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

* Fixed crash caused by missing pixmaps

Browse Source 
* using resources now instead of xpm file

git-svn-id: trunk@197 -
This commit is contained in:
lazarus 2001-02-25 09:22:28 +00:00
parent a6404f82e0
commit d0de358792
2 changed files with 68 additions and 39 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

59
examples/testallform.pp
View File

@ -32,7 +32,7 @@ interface
uses classes, forms, buttons, StdCtrls, controls, menus, ExtCtrls, CListBox,
ComCtrls, SysUtils, Graphics, Dialogs, Inifiles, Spin, clipbrd, lclLinux,
registry;
registry, lresources;
type
TForm1 = class(TForm)
@ -273,8 +273,32 @@ var
implementation
{$I testtools.inc}
function LoadResource(ResourceName:string; PixMap:TPixMap):boolean;
var
ms:TMemoryStream;
res:TLResource;
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
writeln ('TestAll Warning: resource "', ResourceName,'" not found!');
end;
{$I testtools.inc}
//******** Create Form1.TForm1 ******************************************************
constructor TForm1.Create(AOwner: TComponent);
@ -2193,13 +2217,11 @@ ScrollBar1 := TScrollBar.Create(Self);
Visible := True;
end;}
//++++++++++++++++++++++++++++++++++++ SpeedButton1..4 ++++++++++++++++++++++++++++++
S := TFileStream.Create('../images/openfile.xpm', fmOpenRead);
try
Pixmap1 := TPixmap.Create;
Pixmap1.TransparentColor := clBtnFace;
Pixmap1.LoadFromStream(S);
finally
S.Free;
Pixmap1:=TPixMap.Create;
Pixmap1.TransparentColor:=clBtnFace;
if not LoadResource('btn_openfile',Pixmap1) then
begin
LoadResource('default',Pixmap1);
end;
SpeedButton1 := TSpeedButton.Create(Self);
@ -2222,14 +2244,10 @@ SpeedButton1 := TSpeedButton.Create(Self);
Visible := True;
end;
S := TFileStream.Create('../images/save.xpm', fmOpenRead);
try
Pixmap1 := TPixmap.Create;
Pixmap1.TransparentColor := clBtnFace;
Pixmap1.LoadFromStream(S);
finally
S.Free;
end;
Pixmap1:=TPixMap.Create;
Pixmap1.TransparentColor:=clBtnFace;
if not LoadResource('btn_save',Pixmap1)
then LoadResource('default',Pixmap1);
SpeedButton2 := TSpeedButton.Create(Self);
With SpeedButton2 do
@ -2511,10 +2529,17 @@ TrackBar2 := TTrackBar.Create(Self);
//++++++++++++++++++++++++++++++++++++ THE END ++++++++++++++++++++++++++++++++++++++
END;
initialization
{$I ../images/laz_images.lrs}
{$I ../designer/lazarus_control_images.lrs}
END.
{
$Log$
Revision 1.3 2001/02/25 09:22:28 lazarus
* Fixed crash caused by missing pixmaps
* using resources now instead of xpm file
Revision 1.2 2000/09/22 20:22:02 lazarus
+Rebuilt from beginning to V0.2
+Prepared for non existent components (total 60 components).

48
examples/testtools.inc
View File

@ -9,8 +9,8 @@ Info : Array[0..5] of PChar = (' Do not exist yet... ',
' Basic code completed, finalization '+#10#13+' and cleanup is necessary. '+#10#13+' Errors are at presence. ',
' A few procedures are completed, many errors are at presence. ',
' Could crash/freeze your system! It will be created when you push this button. Try it on your own risk!');
FileN : Array[0..8] of String =('bitbtn.xpm','listbox.xpm','newform.xpm','newunit.xpm',
'notebook.xpm','memo.xpm','mouse.xpm','checkbox.xpm','viewunits.xpm');
FileN : Array[0..8] of String =('tbitbtn','tlistbox','btn_newform','btn_newunit',
'tnotebook','tmemo','btn_mouse','tcheckbox','btn_viewunits');
//-----------------------------------------------------------------------------------
// CreateTestTools is a procedure
// that loads all test components
@ -1272,14 +1272,14 @@ lblFormCount := TLabel.Create(Self); //Label showing Screen.PixelsPerInch
FLeft := 10;
For i:= 0 to 8 do
begin
S := TFileStream.Create('../images/'+FileN[i], fmOpenRead);
try
Pixmap1 := TPixmap.Create;
Pixmap1.TransparentColor := clBtnFace;
Pixmap1.LoadFromStream(S);
finally
S.Free;
Pixmap1:=TPixMap.Create;
Pixmap1.TransparentColor:=clBtnFace;
if not LoadResource(FileN[i],Pixmap1) then
begin
LoadResource('default',Pixmap1);
end;
SpeedB[i] := TSpeedButton.Create(Self);
with SpeedB[i] do
begin
@ -1287,24 +1287,22 @@ begin
OnClick := @EventOnClick;
OnMouseDown := @EventOnMouseDown;
OnMouseUp := @EventOnMouseUp;
Case i of
0: Left := SpeedButton1.Left;
1: Left := SpeedButton1.Left + 23;
2: Left := SpeedButton1.Left + 46;
3: Left := SpeedButton1.Left + 69;
4: Left := SpeedButton1.Left + 92;
5: Left := SpeedButton1.Left + 115;
6: Left := SpeedButton1.Left + 138;
7: Left := SpeedButton1.Left + 161;
8: Left := SpeedButton1.Left + 184;
end;
Left := SpeedButton1.Left + (i * 23);
Top := 20;
If i>4 then
Flat := True;
if (i > 4) then
begin
Flat := true;
Hint := FileN [i] + '(flat button)';
end
else begin
Flat := false;
Hint := FileN [i] + '(normal buton)';
end;
Color := clBtnFace;
Glyph := Pixmap1;
Enabled := True;
Visible := True;
ShowHint := true;
end;
end;
@ -2241,6 +2239,8 @@ end;
procedure TForm1.EventOnChange(Sender : TObject);
begin
if not (assigned (lbEvents)) then exit;
lbEvents.Items.Add(Sender.ClassName+'.Change');
EventWatch;
Assert(False, 'Trace: EventOnChange');
@ -2662,6 +2662,10 @@ begin
end;
{
$Log$
Revision 1.4 2001/02/25 09:22:28 lazarus
* Fixed crash caused by missing pixmaps
* using resources now instead of xpm file
Revision 1.3 2000/09/22 20:22:03 lazarus
+Rebuilt from beginning to V0.2
+Prepared for non existent components (total 60 components).