paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-09-06 00:20:13 +02:00
Code Issues Packages Projects Releases Wiki Activity

lcl:

Browse Source 
- fix TSharedIcon.IsEmpty
- force MaskBitsPerPixel to be = 1 for icon

git-svn-id: trunk@15637 -
This commit is contained in:
paul 2008-07-01 06:12:13 +00:00
parent 3562f2f7fa
commit 77f9ce4b17
2 changed files with 8 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
lcl/graphics.pp
View File

@ -1387,6 +1387,7 @@ type
FImages: TFPList;
protected
procedure FreeHandle; override;
function IsEmpty: boolean; override;
public
constructor Create; override;
destructor Destroy; override;

7
lcl/include/icon.inc
View File

@ -90,6 +90,11 @@ begin
FHandle := 0;
end;
function TSharedIcon.IsEmpty: boolean;
begin
Result := inherited IsEmpty and (Count = 0);
end;
class function TSharedIcon.GetImagesClass: TIconImageClass;
begin
Result := TIconImage;
@ -615,6 +620,7 @@ begin
IntfImage.GetRawImage(RawImage, True);
// Paul: don't set MaskBitsPerPixel to zero => windows will fail with no mask
// Even empty mask is better than no mask. But maybe CreateIconIndirect must be fixed on windows?
RawImage.Description.MaskBitsPerPixel := 1;
with TSharedIcon(FSharedImage) do
begin
IconImage := GetImagesClass.Create(RawImage);
@ -789,6 +795,7 @@ begin
NewImage.FImage.Palette := GetMem(NewImage.FImage.PaletteSize);
Move(OldBitmap.FImage.Palette^, NewImage.FImage.Palette^, NewImage.FImage.PaletteSize);
end;
NewImage.FImage.Description.MaskBitsPerPixel := 1;
end;
end;
FreeCanvasContext;