1{
2 /***************************************************************************
3                          progressbar - example
4                          ---------------------
5
6                   Just a simple example to show & verify functionality
7                   of the lazarus TTimer / TProgressBar classes.
8
9                   Initial Revision  : Sun Aug 15 1999
10
11                   by Stefan Hille <stoppok@osibisa.ms.sub.org>
12
13 ***************************************************************************/
14
15 ***************************************************************************
16 *                                                                         *
17 *   This source is free software; you can redistribute it and/or modify   *
18 *   it under the terms of the GNU General Public License as published by  *
19 *   the Free Software Foundation; either version 2 of the License, or     *
20 *   (at your option) any later version.                                   *
21 *                                                                         *
22 *   This code is distributed in the hope that it will be useful, but      *
23 *   WITHOUT ANY WARRANTY; without even the implied warranty of            *
24 *   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU     *
25 *   General Public License for more details.                              *
26 *                                                                         *
27 *   A copy of the GNU General Public License is available on the World    *
28 *   Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also      *
29 *   obtain it by writing to the Free Software Foundation,                 *
30 *   Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA.   *
31 *                                                                         *
32 ***************************************************************************
33}
34program Progressbar;
35
36{$mode objfpc}{$H+}
37
38uses
39  Interfaces, Classes, StdCtrls, Forms, Buttons, Menus, ComCtrls,
40  SysUtils, Extctrls;
41
42
43type
44  TForm1 = class(TFORM)
45  public
46    Progre1: TProgressBar;
47    Timer0 : TTimer;
48    Button1: TButton;
49    Button2: TButton;
50    Button3: TButton;
51    Button4: TButton;
52    Button5: TButton;
53    Button6: TButton;
54    Button7: TButton;
55    mnuFile: TMainMenu;
56    itmFileQuit: TMenuItem;
57    constructor Create(AOwner: TComponent); override;
58    procedure LoadMainMenu;
59    procedure mnuQuitClicked(Sender : TObject);
60  protected
61    procedure Button1CLick(Sender : TObject);
62    procedure Button2CLick(Sender : TObject);
63    procedure Button3CLick(Sender : TObject);
64    procedure Button4CLick(Sender : TObject);
65    procedure Button5CLick(Sender : TObject);
66    procedure Button6CLick(Sender : TObject);
67    procedure Button7CLick(Sender : TObject);
68    procedure TimedOut(Sender : TObject);
69  end;
70
71var
72  Form1 : TForm1;
73
74
75constructor TForm1.Create(AOwner: TComponent);
76begin
77   inherited CreateNew(AOwner, 1);
78   Caption := 'ProgressBar Demo v0.1';
79   LoadMainMenu;
80end;
81
82procedure TForm1.Button1Click(Sender : TObject);
83Begin
84   if assigned (progre1) then begin
85        Progre1.Position := 0;
86   	progre1.Min := progre1.Min - 1
87   end;
88End;
89
90procedure TForm1.Button2Click(Sender : TObject);
91Begin
92   if assigned (progre1) then begin
93        Progre1.Position := 0;
94   	progre1.Min := progre1.Min + 1;
95   end;
96End;
97
98procedure TForm1.Button3Click(Sender : TObject);
99Begin
100   if assigned (progre1) then begin
101	Progre1.Position := 0;
102	progre1.Max := progre1.Max +1;
103   end;
104End;
105
106procedure TForm1.Button4Click(Sender : TObject);
107Begin
108   if assigned (progre1) then begin
109        Progre1.Position := 0;
110	progre1.Max := progre1.Max -1;
111   end;
112End;
113
114procedure TForm1.Button5Click(Sender : TObject);
115Begin
116   if assigned (progre1) then begin
117        Progre1.Smooth := not Progre1.Smooth;
118	if assigned (Button6)
119	  then Button6.Visible := Progre1.Smooth;
120   end;
121End;
122
123procedure TForm1.Button6Click(Sender : TObject);
124Begin
125   if assigned (progre1) then begin
126        Progre1.BarShowtext := not Progre1.BarShowtext;
127   end;
128End;
129
130procedure TForm1.Button7Click(Sender : TObject);
131Begin
132   if assigned (progre1) then
133   begin
134     case Progre1.Orientation of
135        pbVertical      : Progre1.Orientation := pbRightToLeft;
136        pbRightToLeft   : Progre1.Orientation := pbTopDown;
137	pbTopDown       : Progre1.Orientation := pbHorizontal;
138        pbHorizontal    : Progre1.Orientation := pbVertical;
139     end;
140   end;
141End;
142
143procedure TForm1.TimedOut(Sender : TObject);
144Begin
145   if assigned (progre1) then
146   begin
147      Progre1.StepIt;
148      if Progre1.Position = Progre1.Max
149         then Progre1.Position := Progre1.min;
150   end;
151End;
152
153{------------------------------------------------------------------------------}
154procedure TForm1.LoadMainMenu;
155
156begin
157	{ set the height and width }
158	Height := 350;
159	Width := 700;
160
161	{ Create the timer }
162	Timer0 := TTimer.Create (Self);
163	Timer0.OnTimer := @TimedOut;
164
165	{ Create a progressbar }
166	Progre1 := TProgressBar.Create (Self);
167	Progre1.Parent := Self;
168	Progre1.Left := 300;
169	Progre1.Top  := 30;
170	Progre1.Width:= 250;
171	Progre1.Height:= 40;
172	Progre1.BarShowText := true;
173	Progre1.Smooth := True;
174	Progre1.Show;
175
176
177	{ Create a few buttons }
178	Button2 := TButton.Create(Self);
179	Button2.Parent := Self;
180	Button2.Left := 200;
181	Button2.Top := 70;
182	Button2.Width := 80;
183	Button2.Height := 30;
184	Button2.Show;
185	Button2.Caption := 'PMin ++';
186//	Button2.ToolTip := 'Tool Tip';
187//	Button2.ShowToolTip := True;
188	Button2.OnClick := @Button2Click;
189
190
191	Button1 := TButton.Create(Self);
192	Button1.Parent := Self;
193	Button1.Left := 50;
194	Button1.Top := 70;
195	Button1.Width := 80;
196	Button1.Height := 30;
197	Button1.Show;
198	Button1.Caption := 'PMin--';
199	Button1.OnClick := @Button1Click;
200
201	{ Create 2 more buttons outside the groupbox }
202	Button3 := TButton.Create(Self);
203	Button3.Parent := Self;
204	Button3.Left := 50;
205	Button3.Top := 30;
206	Button3.Width := 80;
207	Button3.Height := 30;
208	Button3.Show;
209	Button3.Caption := 'PMax++';
210//	Button3.ToolTip := 'Tool Tip';
211//	Button3.ShowToolTip := True;
212	Button3.OnClick := @Button3Click;
213
214	Button4 := TButton.Create(Self);
215	Button4.Parent := Self;
216	Button4.Left := 200;
217	Button4.Top := 30;
218	Button4.Width := 80;
219	Button4.Height := 30;
220	Button4.Show;
221	Button4.Caption := 'PMax--';
222	Button4.OnClick := @Button4Click;
223
224	Button5 := TButton.Create(Self);
225	Button5.Parent := Self;
226	Button5.Left := 100;
227	Button5.Top := 110;
228	Button5.Width := 130;
229	Button5.Height := 30;
230	Button5.Show;
231	Button5.Caption := 'Toggle Smooth';
232	Button5.OnClick := @Button5Click;
233
234	Button6 := TButton.Create(Self);
235	Button6.Parent := Self;
236	Button6.Left := 100;
237	Button6.Top := 150;
238	Button6.Width := 130;
239	Button6.Height := 30;
240	Button6.Show;
241	Button6.Caption := 'Toggle Text';
242	Button6.OnClick := @Button6Click;
243	Button6.Visible := Progre1.Smooth;
244
245	Button7 := TButton.Create(Self);
246	Button7.Parent := Self;
247	Button7.Left := 100;
248	Button7.Top := 190;
249	Button7.Width := 130;
250	Button7.Height := 30;
251	Button7.Show;
252	Button7.Caption := 'Orientation';
253	Button7.OnClick := @Button7Click;
254
255	{ create a menubar }
256	mnuFile := TMainMenu.Create(Self);
257        mnuFile.Name:='mnuFile';
258        Menu := mnuFile;
259
260	itmFileQuit := TMenuItem.Create(Self);
261	itmFileQuit.Caption := 'Quit';
262	itmFileQuit.OnClick := @mnuQuitClicked;
263	mnuFile.Items.Add(itmFileQuit);
264
265end;
266
267{------------------------------------------------------------------------------}
268procedure TForm1.mnuQuitClicked(Sender : TObject);
269begin
270  Close;
271end;
272{------------------------------------------------------------------------------}
273
274begin
275   Application.Initialize; { calls InitProcedure which starts up GTK }
276   Application.CreateForm(TForm1, Form1);
277   Application.Run;
278end.
279
280