1{ $Id$ } 2{ 3 /*************************************************************************** 4 5 6 Initial Revision : Sun Mar 28 23:15:32 CST 1999 7 8 9 ***************************************************************************/ 10 11 *************************************************************************** 12 * * 13 * This source is free software; you can redistribute it and/or modify * 14 * it under the terms of the GNU General Public License as published by * 15 * the Free Software Foundation; either version 2 of the License, or * 16 * (at your option) any later version. * 17 * * 18 * This code is distributed in the hope that it will be useful, but * 19 * WITHOUT ANY WARRANTY; without even the implied warranty of * 20 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * 21 * General Public License for more details. * 22 * * 23 * A copy of the GNU General Public License is available on the World * 24 * Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also * 25 * obtain it by writing to the Free Software Foundation, * 26 * Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA. * 27 * * 28 *************************************************************************** 29} 30program GroupBox; 31 32{$mode objfpc}{$H+} 33 34uses 35 Interfaces, Classes, StdCtrls, Forms, Buttons, Menus, ComCtrls, SysUtils; 36 37type 38 TForm1 = class(TFORM) 39 public 40 Button1: TButton; 41 Button2: TButton; 42 Button3: TButton; 43 Button4: TButton; 44 grpTst : TGroupBox; 45 mnuFile: TMainMenu; 46 itmFileQuit: TMenuItem; 47 CheckBox1: TCheckBox; 48 constructor Create(AOwner: TComponent); override; 49 procedure LoadMainMenu; 50 procedure mnuQuitClicked(Sender : TObject); 51 protected 52 procedure Button1CLick(Sender : TObject); 53 procedure Button2CLick(Sender : TObject); 54 procedure Button3CLick(Sender : TObject); 55 procedure Button4CLick(Sender : TObject); 56 end; 57 58var Form1 : TForm1; 59 60constructor TForm1.Create(AOwner: TComponent); 61begin 62 inherited CreateNew(AOwner, 1); 63 Caption := 'Groubox Demo v0.1'; 64 LoadMainMenu; 65end; 66 67procedure TForm1.Button1Click(Sender : TObject); 68Begin 69 if assigned (grpTst) then grpTst.Height := grpTst.Height + 10; 70End; 71 72procedure TForm1.Button2Click(Sender : TObject); 73Begin 74 if assigned (grpTst) then begin 75 grpTst.Width := grpTst.Width + 10; 76 grpTst.Show; 77 end; 78End; 79 80procedure TForm1.Button3Click(Sender : TObject); 81Begin 82 if assigned (grpTst) then begin 83 grpTst.Show; 84 end; 85End; 86 87procedure TForm1.Button4Click(Sender : TObject); 88Begin 89 if assigned (grpTst) then begin 90 grpTst.Hide; 91 end; 92End; 93 94{------------------------------------------------------------------------------} 95 96{------------------------------------------------------------------------------} 97procedure TForm1.LoadMainMenu; 98begin 99 { set the height and width } 100 Height := 350; 101 Width := 350; 102 103 { Create a groupbox } 104 grpTst := TGroupBox.Create(Self); 105 with grpTst do begin 106 Name:='grpTst'; 107 Parent := self; 108 top := 70; 109 left := 10; 110 Height :=200; 111 Width := 300; 112 Caption := 'Groupbox with 2 Buttons'; 113 end; 114 115 { Create 2 buttons inside the groupbox } 116 if assigned (grpTst) then 117 begin 118 Button2 := TButton.Create(grpTst); 119 Button2.Parent := grpTst; 120 121 Checkbox1 := TCheckBox.Create(grpTst); 122 Checkbox1.Parent := grpTst; 123 Checkbox1.Name:='Checkbox1'; 124 Checkbox1.Left := 200; 125 Checkbox1.Top := 100; 126 Checkbox1.Width := 80; 127 Checkbox1.Height := 30; 128 Checkbox1.Caption := 'Checkbox 1'; 129 end 130 else begin 131 Button2 := TButton.Create(Self); 132 Button2.Parent := Self; 133 end; 134 Button2.Name:='Button2'; 135 Button2.Left := 200; 136 Button2.Top := 50; 137 Button2.Width := 80; 138 Button2.Height := 30; 139 Button2.Caption := 'Width ++'; 140 Button2.OnClick := @Button2Click; 141 142 143 if assigned (grpTst) then 144 begin 145 Button1 := TButton.Create(grpTst); 146 Button1.Parent := grpTst; 147 end 148 else begin 149 Button1 := TButton.Create(Self); 150 Button1.Parent := Self; 151 end; 152 Button1.Name:='Button1'; 153 Button1.Left := 50; 154 Button1.Top := 50; 155 Button1.Width := 80; 156 Button1.Height := 30; 157 Button1.Caption := 'Height++'; 158 Button1.OnClick := @Button1Click; 159 160 { Create 2 more buttons outside the groupbox } 161 Button3 := TButton.Create(Self); 162 Button3.Name:='Button3'; 163 Button3.Parent := Self; 164 Button3.Left := 50; 165 Button3.Top := 30; 166 Button3.Width := 80; 167 Button3.Height := 30; 168 Button3.Caption := 'Show'; 169 Button3.OnClick := @Button3Click; 170 171 Button4 := TButton.Create(Self); 172 Button4.Name:='Button4'; 173 Button4.Parent := Self; 174 Button4.Left := 200; 175 Button4.Top := 30; 176 Button4.Width := 80; 177 Button4.Height := 30; 178 Button4.Caption := 'Hide'; 179 Button4.OnClick := @Button4Click; 180 181 mnuFile := TMainMenu.Create(Self); 182 183 itmFileQuit := TMenuItem.Create(Self); 184 itmFileQuit.Caption := 'Quit'; 185 itmFileQuit.OnClick := @mnuQuitClicked; 186 mnuFile.Items.Add(itmFileQuit); 187end; 188 189{------------------------------------------------------------------------------} 190procedure TForm1.mnuQuitClicked(Sender : TObject); 191begin 192 Close; 193end; 194{------------------------------------------------------------------------------} 195 196begin 197 Application.Initialize; { calls InitProcedure which starts up GTK } 198 Application.CreateForm(TForm1, Form1); 199 Application.Run; 200end. 201 202