1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
|
unit gui_form;
{$mode objfpc}{$H+}
interface
uses
Classes,
SysUtils,
gfxbase,
gfx_widget;
type
TWindowPosition = (wpUser, wpAuto, wpScreenCenter);
TfpgForm = class(TfpgWidget)
private
FOnActivate: TNotifyEvent;
FOnClose: TNotifyEvent;
FOnCreate: TNotifyEvent;
FOnDeactivate: TNotifyEvent;
FOnDestroy: TNotifyEvent;
FOnHide: TNotifyEvent;
FOnShow: TNotifyEvent;
protected
FPrevModalForm: TfpgWindowBase;
FModalResult: integer;
FParentForm: TfpgForm;
FWindowPosition: TWindowPosition;
FWindowTitle: string;
FSizeable: boolean;
FBackgroundColor: TfpgColor;
procedure AdjustWindowStyle; override;
procedure SetWindowParameters; override;
procedure SetWindowTitle(const ATitle: string); override;
procedure MsgActivate(var msg: TfpgMessageRec); message FPGM_ACTIVATE;
procedure MsgDeActivate(var msg: TfpgMessageRec); message FPGM_DEACTIVATE;
procedure MsgClose(var msg: TfpgMessageRec); message FPGM_CLOSE;
procedure HandlePaint; override;
procedure HandleClose; virtual;
procedure HandleHide; override;
procedure HandleShow; override;
procedure AfterConstruction; override;
procedure BeforeDestruction; override;
public
constructor Create(AOwner: TComponent); override;
procedure AfterCreate; virtual;
procedure Show;
procedure Hide;
function ShowModal: integer;
procedure Close;
property Sizeable: boolean read FSizeable write FSizeable;
property WindowPosition: TWindowPosition read FWindowPosition write FWindowPosition;
property WindowTitle: string read FWindowTitle write SetWindowTitle;
property ModalResult: integer read FModalResult write FModalResult;
published
{$Note Refactor this to a TfpgCustomForm and only surface it here }
property OnActivate: TNotifyEvent read FOnActivate write FOnActivate;
property OnClose: TNotifyEvent read FOnClose write FOnClose;
property OnCreate: TNotifyEvent read FOnCreate write FOnCreate;
property OnDeactivate: TNotifyEvent read FOnDeactivate write FOnDeactivate;
property OnDestroy: TNotifyEvent read FOnDestroy write FOnDestroy;
property OnHide: TNotifyEvent read FOnHide write FOnHide;
property OnShow: TNotifyEvent read FOnShow write FOnShow;
end;
function WidgetParentForm(wg: TfpgWidget): TfpgForm;
implementation
uses
fpgfx;
function WidgetParentForm(wg: TfpgWidget): TfpgForm;
var
w: TfpgWidget;
begin
w := wg;
while w <> nil do
begin
if w is TfpgForm then
begin
Result := TfpgForm(w);
Exit; //==>
end;
w := w.Parent;
end;
Result := nil;
end;
{ TfpgForm }
procedure TfpgForm.SetWindowTitle(const ATitle: string);
begin
FWindowTitle := ATitle;
inherited SetWindowTitle(ATitle);
end;
procedure TfpgForm.MsgActivate(var msg: TfpgMessageRec);
begin
if (fpgApplication.TopModalForm = nil) or (fpgApplication.TopModalForm = self) then
begin
FocusRootWidget := self;
if ActiveWidget = nil then
ActiveWidget := FindFocusWidget(nil, fsdFirst)
else
ActiveWidget.SetFocus;
end;
if Assigned(FOnActivate) then
FOnActivate(self);
end;
procedure TfpgForm.MsgDeActivate(var msg: TfpgMessageRec);
begin
if ActiveWidget <> nil then
ActiveWidget.KillFocus;
if Assigned(FOnDeactivate) then
FOnDeactivate(self);
end;
procedure TfpgForm.HandlePaint;
begin
Canvas.BeginDraw;
inherited;
Canvas.Clear(FBackgroundColor);
Canvas.EndDraw(0, 0, FWidth, FHeight);
end;
procedure TfpgForm.AdjustWindowStyle;
begin
if fpgApplication.MainForm = nil then
fpgApplication.MainForm := self;
if FWindowPosition = wpAuto then
Include(FWindowAttributes, waAutoPos)
else
Exclude(FWindowAttributes, waAutoPos);
if FWindowPosition = wpScreenCenter then
Include(FWindowAttributes, waScreenCenterPos)
else
Exclude(FWindowAttributes, waScreenCenterPos);
if FSizeable then
Include(FWindowAttributes, waSizeable)
else
Exclude(FWindowAttributes, waSizeable);
end;
procedure TfpgForm.SetWindowParameters;
begin
inherited;
DoSetWindowTitle(FWindowTitle);
end;
constructor TfpgForm.Create(AOwner: TComponent);
begin
inherited;
FWindowPosition := wpUser;
FWindowTitle := '';
FSizeable := True;
FParentForm := nil;
FBackgroundColor := clWindowBackground;
FMinWidth := 32;
FMinHeight := 32;
FModalResult := 0;
FPrevModalForm := nil;
AfterCreate;
end;
procedure TfpgForm.AfterCreate;
begin
// for the user
end;
procedure TfpgForm.Show;
begin
HandleShow;
end;
function TfpgForm.ShowModal: integer;
begin
FPrevModalForm := fpgApplication.TopModalForm;
fpgApplication.TopModalForm := self;
ModalResult := 0;
Show;
// processing messages until this form ends.
// delivering the remaining messages
fpgApplication.ProcessMessages;
repeat
fpgWaitWindowMessage;
until (ModalResult <> 0) or (not Visible);
fpgApplication.TopModalForm := FPrevModalForm;
Result := ModalResult;
end;
procedure TfpgForm.MsgClose(var msg: TfpgMessageRec);
begin
HandleClose;
if Assigned(FOnClose) then
FOnClose(self);
end;
procedure TfpgForm.HandleClose;
begin
Close;
end;
procedure TfpgForm.HandleHide;
begin
inherited HandleHide;
if Assigned(FOnHide) then
FOnHide(self);
end;
procedure TfpgForm.HandleShow;
begin
inherited HandleShow;
if Assigned(FOnShow) then
FOnShow(self);
end;
procedure TfpgForm.AfterConstruction;
begin
inherited AfterConstruction;
if Assigned(FOnCreate) then
FOnCreate(self);
end;
procedure TfpgForm.BeforeDestruction;
begin
inherited BeforeDestruction;
if Assigned(FOnDestroy) then
FOnDestroy(self);
end;
procedure TfpgForm.Hide;
begin
if (fpgApplication.TopModalForm = self) then
fpgApplication.TopModalForm := FPrevModalForm;
HandleHide;
if ModalResult = 0 then
ModalResult := -1;
end;
procedure TfpgForm.Close;
begin
Hide;
if fpgApplication.MainForm = self then
Halt(0);
end;
end.
|
