Виртуальная библиотека Delphi

// 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). Очень полезно при поиске нужного изображения для кнопок!

Установить в инспекторе объектов для ListBox поле ItemHeight = 19, а поле Color = clBtnFace.

{ Загрузить список файлов в ListBox1 при нажатии на кнопку Load (например)}

procedure TForm1.bLoadClick(Sender: TObject);

VAR S : String;

begin

 ListBox1.Clear; {чистим список}

 S := '*.bmp'#0; {задаем шаблон}

 ListBox1.Perform(LB_DIR, DDL_ReadWrite, Longint(@S[1])); {заполняем список}

end;

............

{Отобразить изображения и имена файлов в ListBox}

procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: DrawState);

VAR

 Bitmap : TBitmap;

 Offset : Integer;

 BMPRect: TRect;

begin

 WITH (Control AS TListBox).Canvas DO BEGIN

  FillRect(Rect);

  Bitmap := TBitmap.Create;

  Bitmap.LoadFromFile(ListBox1.Items[Index]);

  Offset := 0;

  IF Bitmap <> NIL THEN BEGIN

   BMPRect := Bounds(Rect.Left+2, Rect.Top+2,

    (Rect.Bottom-Rect.Top-2)*2, Rect.Bottom-Rect.Top-2);

   {StretchDraw(BMPRect, Bitmap); Можно просто нарисовать, но лучше сначала убрать фон}

   BrushCopy(BMPRect,Bitmap, Bounds(0, 0, Bitmap.Width, Bitmap.Height),

   Bitmap.Canvas.Pixels[0, Bitmap.Height-1]);

   Offset := (Rect.Bottom-Rect.Top+1)*2;

  END;

  TextOut(Rect.Left+Offset, Rect.Top, ListBox1.Items[Index]);

  Bitmap.Free;

 END;

end;

Данный пример работает медленно, но оптимизация, для ускорения, вызвала бы трудность в понимании общего принципа его работы.

Можно ли из Delphi рисовать в любой части экрана или в чужом окне?

Для этого надо воспользоваться функциями API. Получить контекст чужого окна, либо всего экрана:

function GetDC(Wnd: HWnd): HDC;

где Wnd — указатель на нужное окно, или 0 для получения контекста всего экрана.

И далее, пользуясь функциями API, нарисовать все что надо.

Пример:

PROCEDURE DrawOnScreen;

VAR ScreenDC: hDC;

BEGIN

 ScreenDC := GetDC(0); {получить контекст экрана}

 Ellipse(ScreenDC, 0, 0, 200, 200); {нарисовать}

 ReleaseDC(0,ScreenDC); {освободить контекст}

END;