paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-07-23 03:45:55 +02:00
Code Issues Packages Projects Releases Wiki Activity

* enhanced testdialog for TBevel

Browse Source 
* basic test for TPaintBox
stoppok

git-svn-id: trunk@264 -
This commit is contained in:
lazarus 2001-04-17 21:36:15 +00:00
parent f8ad639e4e
commit bfe772f331
2 changed files with 79 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
examples/testallform.pp
View File

@ -138,7 +138,9 @@ type
procedure BoxStyle(Sender : TObject);
procedure ShowBox(Sender : TObject);
//+++++++++++++ TBevel ++++++++++++++++++++++++++++++++
chbBevelStyle,
chbBevelShape : TRadiogroup;
procedure BevelSettings(Sender : TObject);
//+++++++++++++ TButton +++++++++++++++++++++++++++++++
LCount : Integer;
btnCLRLotto : TBitBtn;
@ -216,6 +218,8 @@ type
btnNew, btnSave, btnOpen : TBitBtn;
//+++++++++++++ TOpenDialog +++++++++++++++++++++++++++
//+++++++++++++ TPaintBox +++++++++++++++++++++++++++++
pntCount : integer;
//+++++++++++++ TProgressBar ++++++++++++++++++++++++++
chbProgText, chbProgDirect, chbProgOrient, chbProgEnable, chbSmooth : TCheckBox;
ProgTime : TTimer;
@ -2000,7 +2004,7 @@ TabSheet3 := TTabSheet.Create(Self);
TabSheet3.Caption := 'TabSheet3';
TabSheet3.PageControl := PageControl1;}
//++++++++++++++++++++++++++++++++++++ PaintBox1 ++++++++++++++++++++++++++++++++++++
{PaintBox1 := TPaintBox.Create(Self); //Gives Access violation !!!
PaintBox1 := TPaintBox.Create(Self); //Gives Access violation !!!
with PaintBox1 do
begin
OnClick := @EventOnClick;
@ -2035,7 +2039,7 @@ TabSheet3.PageControl := PageControl1;}
Top := 10;
Visible := True;
Width := 100;
end;}
end;
//++++++++++++++++++++++++++++++++++++ Panel1 +++++++++++++++++++++++++++++++++++++++
//++++++++++++++++++++++++++++++++++++ PopupMenu1 +++++++++++++++++++++++++++++++++++
@ -2536,6 +2540,11 @@ END.
{
$Log$
Revision 1.4 2001/04/17 21:36:15 lazarus
* enhanced testdialog for TBevel
* basic test for TPaintBox
stoppok
Revision 1.3 2001/02/25 09:22:28 lazarus
* Fixed crash caused by missing pixmaps
* using resources now instead of xpm file

68
examples/testtools.inc
View File

@ -137,7 +137,43 @@ lblExeName := TLabel.Create(Self); //Label showing Application.ExeName
//+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
//++++++++++++++++++++++++++++++++++ TBevel Tools +++++++++++++++++++++++++++++++++++
//+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
chbBevelStyle := TRadioGroup.Create (self);
with chbBevelStyle do
begin
Parent := BenchForm[2];
OnClick := @BevelSettings;
Top := 10;
Left := 160;
Height := 60;
Width := 180;
Items.Add ('lowered');
Items.Add ('raised');
Hint := 'Change style (lowered/raised)';
ShowHint := True;
ItemIndex := 0;
Show;
Caption := 'Bevel Styles';
End;
chbBevelShape := TRadioGroup.Create (self);
with chbBevelShape do
begin
Parent := BenchForm[2];
top := 80;
left := 160;
Height := 200;
Width := 180;
OnClick := @BevelSettings;
Items.Add ('bsBox');
Items.Add ('bsFrame');
Items.Add ('bsTopLine');
Items.Add ('bsBottomLine');
Items.Add ('bsLeftLine');
Items.Add ('bsRightLine');
ItemIndex := 0;
Show;
Caption := 'Bevel Shapes';
end;
//+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
//++++++++++++++++++++++++++++++++++ TBitBtn Tools ++++++++++++++++++++++++++++++++++
//+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
@ -1084,6 +1120,7 @@ btnOpen := TBitBtn.Create(Self); //Button Open
//+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
//+++++++++++++++++++++++++++++++++++ TPaintBox Tools +++++++++++++++++++++++++++++++
//+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
pntCount := 0;
// ADD PaintBox CompTools HERE !!!!!!!!!
//+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
//+++++++++++++++++++++++++++++++++++ TPanel Tools ++++++++++++++++++++++++++++++++++
@ -2042,6 +2079,21 @@ begin
Else ProgressBar1.BarShowText := False;
end;
procedure TForm1.BevelSettings(Sender : TObject);
begin
case chbBevelShape.ItemIndex of
0 : Bevel1.Shape := bsBox;
1 : Bevel1.Shape := bsFrame;
2 : Bevel1.Shape := bsTopLine;
3 : Bevel1.Shape := bsBottomLine;
4 : Bevel1.Shape := bsLeftLine;
5 : Bevel1.Shape := bsRightLine;
end;
if chbBevelStyle.ItemIndex = 0
then Bevel1.Style := bsLowered
else Bevel1.Style := bsRaised
end;
//+++++++++++++++++++++++++++++++++ TRadioGroup +++++++++++++++++++++++++++++++++++++
procedure TForm1.RadioGroupClick(Sender : TObject);
begin
@ -2203,6 +2255,15 @@ begin
lblState.Caption := 'State= cbChecked'
Else lblState.Caption := 'State= cbUnchecked';
end;
If Sender.ClassName='TPAINTBOX' then
begin
with TPaintBox(Sender).canvas do
begin
moveto (0,0);
inc (pntCount);
lineto (100, pntCount * 10);
end;
end;
end;
procedure TForm1.EventOnDblClick(Sender : TObject);
@ -2662,6 +2723,11 @@ begin
end;
{
$Log$
Revision 1.5 2001/04/17 21:36:15 lazarus
* enhanced testdialog for TBevel
* basic test for TPaintBox
stoppok
Revision 1.4 2001/02/25 09:22:28 lazarus
* Fixed crash caused by missing pixmaps
* using resources now instead of xpm file