source: tags/1.3.1/Packages/Common/UPersistentForm.pas

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