1{
2 *****************************************************************************
3 *                                                                           *
4 *  This file is part of the Lazarus Component Library (LCL)                 *
5 *                                                                           *
6 *  See the file COPYING.LCL, included in this distribution,                 *
7 *  for details about the copyright.                                         *
8 *                                                                           *
9 *  This program is distributed in the hope that it will be useful,          *
10 *  but WITHOUT ANY WARRANTY; without even the implied warranty of           *
11 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                     *
12 *                                                                           *
13 *****************************************************************************
14
15  LCL Test 2_3
16
17  Showing a form at 100,90,350,200
18}
19program Test2_3TwoSimpleForms1;
20
21{$mode objfpc}{$H+}
22
23uses
24  Interfaces, FPCAdds, LCLProc, LCLType, Classes, Controls, Forms, TypInfo,
25  LMessages;
26
27type
28
29  { TForm1And2 }
30
31  TForm1And2 = class(TForm)
32    procedure FormActivate(Sender: TObject);
33    procedure FormChangeBounds(Sender: TObject);
34    procedure FormClick(Sender: TObject);
35    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
36    procedure FormCloseQuery(Sender: TObject; var CanClose: boolean);
37    procedure FormCreate(Sender: TObject);
38    procedure FormDeactivate(Sender: TObject);
39    procedure FormEnter(Sender: TObject);
40    procedure FormExit(Sender: TObject);
41    function FormHelp(Command: Word; Data: PtrInt; var CallHelp: Boolean
42      ): Boolean;
43    procedure FormHide(Sender: TObject);
44    procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
45    procedure FormKeyPress(Sender: TObject; var Key: char);
46    procedure FormMouseDown(Sender: TOBject; Button: TMouseButton;
47      Shift: TShiftState; X, Y: Integer);
48    procedure FormMouseEnter(Sender: TObject);
49    procedure FormMouseLeave(Sender: TObject);
50    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer
51      );
52    procedure FormMouseUp(Sender: TOBject; Button: TMouseButton;
53      Shift: TShiftState; X, Y: Integer);
54    procedure FormMouseWheel(Sender: TObject; Shift: TShiftState;
55      WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
56    procedure FormMouseWheelDown(Sender: TObject; Shift: TShiftState;
57      MousePos: TPoint; var Handled: Boolean);
58    procedure FormMouseWheelUp(Sender: TObject; Shift: TShiftState;
59      MousePos: TPoint; var Handled: Boolean);
60    procedure FormPaint(Sender: TObject);
61    procedure FormResize(Sender: TObject);
62    procedure FormShortcut(var Msg: TLMKey; var Handled: Boolean);
63    procedure FormShow(Sender: TObject);
64    procedure FormUTF8KeyPress(Sender: TObject; var UTF8Key: TUTF8Char);
65  public
66    constructor Create(TheOwner: TComponent); override;
67  end;
68
69var
70  Form1: TForm1And2 = nil;
71  Form2: TForm1And2 = nil;
72
73{ TForm1And2 }
74
75procedure TForm1And2.FormActivate(Sender: TObject);
76begin
77  debugln('TForm1And2.FormActivate ',DbgSName(Sender));
78end;
79
80procedure TForm1And2.FormChangeBounds(Sender: TObject);
81begin
82  debugln('TForm1And2.FormChangeBounds ',DbgSName(Sender),' Bounds=',dbgs(BoundsRect));
83end;
84
85procedure TForm1And2.FormClick(Sender: TObject);
86begin
87  debugln('TForm1And2.FormClick ',DbgSName(Sender));
88end;
89
90procedure TForm1And2.FormClose(Sender: TObject; var CloseAction: TCloseAction);
91begin
92  debugln('TForm1And2.FormClose ',DbgSName(Sender),' CloseAction=',
93          GetEnumName(TypeInfo(TCloseAction),ord(CloseAction)));
94end;
95
96procedure TForm1And2.FormCloseQuery(Sender: TObject; var CanClose: boolean);
97begin
98  debugln('TForm1And2.FormCloseQuery ',DbgSName(Sender),' CanClose',dbgs(CanClose));
99end;
100
101procedure TForm1And2.FormCreate(Sender: TObject);
102begin
103  debugln('TForm1And2.FormCreate ',DbgSName(Sender));
104end;
105
106procedure TForm1And2.FormDeactivate(Sender: TObject);
107begin
108  debugln('TForm1And2.FormDeactivate ',DbgSName(Sender));
109end;
110
111procedure TForm1And2.FormEnter(Sender: TObject);
112begin
113  debugln('TForm1And2.FormEnter ',DbgSName(Sender));
114end;
115
116procedure TForm1And2.FormExit(Sender: TObject);
117begin
118  debugln('TForm1And2.FormExit ',DbgSName(Sender));
119end;
120
121function TForm1And2.FormHelp(Command: Word; Data: PtrInt; var CallHelp: Boolean
122  ): Boolean;
123begin
124  debugln('TForm1And2.FormHelp Command=',dbgs(Command),' Data=',HexStr(Cardinal(Data),8),' CallHelp=',dbgs(CallHelp));
125  Result:=false;
126end;
127
128procedure TForm1And2.FormHide(Sender: TObject);
129begin
130  debugln('TForm1And2.FormHide ',DbgSName(Sender));
131end;
132
133procedure TForm1And2.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState
134  );
135begin
136  Debugln('TForm1And2.FormKeyDown ',DbgSName(Sender),' Key=',dbgs(Key),
137          ' Shift=',dbgs(Shift));
138end;
139
140procedure TForm1And2.FormKeyPress(Sender: TObject; var Key: char);
141begin
142  debugln('TForm1And2.FormKeyPress ',DbgSName(Sender),' Key=',DbgStr(Key));
143end;
144
145procedure TForm1And2.FormMouseDown(Sender: TOBject; Button: TMouseButton;
146  Shift: TShiftState; X, Y: Integer);
147begin
148  debugln('TForm1And2.FormMouseDown ',DbgSName(Sender),
149    ' Button=',GetEnumName(TypeInfo(TMouseButton),ord(Button)),
150    ' X=',dbgs(X),' Y=',dbgs(Y),' Shift=',dbgs(Shift));
151end;
152
153procedure TForm1And2.FormMouseEnter(Sender: TObject);
154begin
155  debugln('TForm1And2.FormMouseEnter ',DbgSName(Sender));
156end;
157
158procedure TForm1And2.FormMouseLeave(Sender: TObject);
159begin
160  debugln('TForm1And2.FormMouseLeave ',DbgSName(Sender));
161end;
162
163procedure TForm1And2.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
164  Y: Integer);
165begin
166  debugln('TForm1And2.FormMouseMove ',DbgSName(Sender),
167    ' X=',dbgs(X),' Y=',dbgs(Y),' Shift=',dbgs(Shift));
168end;
169
170procedure TForm1And2.FormMouseUp(Sender: TOBject; Button: TMouseButton;
171  Shift: TShiftState; X, Y: Integer);
172begin
173  debugln('TForm1And2.FormMouseUp ',DbgSName(Sender),
174    ' Button=',GetEnumName(TypeInfo(TMouseButton),ord(Button)),
175    ' X=',dbgs(X),' Y=',dbgs(Y),' Shift=',dbgs(Shift));
176end;
177
178procedure TForm1And2.FormMouseWheel(Sender: TObject; Shift: TShiftState;
179  WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
180begin
181  debugln('TForm1And2.FormMouseWheel ',DbgSName(Sender),
182    ' WheelDelta=',dbgs(WheelDelta),' MousePos=',dbgs(MousePos),
183    ' Handled=',dbgs(Handled),' Shift=',dbgs(Shift));
184end;
185
186procedure TForm1And2.FormMouseWheelDown(Sender: TObject; Shift: TShiftState;
187  MousePos: TPoint; var Handled: Boolean);
188begin
189  debugln('TForm1And2.FormMouseWheelDown ',DbgSName(Sender),
190    ' MousePos=',dbgs(MousePos),
191    ' Handled=',dbgs(Handled),' Shift=',dbgs(Shift));
192end;
193
194procedure TForm1And2.FormMouseWheelUp(Sender: TObject; Shift: TShiftState;
195  MousePos: TPoint; var Handled: Boolean);
196begin
197  debugln('TForm1And2.FormMouseWheelUp ',DbgSName(Sender),
198    ' MousePos=',dbgs(MousePos),
199    ' Handled=',dbgs(Handled),' Shift=',dbgs(Shift));
200end;
201
202procedure TForm1And2.FormPaint(Sender: TObject);
203begin
204  debugln('TForm1And2.FormPaint ',DbgSName(Sender));
205end;
206
207procedure TForm1And2.FormResize(Sender: TObject);
208begin
209  debugln('TForm1And2.FormResize ',DbgSName(Sender),' Bounds=',dbgs(BoundsRect));
210end;
211
212procedure TForm1And2.FormShortcut(var Msg: TLMKey; var Handled: Boolean);
213begin
214  debugln('TForm1And2.FormShortcut Msg.CharCode=',dbgs(Msg.CharCode),
215          ' Handled=',dbgs(Handled));
216end;
217
218procedure TForm1And2.FormShow(Sender: TObject);
219begin
220  debugln('TForm1And2.FormShow ',DbgSName(Sender));
221end;
222
223procedure TForm1And2.FormUTF8KeyPress(Sender: TObject; var UTF8Key: TUTF8Char);
224begin
225  debugln('TForm1And2.FormUTF8KeyPress ',DbgSName(Sender),' UTF8Key="',DbgStr(UTF8Key),'"');
226end;
227
228constructor TForm1And2.Create(TheOwner: TComponent);
229begin
230  OnActivate:=@FormActivate;
231  OnChangeBounds:=@FormChangeBounds;
232  OnClick:=@FormClick;
233  OnClose:=@FormClose;
234  OnCloseQuery:=@FormCloseQuery;
235  OnCreate:=@FormCreate;
236  OnDeactivate:=@FormDeactivate;
237  OnEnter:=@FormEnter;
238  OnExit:=@FormExit;
239  OnHelp:=@FormHelp;
240  OnHide:=@FormHide;
241  OnKeyDown:=@FormKeyDown;
242  OnKeyDown:=@FormKeyDown;
243  OnKeyPress:=@FormKeyPress;
244  OnMouseDown:=@FormMouseDown;
245  OnMouseEnter:=@FormMouseEnter;
246  OnMouseLeave:=@FormMouseLeave;
247  OnMouseMove:=@FormMouseMove;
248  OnMouseUp:=@FormMouseUp;
249  OnMouseWheel:=@FormMouseWheel;
250  OnMouseWheelDown:=@FormMouseWheelDown;
251  OnMouseWheelUp:=@FormMouseWheelUp;
252  OnPaint:=@FormPaint;
253  OnResize:=@FormResize;
254  OnShortcut:=@FormShortcut;
255  OnShow:=@FormShow;
256  OnUTF8KeyPress:=@FormUTF8KeyPress;
257  inherited Create(TheOwner);
258
259  if Self=Form1 then
260    Name:='Form1'
261  else
262    Name:='Form2';
263  Caption:='Title '+Name;
264  if Name='Form1' then
265    SetBounds(100,90,350,200)
266  else
267    SetBounds(470,90,380,190);
268end;
269
270begin
271  Application.Initialize;
272  Application.CreateForm(TForm1And2,Form1);
273  debugln('Form1.Bounds=',dbgs(Form1.BoundsRect));
274  Application.CreateForm(TForm1And2,Form2);
275  debugln('Form2.Bounds=',dbgs(Form2.BoundsRect));
276  Form2.Show;
277  Application.Run;
278end.
279
280