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

examples: use FPC resources

Browse Source 
git-svn-id: trunk@43013 -
This commit is contained in:
paul 2013-09-28 15:25:27 +00:00
parent 28a7e9342f
commit 0e8dcc15e1
1 changed files with 13 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

38
examples/testallform.pp
View File

@ -322,30 +322,21 @@ var
implementation
function LoadResource(ResourceName:string; PixMap:TPixMap):boolean;
var
ms:TMemoryStream;
res:TLResource;
{$R ../images/laz_images.res}
{$R ../images/components_images.res}
function LoadResource(ResourceName:string; PixMap: TPixmap): Boolean;
var
Bitmap: TCustomBitmap;
begin
Bitmap := CreateBitmapFromResourceName(HInstance, ResourceName);
Result := Assigned(Bitmap);
if Result then
begin
Result:=false;
res:=LazarusResources.Find(ResourceName);
if (res <> nil) then
begin
if res.ValueType='XPM' then begin
ms:=TMemoryStream.Create;
try
ms.Write(res.Value[1],length(res.Value));
ms.Position:=0;
PixMap.LoadFromStream(ms);
Result:=true;
finally
ms.Free;
end;
end;
end
else
//debugln ('TestAll Warning: resource "', ResourceName,'" not found!');
PixMap.Assign(Bitmap);
Bitmap.Free;
end;
end;
{$I testtools.inc}
@ -2526,8 +2517,5 @@ TrackBar2 := TTrackBar.Create(Self);
//++++++++++++++++++++++++++++++++++++ THE END ++++++++++++++++++++++++++++++++++++++
END;
initialization
{$I ../images/laz_images.lrs}
{$I ../images/components_images.lrs}
END.