Читать «Виртуальная библиотека Delphi» онлайн - страница 25

Unknown

type TBmpForm = class(TForm)

 Button1: TButton;

 procedure FormDestroy(Sender: TObject);

 procedure FormPaint(Sender: TObject);

 procedure Button1Click(Sender: TObject);

 procedure FormCreate(Sender: TObject);

private

 Bitmap: TBitmap;

 procedure ScrambleBitmap;

 procedure WMEraseBkgnd(var m: TWMEraseBkgnd); message WM_ERASEBKGND;

end;

var

 BmpForm: TBmpForm;

implementation

{$R *.DFM}

procedure TBmpForm.FormCreate(Sender: TObject);

begin

 Bitmap := TBitmap.Create;

 Bitmap.LoadFromFile('bor6.bmp');

end;

procedure TBmpForm.FormDestroy(Sender: TObject);

begin

 Bitmap.Free;

end;

// since we're going to be painting the whole form, handling this

// message will suppress the uneccessary repainting of the background

// which can result in flicker.

procedure TBmpform.WMEraseBkgnd(var m : TWMEraseBkgnd);

begin

 m.Result := LRESULT(False);

end;

procedure TBmpForm.FormPaint(Sender: TObject);

 var x, y: Integer;

begin

 y := 0;

 while y < Height do begin

  x := 0;

  while x < Width do begin

   Canvas.Draw(x, y, Bitmap);

   x := x + Bitmap.Width;

  end;

  y := y + Bitmap.Height;

 end;

end;

procedure TBmpForm.Button1Click(Sender: TObject);

begin

 ScrambleBitmap; Invalidate;

end;

// scrambling the bitmap is easy when it's has 256 colors:

// we just need to change each of the color in the palette

// to some other value.

procedure TBmpForm.ScrambleBitmap;

var

 pal: PLogPalette;

 hpal: HPALETTE;

 i: Integer;

begin

 pal := nil;

 try

  GetMem(pal, sizeof(TLogPalette) + sizeof(TPaletteEntry) * 255);

  pal.palVersion := $300;

  pal.palNumEntries := 256;

  for i := 0 to 255 do begin

   pal.palPalEntry[i].peRed := Random(255);

   pal.palPalEntry[i].peGreen := Random(255);

   pal.palPalEntry[i].peBlue := Random(255);

  end;

  hpal := CreatePalette(pal^);

  if hpal <> 0 then Bitmap.Palette := hpal;

 finally

  FreeMem(pal);

 end;

end;

end.

Заполняет Canvas рисунком с рабочего стола, учитывая координаты.

Function PaintDesktop(HDC) : boolean;

Например:

PaintDesktop(form1.Canvas.Handle);

Как вставить растровое изображение в компонент ListBox?

Для этого необходимо установить в инспекторе объектов поле Style в lbOwnerDrawFixed, при фиксированной высоте строки, или в lbOwnerDrawVariable, при переменной, и установить собственный обработчик события для OnDrawItem. В этом обработчике и надо рисовать растровое изображение.

Пример:

Рисуются изображения размером 32×16 (размер стандартного глифа для Delphi). Очень полезно при поиске нужного изображения для кнопок!