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

lcl: add TCustomImageList.GetFullRawImage, TCustomImageList.GetFullBitmap to retrieve one image/bitmap with all icons placed in the imagelist

Browse Source 
git-svn-id: trunk@16381 -
This commit is contained in:
paul 2008-09-03 07:43:54 +00:00
parent fc954bd37a
commit 03fcee900c
2 changed files with 46 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
lcl/imglist.pp
View File

@ -173,6 +173,8 @@ type
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 GetRawImage(Index: Integer; out Image: TRawImage);
function GetHotSpot: TPoint; virtual;

46
lcl/include/imglist.inc
View File

@ -534,6 +534,36 @@ begin
GetBitmap(Index, Image, gdeNormal);
end;
procedure TCustomImageList.GetFullBitmap(Image: TCustomBitmap; AEffect: TGraphicsDrawEffect = gdeNormal);
var
RawImg: TRawImage;
ListImg, DeviceImg: TLazIntfImage;
ImgHandle, MskHandle: HBitmap;
begin
if (FCount = 0) or (Image = nil) then Exit;
GetFullRawImage(RawImg);
RawImg.PerformEffect(AEffect, True);
MskHandle := 0;
if not CreateCompatibleBitmaps(RawImg, ImgHandle, MskHandle, 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, Width, Height * Count);
DeviceImg.CopyPixels(ListImg);
DeviceImg.GetRawImage(RawImg);
RawImage_CreateBitmaps(RawImg, ImgHandle, MskHandle);
DeviceImg.Free;
ListImg.Free;
end;
Image.SetHandles(ImgHandle, MskHandle);
RawImg.FreeData;
end;
procedure TCustomImageList.GetBitmap(Index: Integer; Image: TCustomBitmap;
AEffect: TGraphicsDrawEffect);
var
@ -565,13 +595,25 @@ begin
RawImg.FreeData;
end;
procedure TCustomImageList.GetFullRawImage(out Image: TRawImage);
begin
Image.Init;
if (FCount = 0) then Exit;
FillDescription(Image.Description);
Image.Description.Height := Height * Count;
Image.DataSize := Width * Height * Count * SizeOf(FData[0]);
Image.Data := PByte(FData);
end;
procedure TCustomImageList.GetRawImage(Index: Integer; out Image: TRawImage);
begin
Image.Init;
if (FCount = 0) then Exit;
CheckIndex(Index);
Image.Init;
FillDescription(Image.Description);
Image.DataSize := FWidth * FHeight * SizeOF(FData[0]);
Image.DataSize := FWidth * FHeight * SizeOf(FData[0]);
Image.Data := @FData[Index * FWidth * FHeight];
end;