How to draw transparent bitmap from ImageList on TMenuItem?

1.4k Views Asked by At

I need to draw a transparent bitmap on a TMenuItem. Despite trying for many hours with different methods I could not succeed:

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;

This is how ThisBmp looks in CodeSite after GetBitmap: enter image description here

And this how the resulting menu item looks: enter image description here

1

There are 1 best solutions below

3
On

Your code doesn't work because you lost all transparency info when using GetBitmap(). You will have to draw the bitmap manually instead, eg:

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;

Alternatively:

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;

Then you can do this:

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