Как нарисовать прозрачное растровое изображение из ImageList на TMenuItem? - PullRequest
Новая
       32

Как нарисовать прозрачное растровое изображение из ImageList на TMenuItem?

0 голосов
/ 15 января 2019

Мне нужно нарисовать прозрачное растровое изображение на TMenuItem. Несмотря на попытки в течение многих часов разными методами, я не смог добиться успеха: 

var
  NewItem: TMenuItem;
  ThisBmp: TBitmap;
begin
  NewItem := TMenuItem.Create(pmSendToCustomTool);
  NewItem.Caption := ThisCaption;
  NewItem.Bitmap.SetSize(16,16);
  NewItem.Bitmap.PixelFormat := pf32bit;
  NewItem.Bitmap.Transparent := True;
  NewItem.Bitmap.TransparentColor := clFuchsia;
  ThisBmp := TBitmap.Create;
  try
    ThisBmp.SetSize(16,16);
    ThisBmp.PixelFormat := pf32bit;
    ThisBmp.Transparent := True;
    ThisBmp.Canvas.Brush.Color := clFuchsia;
    ThisBmp.TransparentColor := clFuchsia; 
    MySystemImageList1.GetBitmap(AIndex, ThisBmp);
    CodeSite.Send('ThisBmp', ThisBmp);
    NewItem.Bitmap.Assign(ThisBmp);
    CodeSite.Send('NewItem.Bitmap', NewItem.Bitmap);
  finally
    ThisBmp.Free;
  end;

Вот как ThisBmp выглядит в CodeSite после GetBitmap: enter image description here

А вот так выглядит получившийся пункт меню: enter image description here

1 Ответ

0 голосов
/ 15 января 2019

Ваш код не работает, потому что вы потеряли всю информацию о прозрачности при использовании GetBitmap(). Вместо этого вам придется рисовать растровое изображение вручную, например: 

uses
  ..., Winapi.CommCtrl;

procedure GetTransparentBitmapFromImageList(ImageList: TCustomImageList; Index: Integer; Bitmap: TBitmap);
var
  i: integer;
begin
  // make sure your ImageList is set to ColorDepth=cd32bit and DrawingStyle=dsTransparant beforehand...
  Bitmap.SetSize(ImageList.Width, ImageList.Height);
  Bitmap.PixelFormat := pf32bit;
  if (ImageList.ColorDepth = cd32Bit) then
  begin
    Bitmap.Transparent := False;
    Bitmap.AlphaFormat := afDefined;
  end
  else
    Bitmap.Transparent := True;
  for i := 0 to Bitmap.Height-1 do
    FillChar(Bitmap.ScanLine[i]^, Bitmap.Width*SizeOf(DWORD), $00);
  ImageList_Draw(ImageList.Handle, Index, Bitmap.Canvas.Handle, 0, 0, ILD_TRANSPARENT);
end;

В качестве альтернативы: 

procedure GetTransparentBitmapFromImageList(ImageList: TCustomImageList; Index: Integer; Bitmap: TBitmap);
begin
  Bitmap.PixelFormat := pf32bit;
  Bitmap.Canvas.Brush.Color := clFuschia;
  Bitmap.SetSize(ImageList.Width, ImageList.Height);
  ImageList.Draw(Bitmap.Canvas, 0, 0, AIndex, dsTransparent, itImage);
  Bitmap.Transparent := True;
  Bitmap.TransParentColor := clFuchsia;
  Bitmap.TransparentMode := tmAuto;
end;

Тогда вы можете сделать это: 

var
  NewItem: TMenuItem;
begin
  NewItem := TMenuItem.Create(pmSendToCustomTool);
  NewItem.Caption := ThisCaption;
  GetTransparentBitmapFromImageList(MySystemImageList1, AIndex, NewItem.Bitmap);
  CodeSite.Send('NewItem.Bitmap', NewItem.Bitmap);
end;
...