paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-11-23 16:59:29 +01:00
Code Issues Packages Projects Releases Wiki Activity

LCL/Graphics: Allow to save individual images of TCustomIcon in another raster image format. Fixes issue #36828.

Browse Source
This commit is contained in:
wp_xyz 2025-07-13 22:05:06 +02:00
parent 7eddf0a93f
commit fd9ebbb202
3 changed files with 54 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
lcl/graphics.pp
View File

@ -1670,6 +1670,7 @@ type
procedure SetHandles(ABitmap, AMask: HBITMAP); override;
procedure Sort;
function GetBestIndexForSize(ASize: TSize): Integer;
function ExportImage(AIndex: Integer; AImageClass: TFPImageBitmapClass): TFPImageBitmap;
property Current: Integer read FCurrent write SetCurrent;
property Count: Integer read GetCount;

9
lcl/include/icon.inc
View File

@ -523,6 +523,15 @@ begin
end;
end;
{ Exports the image at the specified index to another TFPImageBitmap class.
NOTE: The created instance must be destroyed by the calling routine. }
function TCustomIcon.ExportImage(AIndex: Integer;
AImageClass: TFPImageBitmapClass): TFPImageBitmap;
begin
Result := AImageClass.Create;
Result.LoadFromRawImage(TSharedIcon(FSharedImage).Images[AIndex].RawImage, false);
end;
function TCustomIcon.GetCount: Integer;
begin
Result := TSharedIcon(FSharedImage).Count;

58
lcl/include/picture.inc
View File

@ -644,9 +644,28 @@ end;
procedure TPicture.SaveToStreamWithFileExt(Stream: TStream; const FileExt: string);
var
GraphicClass: TGraphicClass;
IntfImg: TLazIntfImage;
ImgWriter: TFPCustomImageWriter;
fpBmpClass: TFPImageBitmapClass;
fpBmp: TFPImageBitmap;
icn: TCustomIcon;
procedure SaveFPBmp(AFpBmp: TFPImageBitmap);
var
IntfImg: TLazIntfImage;
ImgWriter: TFPCustomImageWriter = nil;
begin
IntfImg := TLazIntfImage.Create(0,0,[]);
try
ImgWriter := TFPImageBitmapClass(GraphicClass).GetWriterClass.Create;
IntfImg.SetRawImage(AFpBmp.GetRawImagePtr^, False);
AFpBmp.InitializeWriter(IntfImg, ImgWriter);
IntfImg.SaveToStream(Stream, ImgWriter);
AFpBmp.FinalizeWriter(ImgWriter);
finally
IntfImg.Free;
ImgWriter.Free;
end;
end;
begin
if Graphic = nil then Exit;
if FileExt <> '' then
@ -663,21 +682,32 @@ begin
if (Graphic is TFPImageBitmap) and GraphicClass.InheritsFrom(TFPImageBitmap)
then begin
fpBmp := TFPImageBitmap(Graphic);
ImgWriter := nil;
IntfImg := TLazIntfImage.Create(0,0,[]);
try
ImgWriter := TFPImageBitmapClass(GraphicClass).GetWriterClass.Create;
IntfImg.SetRawImage(fpBmp.GetRawImagePtr^, False);
fpBmp.InitializeWriter(IntfImg, ImgWriter);
IntfImg.SaveToStream(Stream, ImgWriter);
fpBmp.FinalizeWriter(ImgWriter);
finally
IntfImg.Free;
ImgWriter.Free;
end;
SaveFpBmp(TFPImageBitmap(Graphic));
Exit;
end;
if (Graphic is TCustomIcon) then
begin
// Save Icon as .ico or .icns
if SameText(FileExt, TIcon.GetFileExtensions) or SameText(FileExt, TIcnsIcon.GetFileExtensions) then
TCustomIcon(Graphic).SaveToStream(Stream)
else
// Save current image of Icon as format given by FileExt
if GraphicClass.InheritsFrom(TFPImageBitmap) then
begin
icn := TCustomIcon(Graphic);
fpBmpClass := TFPImageBitmapClass(GraphicClass);
fpBmp := icn.ExportImage(icn.Current, fpBmpClass);
try
SaveFpBmp(fpBmp);
exit;
finally
fpBmp.Free;
end;
end;
exit;
end;
// no conversion available yet
raise Exception.CreateFmt('TODO: Conversion for vector or icon images of format "%s" to "%s"!', [Graphic.GetFileExtensions, FileExt]);
end;