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

lcl: create TCustomBitmap from resource according to stream format instead of PNG only

Browse Source 
git-svn-id: trunk@43069 -
This commit is contained in:
paul 2013-10-04 15:19:40 +00:00
parent a6e05fc24b
commit 4152533519
2 changed files with 58 additions and 45 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

101
lcl/graphics.pp
View File

@ -2201,50 +2201,6 @@ begin
Result := CreateBitmapFromLazarusResource(AName, TCustomBitmap);
end;
function CreateGraphicFromResourceName(Instance: THandle; const ResName: String): TGraphic;
var
ResHandle: TFPResourceHandle;
begin
// test Icon
ResHandle := FindResource(Instance, PChar(ResName), PChar(RT_GROUP_ICON));
if ResHandle <> 0 then
begin
Result := TIcon.Create;
TIcon(Result).LoadFromResourceHandle(Instance, ResHandle);
Exit;
end;
// test Cursor
ResHandle := FindResource(Instance, PChar(ResName), PChar(RT_GROUP_CURSOR));
if ResHandle <> 0 then
begin
Result := TCursorImage.Create;
TCursorImage(Result).LoadFromResourceHandle(Instance, ResHandle);
end
else
Result := CreateBitmapFromResourceName(Instance, ResName)
end;
function CreateBitmapFromResourceName(Instance: THandle; const ResName: String): TCustomBitmap;
var
ResHandle: TFPResourceHandle;
begin
ResHandle := FindResource(Instance, PChar(ResName), PChar(RT_BITMAP));
if ResHandle <> 0 then
begin
Result := TBitmap.Create;
Result.LoadFromResourceName(Instance, ResName);
Exit;
end;
ResHandle := FindResource(Instance, PChar(ResName), PChar(RT_RCDATA));
if ResHandle <> 0 then
begin
Result := TPortableNetworkGraphic.Create;
Result.LoadFromResourceName(Instance, ResName);
end
else
Result := nil;
end;
function CreateBitmapFromLazarusResource(const AName: String; AMinimumClass: TCustomBitmapClass): TCustomBitmap;
var
Stream: TLazarusResourceStream;
@ -2806,6 +2762,63 @@ end;
{$I tiffimage.inc}
{$I gifimage.inc}
function CreateGraphicFromResourceName(Instance: THandle; const ResName: String): TGraphic;
var
ResHandle: TFPResourceHandle;
begin
// test Icon
ResHandle := FindResource(Instance, PChar(ResName), PChar(RT_GROUP_ICON));
if ResHandle <> 0 then
begin
Result := TIcon.Create;
TIcon(Result).LoadFromResourceHandle(Instance, ResHandle);
Exit;
end;
// test Cursor
ResHandle := FindResource(Instance, PChar(ResName), PChar(RT_GROUP_CURSOR));
if ResHandle <> 0 then
begin
Result := TCursorImage.Create;
TCursorImage(Result).LoadFromResourceHandle(Instance, ResHandle);
end
else
Result := CreateBitmapFromResourceName(Instance, ResName)
end;
function CreateBitmapFromResourceName(Instance: THandle; const ResName: String): TCustomBitmap;
var
ResHandle: TFPResourceHandle;
Stream: TResourceStream;
GraphicClass: TGraphicClass;
begin
ResHandle := FindResource(Instance, PChar(ResName), PChar(RT_BITMAP));
if ResHandle <> 0 then
begin
Result := TBitmap.Create;
Result.LoadFromResourceName(Instance, ResName);
Exit;
end;
ResHandle := FindResource(Instance, PChar(ResName), PChar(RT_RCDATA));
if ResHandle <> 0 then
begin
Stream := TResourceStream.Create(Instance, PChar(ResName), PChar(RT_RCDATA));
try
GraphicClass := GetPicFileFormats.FindByStreamFormat(Stream);
if Assigned(GraphicClass) and GraphicClass.InheritsFrom(TCustomBitmap) then
begin
Result := TCustomBitmap(GraphicClass.Create);
Result.LoadFromStream(Stream);
end
else
Result := nil;
finally
Stream.Free;
end;
end
else
Result := nil;
end;
function LocalGetSystemFont: HFont;
begin
Result := GetStockObject(DEFAULT_GUI_FONT);

2
lcl/include/picture.inc
View File

@ -310,7 +310,7 @@ var
function GetPicFileFormats: TPicFileFormatsList;
begin
if (PicFileFormats = nil) and (not GraphicsFinalized) then
if not Assigned(PicFileFormats) and not GraphicsFinalized then
PicFileFormats := TPicFileFormatsList.Create;
Result := PicFileFormats;
end;