mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-06-06 03:38:26 +02:00
c9e180acac
Basic graphic primitives split into GraphType package, so that we can reference it from interface (GTK, Win32) units. New Frame3d canvas method that uses native (themed) drawing (GTK only). New overloaded Canvas.TextRect method. LCLLinux and Graphics was split, so a bunch of files had to be modified. git-svn-id: trunk@653 -
404 lines
10 KiB
ObjectPascal
404 lines
10 KiB
ObjectPascal
{
|
|
/***************************************************************************
|
|
checkbox.pp
|
|
-----------
|
|
Sample for Lazarus Checkbox.
|
|
|
|
|
|
Initial Revision : Wed Dec 29 23:15:32 CST 1999
|
|
|
|
|
|
***************************************************************************/
|
|
|
|
/***************************************************************************
|
|
* *
|
|
* This program is free software; you can redistribute it and/or modify *
|
|
* it under the terms of the GNU General Public License as published by *
|
|
* the Free Software Foundation; either version 2 of the License, or *
|
|
* (at your option) any later version. *
|
|
* *
|
|
***************************************************************************/
|
|
}
|
|
{$H+}
|
|
program checkbox;
|
|
|
|
{$mode objfpc}
|
|
|
|
uses
|
|
classes, stdctrls, forms, buttons, menus, comctrls, sysutils,
|
|
extctrls, graphtype, controls;
|
|
|
|
type
|
|
TForm1 = class(TFORM)
|
|
public
|
|
Button2: TButton;
|
|
Button3: TButton;
|
|
Panel1: TPanel;
|
|
mnuMain: TMainMenu;
|
|
itmFileQuit: TMenuItem;
|
|
itmFile: TMenuItem;
|
|
CheckBox1 : TCheckBox;
|
|
RadioButton : TRadioButton;
|
|
RadioButton2 : TRadioButton;
|
|
RadioButton3 : TRadioButton;
|
|
RadioGroup : TRadioGroup;
|
|
RadioGroup2 : TRadioGroup;
|
|
ToggleBox : TToggleBox;
|
|
label1 : TLabel;
|
|
label2 : TLabel;
|
|
constructor Create(AOwner: TComponent); override;
|
|
procedure LoadMainMenu;
|
|
Procedure FormKill(Sender : TObject);
|
|
procedure mnuQuitClicked(Sender : TObject);
|
|
protected
|
|
procedure Button1CLick(Sender : TObject);
|
|
procedure Button2CLick(Sender : TObject);
|
|
procedure Button3CLick(Sender : TObject);
|
|
procedure Button4CLick(Sender : TObject);
|
|
procedure CheckBoxClick(Sender : TObject);
|
|
procedure RadioButtonClick(Sender : TObject);
|
|
procedure RadioGroupClick(Sender : TObject);
|
|
procedure ToggleBoxClick(Sender : TObject);
|
|
end;
|
|
|
|
var
|
|
Form1 : TForm1;
|
|
|
|
constructor TForm1.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
Caption := 'CheckBox Demo V.02';
|
|
LoadMainMenu;
|
|
end;
|
|
|
|
procedure TForm1.Button1Click(Sender : TObject);
|
|
Begin
|
|
End;
|
|
|
|
procedure TForm1.Button2Click(Sender : TObject);
|
|
Begin
|
|
if assigned (CheckBox1) then
|
|
begin
|
|
CheckBox1.Checked := not CheckBox1.Checked;
|
|
end;
|
|
Panel1.Caption:= 'Changed';
|
|
End;
|
|
|
|
procedure TForm1.Button3Click(Sender : TObject);
|
|
var
|
|
i : integer;
|
|
Begin
|
|
if assigned (RadioGroup) then
|
|
begin
|
|
i := RadioGroup.ItemIndex;
|
|
if i < RadioGroup.Items.Count -1
|
|
then RadioGroup.ItemIndex := i + 1
|
|
else RadioGroup.ItemIndex := 0
|
|
end;
|
|
if assigned (RadioGroup2) then
|
|
begin
|
|
i := RadioGroup2.ItemIndex;
|
|
if i < RadioGroup2.Items.Count -1
|
|
then RadioGroup2.ItemIndex := i + 1
|
|
else RadioGroup2.ItemIndex := 0
|
|
end;
|
|
End;
|
|
|
|
procedure TForm1.Button4Click(Sender : TObject);
|
|
Begin
|
|
End;
|
|
|
|
procedure TForm1.CheckBoxClick(Sender : TObject);
|
|
Begin
|
|
WriteLn('[TForm1.CheckBoxClick]');
|
|
if assigned (CheckBox1) and assigned (label1) then begin
|
|
Writeln (' [checkbox and label assigned]');
|
|
if CheckBox1.Checked
|
|
then label1.Caption := 'checked'
|
|
else label1.Caption := 'unchecked';
|
|
// ***SIGSEGV!!!!!!!!! label1.Repaint;
|
|
if CheckBox1.Checked
|
|
then CheckBox1.Caption := 'new caption'
|
|
else CheckBox1.Caption := 'Checkbox 1';
|
|
end;
|
|
End;
|
|
|
|
procedure TForm1.RadioButtonClick(Sender : TObject);
|
|
begin
|
|
WriteLn('[TForm1.RadioButtonClick]');
|
|
if assigned (label2)
|
|
then label2.Caption := 'active: ' + TRadioButton (Sender).Caption
|
|
end;
|
|
|
|
procedure TForm1.RadioGroupClick(Sender : TObject);
|
|
begin
|
|
WriteLn('[TForm1.RadioGroupClick]');
|
|
end;
|
|
|
|
procedure TForm1.ToggleBoxClick(Sender : TObject);
|
|
begin
|
|
WriteLn('[TForm1.ToggleBoxClick]');
|
|
if assigned (ToggleBox) then
|
|
begin
|
|
if ToggleBox.checked
|
|
then ToggleBox.Caption := 'Togglebox1'
|
|
else ToggleBox.Caption := 'does nothing:-(';
|
|
// ***SIGSEGV!!!!!!!!! ToggleBox.RePaint;
|
|
end;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
|
|
procedure TForm1.FormKill(Sender : TObject);
|
|
Begin
|
|
// Free;
|
|
Application.terminate;
|
|
End;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
procedure TForm1.LoadMainMenu;
|
|
|
|
begin
|
|
OnDestroy := @FormKill;
|
|
|
|
{ set the height and width }
|
|
Height := 450;
|
|
Width := 700;
|
|
|
|
{ Create a checkbox }
|
|
CheckBox1 := TCheckBox.Create(Self);
|
|
CheckBox1.Parent := self;
|
|
CheckBox1.top := 35;
|
|
CheckBox1.left := 10;
|
|
CheckBox1.Height :=20;
|
|
CheckBox1.Width := 200;
|
|
CheckBox1.OnCLick := @CheckBoxClick;
|
|
CheckBox1.Show;
|
|
CheckBox1.Caption := 'Checkbox 1';
|
|
|
|
{ Create a label which shows the state checked/unchecked of the checkbox}
|
|
label1 := TLabel.Create(Self);
|
|
label1.Parent := self;
|
|
label1.top := 35;
|
|
label1.left := 220;
|
|
label1.Height :=20;
|
|
label1.Width := 100;
|
|
label1.Show;
|
|
label1.Caption := 'unchecked';
|
|
|
|
|
|
{ Sample panel here }
|
|
Panel1:= TPanel.Create(Self);
|
|
with Panel1 do begin
|
|
Parent := Self;
|
|
Left := 320;
|
|
Top := 60;
|
|
Width := 280;
|
|
Height := 81;
|
|
Alignment:= taRightJustify;
|
|
BevelInner:= bvLowered;
|
|
BevelOuter:= bvRaised;
|
|
BorderWidth:= 4;
|
|
BevelWidth:= 4;
|
|
Show;
|
|
Caption:= 'Hello world';
|
|
end;
|
|
|
|
{ Create a button which toggles the checkbox }
|
|
Button2 := TBitBtn.Create(Self);
|
|
Button2.Parent := Panel1;
|
|
Button2.Left := 5;
|
|
Button2.Top := 45;
|
|
Button2.Width := 180;
|
|
Button2.Height := 20;
|
|
Button2.Show;
|
|
Button2.Caption := 'Toggle checkbox';
|
|
Button2.OnClick := @Button2Click;
|
|
|
|
{ Create a label which shows the caption of the active radiobutton }
|
|
label2 := TLabel.Create(Self);
|
|
label2.Parent := self;
|
|
label2.top := 90;
|
|
label2.left := 220;
|
|
label2.Height :=20;
|
|
label2.Width := 200;
|
|
label2.Show;
|
|
label2.Caption := 'active: unknown';
|
|
|
|
{ Create a radio button }
|
|
RadioButton := TRadioButton.Create(Self);
|
|
RadioButton.Parent := self;
|
|
RadioButton.top := 70;
|
|
RadioButton.left := 10;
|
|
RadioButton.Height :=20;
|
|
RadioButton.Width := 200;
|
|
RadioButton.OnCLick := @RadioButtonClick;
|
|
RadioButton.Checked := false;
|
|
RadioButton.Show;
|
|
RadioButton.Caption := 'Radio button 1';
|
|
|
|
{ Create a 2nd radiobutton }
|
|
RadioButton2 := TRadioButton.Create(Self);
|
|
with RadioButton2 do
|
|
begin
|
|
Parent := self;
|
|
top := 90;
|
|
left := 10;
|
|
Height :=20;
|
|
Width := 200;
|
|
OnCLick := @RadioButtonClick;
|
|
Checked := true;
|
|
Show;
|
|
Caption := 'Radiobutton 2'
|
|
end;
|
|
|
|
{ Create a 3rd radiobutton }
|
|
RadioButton3 := TRadioButton.Create(Self);
|
|
with RadioButton3 do
|
|
begin
|
|
Parent := self;
|
|
top := 110;
|
|
left := 10;
|
|
Height :=20;
|
|
Width := 200;
|
|
OnCLick := @RadioButtonClick;
|
|
Checked := false;
|
|
Show;
|
|
Caption := 'Radiobutton 3'
|
|
end;
|
|
|
|
{ Create a radiogroup }
|
|
RadioGroup := TRadioGroup.Create(Self);
|
|
with RadioGroup do
|
|
begin
|
|
Parent := self;
|
|
top := 200;
|
|
left := 10;
|
|
Height :=200;
|
|
Width := 150;
|
|
OnCLick := @RadioGroupClick;
|
|
RadioGroup.Items.Add ('No 1');
|
|
RadioGroup.Items.Add ('No 2');
|
|
RadioGroup.Items.Add ('No 3');
|
|
RadioGroup.Items.Add ('No 4');
|
|
RadioGroup.Items.Add ('No 5');
|
|
RadioGroup.Items.Add ('No 6');
|
|
ItemIndex := 3;
|
|
Show;
|
|
Caption := 'Radiogroup';
|
|
end;
|
|
|
|
{ Create a button which does mystic things with the radiogroup }
|
|
Button3 := TButton.Create(Self);
|
|
Button3.Parent := Self;
|
|
Button3.Left := 220;
|
|
Button3.Top := 220;
|
|
Button3.Width := 180;
|
|
Button3.Height := 30;
|
|
Button3.Show;
|
|
Button3.Caption := 'Mystic Radiogroups';
|
|
Button3.OnClick := @Button3Click;
|
|
|
|
{ Create a radiogroup }
|
|
RadioGroup2 := TRadioGroup.Create(Self);
|
|
with RadioGroup2 do
|
|
begin
|
|
Parent := self;
|
|
top := 300;
|
|
left := 220;
|
|
Height := 100;
|
|
Width := 300;
|
|
Columns := 3;
|
|
Items.Add ('No 1');
|
|
Items.Add ('No 2');
|
|
Items.Add ('No 3');
|
|
Items.Add ('No 4');
|
|
Items.Add ('No 5');
|
|
Items.Add ('No 6');
|
|
ItemIndex := 1;
|
|
Show;
|
|
Caption := '3 columns';
|
|
end;
|
|
|
|
{ Create a togglebox }
|
|
ToggleBox := TToggleBox.Create(Self);
|
|
with ToggleBox do
|
|
begin
|
|
Parent := self;
|
|
top := 150;
|
|
left := 10;
|
|
Height :=30;
|
|
Width := 240;
|
|
OnCLick := @ToggleBoxClick;
|
|
Show;
|
|
Caption := 'ToggleBox 1'
|
|
end;
|
|
|
|
mnuMain := TMainMenu.Create(Self);
|
|
Menu := mnuMain;
|
|
|
|
itmFile := TMenuItem.Create(Self);
|
|
itmFile.Caption := 'File';
|
|
mnuMain.Items.Add(itmFile);
|
|
|
|
itmFileQuit := TMenuItem.Create(Self);
|
|
itmFileQuit.Caption := 'Quit';
|
|
itmFileQuit.OnClick := @mnuQuitClicked;
|
|
itmFile.Add(itmFileQuit);
|
|
|
|
|
|
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
procedure TForm1.mnuQuitClicked(Sender : TObject);
|
|
begin
|
|
Free;
|
|
end;
|
|
{------------------------------------------------------------------------------}
|
|
|
|
begin
|
|
Application.Initialize; { calls InitProcedure which starts up GTK }
|
|
Application.CreateForm(TForm1, Form1);
|
|
Application.Run;
|
|
end.
|
|
|
|
{
|
|
$Log$
|
|
Revision 1.2 2002/02/03 00:24:00 lazarus
|
|
TPanel implemented.
|
|
Basic graphic primitives split into GraphType package, so that we can
|
|
reference it from interface (GTK, Win32) units.
|
|
New Frame3d canvas method that uses native (themed) drawing (GTK only).
|
|
New overloaded Canvas.TextRect method.
|
|
LCLLinux and Graphics was split, so a bunch of files had to be modified.
|
|
|
|
Revision 1.1 2000/07/13 10:28:20 michael
|
|
+ Initial import
|
|
|
|
Revision 1.6 2000/06/22 20:58:49 lazarus
|
|
- enhanced checkbox example, stoppok
|
|
|
|
Revision 1.5 2000/06/18 08:11:32 lazarus
|
|
Fixed crash in checkbox.pp when Checkbox1 was clicked.
|
|
stoppok
|
|
|
|
Revision 1.4 2000/01/04 23:12:46 lazarus
|
|
MWE:
|
|
Fixed LM_CHAR message. It is now after the LM_KEYUP message
|
|
Fixed Menus at checkbox example.
|
|
Removed references to TTabbedNtBK (somebody removed the files) and
|
|
chanched it on the compileroptions form
|
|
|
|
Revision 1.3 2000/01/02 00:30:29 lazarus
|
|
Stoppok:
|
|
- Shows usage of TRadiogroup now
|
|
|
|
Revision 1.2 1999/12/30 19:05:22 lazarus
|
|
|
|
- Enhanced checkbox.pp to also demonstrate TRadiobutton
|
|
stoppok
|
|
|
|
}
|
|
|