lazarus-src-0.9.30.4 0.9.30.4-6 / usr / lib / lazarus / 0.9.30.4 / examples / checkbox.pp

{
 /***************************************************************************
                             checkbox.pp
                             -----------
                        Sample for Lazarus Checkbox.


                   Initial Revision  : Wed Dec 29 23:15:32 CST 1999


 ***************************************************************************/

 ***************************************************************************
 *                                                                         *
 *   This source 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.                                   *
 *                                                                         *
 *   This code is distributed in the hope that it will be useful, but      *
 *   WITHOUT ANY WARRANTY; without even the implied warranty of            *
 *   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU     *
 *   General Public License for more details.                              *
 *                                                                         *
 *   A copy of the GNU General Public License is available on the World    *
 *   Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also      *
 *   obtain it by writing to the Free Software Foundation,                 *
 *   Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.        *
 *                                                                         *
 ***************************************************************************
}
program CheckBox;

{$mode objfpc}{$H+}

uses
  Interfaces, Classes, Stdctrls, Forms, Buttons, Menus, Comctrls,
  SysUtils, ExtCtrls, GraphType, Graphics, Controls;

type
  TForm1 = class(TFORM)
  public
    Button2: TButton;
    Button3: TButton;
    Button11, Button12, Button13 : TSpeedButton; 
    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

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 := TButton.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;

   Button11 := TSpeedButton.Create(Self);
   Button11.GroupIndex:= 1;
   Button11.Layout:= blGlyphTop;
//   Button11.Caption:= 'Option 1';
   Button11.Parent := Self;
   Button11.Left := 5;
   Button11.Top := 5;
   Button11.Width:= 45;
   Button11.Height:= 55;
   Button11.Flat:= true;
   Button11.Glyph.LoadFromFile('../images/btn_newform.xpm');
//   Button11.Spacing:= -1;
//   Button11.Margin:= 4;
   Button11.Visible:= true;
   
   Button12 := TSpeedButton.Create(Self);
   Button12.GroupIndex:= 1;
   Button12.Caption:= '2';
   Button12.Parent := Self;
   Button12.Left := 55;
   Button12.Top := 5;
//   Button12.Flat:= true;
   Button12.Visible:= true;

   Button13 := TSpeedButton.Create(Self);
   Button13.GroupIndex:= 1;
   Button13.Caption:= '3';
   Button13.Parent := Self;
   Button13.Left := 95;
   Button13.Top := 5;
   Button13.Flat:= true;
   Button13.AllowAllUp:= true;
   Button13.Visible:= true;
   

   { 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
  Close;
end;
{------------------------------------------------------------------------------}

begin
   Application.Initialize; { calls InitProcedure which starts up GTK }
   Application.CreateForm(TForm1, Form1);
   Application.Run;
end.