source: branches/xpascal/Packages/Common/PersistentForm.pas

Last change on this file was 227, checked in by chronos, 17 months ago
  • Added: Test form.
  • Added: Interface translation.
  • Added: Common package.
File size: 11.1 KB
Line 
1unit PersistentForm;
2
3interface
4
5uses
6 Classes, SysUtils, Forms, RegistryEx, LCLIntf, Registry, Controls, ComCtrls,
7 ExtCtrls, LCLType;
8
9type
10
11 { TPersistentForm }
12
13 TPersistentForm = class(TComponent)
14 private
15 FEntireVisible: Boolean;
16 FMinVisiblePart: Integer;
17 FRegistryContext: TRegistryContext;
18 procedure LoadControl(Control: TControl);
19 procedure SaveControl(Control: TControl);
20 public
21 FormRestoredSize: TRect;
22 FormWindowState: TWindowState;
23 FormFullScreen: Boolean;
24 Form: TForm;
25 procedure LoadFromRegistry(RegistryContext: TRegistryContext);
26 procedure SaveToRegistry(RegistryContext: TRegistryContext);
27 function CheckEntireVisible(Rect: TRect): TRect;
28 function CheckPartVisible(Rect: TRect; Part: Integer): TRect;
29 procedure Load(Form: TForm; DefaultMaximized: Boolean = False;
30 DefaultFullScreen: Boolean = False);
31 procedure Save(Form: TForm);
32 constructor Create(AOwner: TComponent); override;
33 procedure SetFullScreen(State: Boolean);
34 property RegistryContext: TRegistryContext read FRegistryContext
35 write FRegistryContext;
36 published
37 property MinVisiblePart: Integer read FMinVisiblePart write FMinVisiblePart;
38 property EntireVisible: Boolean read FEntireVisible write FEntireVisible;
39 end;
40
41procedure Register;
42
43
44implementation
45
46procedure Register;
47begin
48 RegisterComponents('Common', [TPersistentForm]);
49end;
50
51{ TPersistentForm }
52
53procedure TPersistentForm.LoadControl(Control: TControl);
54var
55 I: Integer;
56 WinControl: TWinControl;
57begin
58 if Control is TListView then begin
59 with Form, TRegistryEx.Create do
60 try
61 RootKey := RegistryContext.RootKey;
62 OpenKey(RegistryContext.Key + '\Forms\' + Form.Name + '\' + Control.Name, True);
63 for I := 0 to TListView(Control).Columns.Count - 1 do begin
64 if ValueExists('ColWidth' + IntToStr(I)) then
65 TListView(Control).Columns[I].Width := ReadInteger('ColWidth' + IntToStr(I));
66 end;
67 finally
68 Free;
69 end;
70 end;
71
72 if (Control is TPanel) then begin
73 with Form, TRegistryEx.Create do
74 try
75 RootKey := RegistryContext.RootKey;
76 OpenKey(RegistryContext.Key + '\Forms\' + Form.Name + '\' + Control.Name, True);
77 if (TPanel(Control).Align = alRight) or (TPanel(Control).Align = alLeft) then begin
78 if ValueExists('Width') then
79 TPanel(Control).Width := ReadInteger('Width');
80 end;
81 if (TPanel(Control).Align = alTop) or (TPanel(Control).Align = alBottom) then begin
82 if ValueExists('Height') then
83 TPanel(Control).Height := ReadInteger('Height');
84 end;
85 finally
86 Free;
87 end;
88 end;
89
90 if Control is TWinControl then begin
91 WinControl := TWinControl(Control);
92 if WinControl.ControlCount > 0 then begin
93 for I := 0 to WinControl.ControlCount - 1 do begin
94 if WinControl.Controls[I] is TControl then begin
95 LoadControl(WinControl.Controls[I]);
96 end;
97 end;
98 end;
99 end;
100end;
101
102procedure TPersistentForm.SaveControl(Control: TControl);
103var
104 I: Integer;
105 WinControl: TWinControl;
106begin
107 if Control is TListView then begin
108 with Form, TRegistryEx.Create do
109 try
110 RootKey := RegistryContext.RootKey;
111 OpenKey(RegistryContext.Key + '\Forms\' + Form.Name + '\' + Control.Name, True);
112 for I := 0 to TListView(Control).Columns.Count - 1 do begin
113 WriteInteger('ColWidth' + IntToStr(I), TListView(Control).Columns[I].Width);
114 end;
115 finally
116 Free;
117 end;
118 end;
119
120 if (Control is TPanel) then begin
121 with Form, TRegistryEx.Create do
122 try
123 RootKey := RegistryContext.RootKey;
124 OpenKey(RegistryContext.Key + '\Forms\' + Form.Name + '\' + Control.Name, True);
125 if (TPanel(Control).Align = alRight) or (TPanel(Control).Align = alLeft) then begin
126 WriteInteger('Width', TPanel(Control).Width);
127 end;
128 if (TPanel(Control).Align = alTop) or (TPanel(Control).Align = alBottom) then begin
129 WriteInteger('Height', TPanel(Control).Height);
130 end;
131 finally
132 Free;
133 end;
134 end;
135
136 if Control is TWinControl then begin
137 WinControl := TWinControl(Control);
138 if WinControl.ControlCount > 0 then begin
139 for I := 0 to WinControl.ControlCount - 1 do begin
140 if WinControl.Controls[I] is TControl then begin
141 SaveControl(WinControl.Controls[I]);
142 end;
143 end;
144 end;
145 end;
146end;
147
148procedure TPersistentForm.LoadFromRegistry(RegistryContext: TRegistryContext);
149begin
150 with TRegistryEx.Create do
151 try
152 RootKey := RegistryContext.RootKey;
153 OpenKey(RegistryContext.Key + '\Forms\' + Form.Name, True);
154
155 // Restored size
156 FormRestoredSize.Left := ReadIntegerWithDefault('RestoredLeft', FormRestoredSize.Left);
157 FormRestoredSize.Top := ReadIntegerWithDefault('RestoredTop', FormRestoredSize.Top);
158 FormRestoredSize.Right := ReadIntegerWithDefault('RestoredWidth', FormRestoredSize.Right - FormRestoredSize.Left)
159 + FormRestoredSize.Left;
160 FormRestoredSize.Bottom := ReadIntegerWithDefault('RestoredHeight', FormRestoredSize.Bottom - FormRestoredSize.Top)
161 + FormRestoredSize.Top;
162
163 // Other state
164 FormWindowState := TWindowState(ReadIntegerWithDefault('WindowState', Integer(FormWindowState)));
165 FormFullScreen := ReadBoolWithDefault('FullScreen', FormFullScreen);
166 finally
167 Free;
168 end;
169end;
170
171procedure TPersistentForm.SaveToRegistry(RegistryContext: TRegistryContext);
172begin
173 with Form, TRegistryEx.Create do
174 try
175 RootKey := RegistryContext.RootKey;
176 OpenKey(RegistryContext.Key + '\Forms\' + Form.Name, True);
177
178 // Restored size
179 WriteInteger('RestoredWidth', FormRestoredSize.Right - FormRestoredSize.Left);
180 WriteInteger('RestoredHeight', FormRestoredSize.Bottom - FormRestoredSize.Top);
181 WriteInteger('RestoredTop', FormRestoredSize.Top);
182 WriteInteger('RestoredLeft', FormRestoredSize.Left);
183
184 // Other state
185 WriteInteger('WindowState', Integer(FormWindowState));
186 WriteBool('FullScreen', FormFullScreen);
187 finally
188 Free;
189 end;
190end;
191
192function TPersistentForm.CheckEntireVisible(Rect: TRect): TRect;
193var
194 Width: Integer;
195 Height: Integer;
196begin
197 Result := Rect;
198 Width := Rect.Right - Rect.Left;
199 Height := Rect.Bottom - Rect.Top;
200 if Result.Left < (Screen.DesktopLeft) then begin
201 Result.Left := Screen.DesktopLeft;
202 Result.Right := Screen.DesktopLeft + Width;
203 end;
204 if Result.Right > (Screen.DesktopLeft + Screen.DesktopWidth) then begin
205 Result.Left := Screen.DesktopLeft + Screen.DesktopWidth - Width;
206 Result.Right := Screen.DesktopLeft + Screen.DesktopWidth;
207 end;
208 if Result.Top < Screen.DesktopTop then begin
209 Result.Top := Screen.DesktopTop;
210 Result.Bottom := Screen.DesktopTop + Height;
211 end;
212 if Result.Bottom > (Screen.DesktopTop + Screen.DesktopHeight) then begin
213 Result.Top := Screen.DesktopTop + Screen.DesktopHeight - Height;
214 Result.Bottom := Screen.DesktopTop + Screen.DesktopHeight;
215 end;
216end;
217
218function TPersistentForm.CheckPartVisible(Rect: TRect; Part: Integer): TRect;
219var
220 Width: Integer;
221 Height: Integer;
222begin
223 Result := Rect;
224 Width := Rect.Right - Rect.Left;
225 Height := Rect.Bottom - Rect.Top;
226 if Result.Right < (Screen.DesktopLeft + Part) then begin
227 Result.Left := Screen.DesktopLeft + Part - Width;
228 Result.Right := Screen.DesktopLeft + Part;
229 end;
230 if Result.Left > (Screen.DesktopLeft + Screen.DesktopWidth - Part) then begin
231 Result.Left := Screen.DesktopLeft + Screen.DesktopWidth - Part;
232 Result.Right := Screen.DesktopLeft + Screen.DesktopWidth - Part + Width;
233 end;
234 if Result.Bottom < (Screen.DesktopTop + Part) then begin
235 Result.Top := Screen.DesktopTop + Part - Height;
236 Result.Bottom := Screen.DesktopTop + Part;
237 end;
238 if Result.Top > (Screen.DesktopTop + Screen.DesktopHeight - Part) then begin
239 Result.Top := Screen.DesktopTop + Screen.DesktopHeight - Part;
240 Result.Bottom := Screen.DesktopTop + Screen.DesktopHeight - Part + Height;
241 end;
242end;
243
244procedure TPersistentForm.Load(Form: TForm; DefaultMaximized: Boolean = False;
245 DefaultFullScreen: Boolean = False);
246begin
247 Self.Form := Form;
248
249 // Set default
250 FormRestoredSize := Bounds((Screen.Width - Form.Width) div 2,
251 (Screen.Height - Form.Height) div 2, Form.Width, Form.Height);
252 FormWindowState := Form.WindowState;
253 FormFullScreen := DefaultFullScreen;
254
255 LoadFromRegistry(RegistryContext);
256
257 if (FormWindowState = wsMaximized) or DefaultMaximized then begin
258 // Restore to maximized state
259 Form.WindowState := wsNormal;
260 if not EqualRect(FormRestoredSize, Form.BoundsRect) then
261 Form.BoundsRect := FormRestoredSize;
262 Form.WindowState := wsMaximized;
263 end else begin
264 // Restore to normal state
265 Form.WindowState := wsNormal;
266 if FEntireVisible then FormRestoredSize := CheckEntireVisible(FormRestoredSize)
267 else if FMinVisiblePart > 0 then
268 FormRestoredSize := CheckPartVisible(FormRestoredSize, FMinVisiblePart);
269 if not EqualRect(FormRestoredSize, Form.BoundsRect) then
270 Form.BoundsRect := FormRestoredSize;
271 end;
272 if FormFullScreen then SetFullScreen(True);
273 LoadControl(Form);
274end;
275
276procedure TPersistentForm.Save(Form: TForm);
277begin
278 Self.Form := Form;
279 if not FormFullScreen then begin
280 FormWindowState := Form.WindowState;
281 if FormWindowState = wsMaximized then begin
282 FormRestoredSize := Bounds(Form.RestoredLeft, Form.RestoredTop, Form.RestoredWidth,
283 Form.RestoredHeight);
284 end else
285 if FormWindowState = wsNormal then begin
286 FormRestoredSize := Bounds(Form.Left, Form.Top, Form.Width, Form.Height);
287 end;
288 end;
289 SaveToRegistry(RegistryContext);
290 SaveControl(Form);
291end;
292
293constructor TPersistentForm.Create(AOwner: TComponent);
294begin
295 inherited;
296 if AOwner is TForm then Form := TForm(AOwner)
297 else Form := nil;
298 FMinVisiblePart := 50;
299 FRegistryContext.RootKey := HKEY_CURRENT_USER;
300end;
301
302procedure TPersistentForm.SetFullScreen(State: Boolean);
303begin
304 if State then begin
305 FormFullScreen := True;
306 if Form.WindowState = wsMaximized then begin
307 FormRestoredSize := Bounds(Form.RestoredLeft, Form.RestoredTop, Form.RestoredWidth,
308 Form.RestoredHeight);
309 end else
310 if Form.WindowState = wsNormal then begin
311 FormRestoredSize := Bounds(Form.Left, Form.Top, Form.Width, Form.Height);
312 end;
313 FormWindowState := Form.WindowState;
314 Form.WindowState := wsMaximized;
315 Form.WindowState := wsNormal;
316 ShowWindow(Form.Handle, SW_SHOWFULLSCREEN);
317 {$IFDEF WINDOWS}
318 Form.BorderStyle := bsNone;
319 {$ENDIF}
320 end else begin
321 FormFullScreen := False;
322 {$IFDEF WINDOWS}
323 Form.BorderStyle := bsSizeable;
324 {$ENDIF}
325 ShowWindow(Form.Handle, SW_SHOWNORMAL);
326 if FormWindowState = wsNormal then begin
327 Form.WindowState := wsNormal;
328 Form.BoundsRect := FormRestoredSize;
329 end else
330 if FormWindowState = wsMaximized then begin
331 Form.BoundsRect := FormRestoredSize;
332 Form.WindowState := wsMaximized;
333 end;
334 end;
335end;
336
337end.
Note: See TracBrowser for help on using the repository browser.