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

lcl: implement TCustomImageList.GetIcon() for delphi compatibility

Browse Source 
git-svn-id: trunk@36662 -
This commit is contained in:
paul 2012-04-09 06:58:30 +00:00
parent 46dd2e5203
commit d0ced34a84
2 changed files with 41 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
lcl/imglist.pp
View File

@ -178,10 +178,14 @@ type
procedure Draw(ACanvas: TCanvas; AX, AY, AIndex: Integer; ADrawingStyle: TDrawingStyle; AImageType: TImageType;
ADrawEffect: TGraphicsDrawEffect); overload; virtual;
procedure FillDescription(out ADesc: TRawImageDescription);
procedure GetBitmap(Index: Integer; Image: TCustomBitmap); overload;
procedure GetBitmap(Index: Integer; Image: TCustomBitmap; AEffect: TGraphicsDrawEffect); overload;
procedure GetFullBitmap(Image: TCustomBitmap; AEffect: TGraphicsDrawEffect = gdeNormal);
procedure GetFullRawImage(out Image: TRawImage);
procedure GetIcon(Index: Integer; Image: TIcon; AEffect: TGraphicsDrawEffect); overload;
procedure GetIcon(Index: Integer; Image: TIcon); overload;
procedure GetRawImage(Index: Integer; out Image: TRawImage);
function GetHotSpot: TPoint; virtual;

38
lcl/include/imglist.inc
View File

@ -650,6 +650,41 @@ begin
Image.Data := PByte(FData);
end;
procedure TCustomImageList.GetIcon(Index: Integer; Image: TIcon; AEffect: TGraphicsDrawEffect);
var
RawImg: TRawImage;
ListImg, DeviceImg: TLazIntfImage;
IconInfo: TIconInfo;
begin
if (FCount = 0) or (Image = nil) then Exit;
GetRawImage(Index, RawImg);
RawImg.PerformEffect(AEffect, True);
IconInfo.fIcon := True;
IconInfo.hbmMask := 0;
if not CreateCompatibleBitmaps(RawImg, IconInfo.hbmColor, IconInfo.hbmMask, True)
then begin
// bummer, the widgetset doesn't support our 32bit format, try device
ListImg := TLazIntfImage.Create(RawImg, False);
DeviceImg := TLazIntfImage.Create(0,0,[]);
DeviceImg.DataDescription := GetDescriptionFromDevice(0, FWidth, FHeight);
DeviceImg.CopyPixels(ListImg);
DeviceImg.GetRawImage(RawImg);
RawImage_CreateBitmaps(RawImg, IconInfo.hbmColor, IconInfo.hbmMask);
DeviceImg.Free;
ListImg.Free;
end;
Image.Handle := CreateIconIndirect(@IconInfo);
RawImg.FreeData;
end;
procedure TCustomImageList.GetIcon(Index: Integer; Image: TIcon);
begin
GetIcon(Index, Image, gdeNormal);
end;
procedure TCustomImageList.GetRawImage(Index: Integer; out Image: TRawImage);
begin
Image.Init;
@ -657,7 +692,8 @@ begin
if (FCount = 0) then Exit;
CheckIndex(Index);
FillDescription(Image.Description);
if Index >= 0 then begin
if Index >= 0 then
begin
Image.DataSize := FWidth * FHeight * SizeOf(FData[0]);
Image.Data := @FData[Index * FWidth * FHeight];
end;