如何从TMenuItem上的ImageList绘制透明位图?

时间:2019-01-15 18:34:36

标签: delphi delphi-10.1-berlin tmenuitem

我需要在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 GetBitmapenter image description here

之后在CodeSite中的显示方式

结果菜单项的外观如下:enter image description here

1 个答案:

答案 0 :(得分:1)

您的代码不起作用,因为使用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;