paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-18 02:59:17 +02:00
Code Issues Packages Projects Releases Wiki Activity

win32: fix bitmap menu item transparency. Issue #36490. Patch from Denis Kozlov

Browse Source 
git-svn-id: trunk@62551 -
This commit is contained in:
ondrej 2020-01-14 14:56:23 +00:00
parent e254ce3acb
commit 872fe5d89c
1 changed files with 12 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
lcl/interfaces/win32/win32wsmenus.pp
View File

@ -1114,16 +1114,25 @@ var
AImageList: TCustomImageList;
FreeImageList: Boolean;
AImageIndex, AImagesWidth: Integer;
ATransparentColor: TColor;
APPI: longint;
begin
AMenuItem.GetImageList(AImageList, AImagesWidth);
if (AImageList = nil) or (AMenuItem.ImageIndex < 0) then // using icon from Bitmap
begin
if not (Assigned(AMenuItem.Bitmap) and (AMenuItem.Bitmap.Height>0)) then
Exit;
AImageList := TImageList.Create(nil);
AImageList.Width := AMenuItem.Bitmap.Width; // maybe height to prevent too wide bitmaps?
AImageList.Width := AMenuItem.Bitmap.Width;
AImageList.Height := AMenuItem.Bitmap.Height;
if not AMenuItem.Bitmap.Transparent then
AImageIndex := AImageList.AddMasked(AMenuItem.Bitmap, AMenuItem.Bitmap.Canvas.Pixels[0, AImageList.Height-1])
if AMenuItem.Bitmap.Transparent then
begin
case AMenuItem.Bitmap.TransparentMode of
tmAuto: ATransparentColor := AMenuItem.Bitmap.Canvas.Pixels[0, AImageList.Height-1];
tmFixed: ATransparentColor := AMenuItem.Bitmap.TransparentColor;
end;
AImageIndex := AImageList.AddMasked(AMenuItem.Bitmap, ATransparentColor);
end
else
AImageIndex := AImageList.Add(AMenuItem.Bitmap, nil);
FreeImageList := True;