source: trunk/Packages/Common/UPersistentForm.pas

Last change on this file was 19, checked in by chronos, 7 years ago
  • Fixed: Build under Lazarus 1.8.0.
  • Modified: Updated Common package.
File size: 9.2 KB
Line 
1unit UPersistentForm;
2
3{$mode delphi}
4
5// Date: 2015-04-18
6
7interface
8
9uses
10 Classes, SysUtils, Forms, URegistry, LCLIntf, Registry, Controls, ComCtrls;
11
12type
13
14 { TPersistentForm }
15
16 TPersistentForm = class(TComponent)
17 private
18 FEntireVisible: Boolean;
19 FMinVisiblePart: Integer;
20 FRegistryContext: TRegistryContext;
21 procedure LoadControl(Control: TControl);
22 procedure SaveControl(Control: TControl);
23 public
24 FormNormalSize: TRect;
25 FormRestoredSize: TRect;
26 FormWindowState: TWindowState;
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 procedure Save(Form: TForm);
34 constructor Create(AOwner: TComponent); override;
35 property RegistryContext: TRegistryContext read FRegistryContext
36 write FRegistryContext;
37 published
38 property MinVisiblePart: Integer read FMinVisiblePart write FMinVisiblePart;
39 property EntireVisible: Boolean read FEntireVisible write FEntireVisible;
40 end;
41
42procedure Register;
43
44implementation
45
46
47procedure Register;
48begin
49 RegisterComponents('Common', [TPersistentForm]);
50end;
51
52{ TPersistentForm }
53
54procedure TPersistentForm.LoadControl(Control: TControl);
55var
56 I: Integer;
57 WinControl: TWinControl;
58 Count: Integer;
59begin
60 if Control is TListView then begin
61 with Form, TRegistryEx.Create do
62 try
63 RootKey := RegistryContext.RootKey;
64 OpenKey(RegistryContext.Key + '\Forms\' + Form.Name + '\' + Control.Name, True);
65 for I := 0 to TListView(Control).Columns.Count - 1 do begin
66 if ValueExists('ColWidth' + IntToStr(I)) then
67 TListView(Control).Columns[I].Width := ReadInteger('ColWidth' + IntToStr(I));
68 end;
69 finally
70 Free;
71 end;
72 end;
73
74 if Control is TWinControl then begin
75 WinControl := TWinControl(Control);
76 if WinControl.ControlCount > 0 then begin
77 for I := 0 to WinControl.ControlCount - 1 do begin
78 if WinControl.Controls[I] is TControl then begin
79 LoadControl(WinControl.Controls[I]);
80 end;
81 end;
82 end;
83 end;
84end;
85
86procedure TPersistentForm.SaveControl(Control: TControl);
87var
88 I: Integer;
89 WinControl: TWinControl;
90begin
91 if Control is TListView then begin
92 with Form, TRegistryEx.Create do
93 try
94 RootKey := RegistryContext.RootKey;
95 OpenKey(RegistryContext.Key + '\Forms\' + Form.Name + '\' + Control.Name, True);
96 for I := 0 to TListView(Control).Columns.Count - 1 do begin
97 WriteInteger('ColWidth' + IntToStr(I), TListView(Control).Columns[I].Width);
98 end;
99 finally
100 Free;
101 end;
102 end;
103
104 if Control is TWinControl then begin
105 WinControl := TWinControl(Control);
106 if WinControl.ControlCount > 0 then begin
107 for I := 0 to WinControl.ControlCount - 1 do begin
108 if WinControl.Controls[I] is TControl then begin
109 SaveControl(WinControl.Controls[I]);
110 end;
111 end;
112 end;
113 end;
114end;
115
116procedure TPersistentForm.LoadFromRegistry(RegistryContext: TRegistryContext);
117begin
118 with TRegistryEx.Create do
119 try
120 RootKey := RegistryContext.RootKey;
121 OpenKey(RegistryContext.Key + '\Forms\' + Form.Name, True);
122 // Normal size
123 FormNormalSize.Left := ReadIntegerWithDefault('NormalLeft', FormNormalSize.Left);
124 FormNormalSize.Top := ReadIntegerWithDefault('NormalTop', FormNormalSize.Top);
125 FormNormalSize.Right := ReadIntegerWithDefault('NormalWidth', FormNormalSize.Right - FormNormalSize.Left)
126 + FormNormalSize.Left;
127 FormNormalSize.Bottom := ReadIntegerWithDefault('NormalHeight', FormNormalSize.Bottom - FormNormalSize.Top)
128 + FormNormalSize.Top;
129 // Restored size
130 FormRestoredSize.Left := ReadIntegerWithDefault('RestoredLeft', FormRestoredSize.Left);
131 FormRestoredSize.Top := ReadIntegerWithDefault('RestoredTop', FormRestoredSize.Top);
132 FormRestoredSize.Right := ReadIntegerWithDefault('RestoredWidth', FormRestoredSize.Right - FormRestoredSize.Left)
133 + FormRestoredSize.Left;
134 FormRestoredSize.Bottom := ReadIntegerWithDefault('RestoredHeight', FormRestoredSize.Bottom - FormRestoredSize.Top)
135 + FormRestoredSize.Top;
136 // Other state
137 FormWindowState := TWindowState(ReadIntegerWithDefault('WindowState', Integer(wsNormal)));
138 finally
139 Free;
140 end;
141end;
142
143procedure TPersistentForm.SaveToRegistry(RegistryContext: TRegistryContext);
144begin
145 with Form, TRegistryEx.Create do
146 try
147 RootKey := RegistryContext.RootKey;
148 OpenKey(RegistryContext.Key + '\Forms\' + Form.Name, True);
149 // Normal state
150 WriteInteger('NormalWidth', FormNormalSize.Right - FormNormalSize.Left);
151 WriteInteger('NormalHeight', FormNormalSize.Bottom - FormNormalSize.Top);
152 WriteInteger('NormalTop', FormNormalSize.Top);
153 WriteInteger('NormalLeft', FormNormalSize.Left);
154 // Restored state
155 WriteInteger('RestoredWidth', FormRestoredSize.Right - FormRestoredSize.Left);
156 WriteInteger('RestoredHeight', FormRestoredSize.Bottom - FormRestoredSize.Top);
157 WriteInteger('RestoredTop', FormRestoredSize.Top);
158 WriteInteger('RestoredLeft', FormRestoredSize.Left);
159 // Other state
160 WriteInteger('WindowState', Integer(FormWindowState));
161 finally
162 Free;
163 end;
164end;
165
166function TPersistentForm.CheckEntireVisible(Rect: TRect): TRect;
167var
168 Width: Integer;
169 Height: Integer;
170begin
171 Result := Rect;
172 Width := Rect.Right - Rect.Left;
173 Height := Rect.Bottom - Rect.Top;
174 if Result.Left < (Screen.DesktopLeft) then begin
175 Result.Left := Screen.DesktopLeft;
176 Result.Right := Screen.DesktopLeft + Width;
177 end;
178 if Result.Right > (Screen.DesktopLeft + Screen.DesktopWidth) then begin
179 Result.Left := Screen.DesktopLeft + Screen.DesktopWidth - Width;
180 Result.Right := Screen.DesktopLeft + Screen.DesktopWidth;
181 end;
182 if Result.Top < Screen.DesktopTop then begin
183 Result.Top := Screen.DesktopTop;
184 Result.Bottom := Screen.DesktopTop + Height;
185 end;
186 if Result.Bottom > (Screen.DesktopTop + Screen.DesktopHeight) then begin
187 Result.Top := Screen.DesktopTop + Screen.DesktopHeight - Height;
188 Result.Bottom := Screen.DesktopTop + Screen.DesktopHeight;
189 end;
190end;
191
192function TPersistentForm.CheckPartVisible(Rect: TRect; Part: Integer): 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.Right < (Screen.DesktopLeft + Part) then begin
201 Result.Left := Screen.DesktopLeft + Part - Width;
202 Result.Right := Screen.DesktopLeft + Part;
203 end;
204 if Result.Left > (Screen.DesktopLeft + Screen.DesktopWidth - Part) then begin
205 Result.Left := Screen.DesktopLeft + Screen.DesktopWidth - Part;
206 Result.Right := Screen.DesktopLeft + Screen.DesktopWidth - Part + Width;
207 end;
208 if Result.Bottom < (Screen.DesktopTop + Part) then begin
209 Result.Top := Screen.DesktopTop + Part - Height;
210 Result.Bottom := Screen.DesktopTop + Part;
211 end;
212 if Result.Top > (Screen.DesktopTop + Screen.DesktopHeight - Part) then begin
213 Result.Top := Screen.DesktopTop + Screen.DesktopHeight - Part;
214 Result.Bottom := Screen.DesktopTop + Screen.DesktopHeight - Part + Height;
215 end;
216end;
217
218procedure TPersistentForm.Load(Form: TForm; DefaultMaximized: Boolean = False);
219var
220 LoadDefaults: Boolean;
221begin
222 Self.Form := Form;
223 // Set default
224 FormNormalSize := Bounds((Screen.Width - Form.Width) div 2,
225 (Screen.Height - Form.Height) div 2, Form.Width, Form.Height);
226 FormRestoredSize := Bounds((Screen.Width - Form.Width) div 2,
227 (Screen.Height - Form.Height) div 2, Form.Width, Form.Height);
228
229 LoadFromRegistry(RegistryContext);
230
231 if not EqualRect(FormNormalSize, FormRestoredSize) or
232 (LoadDefaults and DefaultMaximized) then begin
233 // Restore to maximized state
234 Form.WindowState := wsNormal;
235 if not EqualRect(FormRestoredSize, Form.BoundsRect) then
236 Form.BoundsRect := FormRestoredSize;
237 Form.WindowState := wsMaximized;
238 end else begin
239 // Restore to normal state
240 Form.WindowState := wsNormal;
241 if FEntireVisible then FormNormalSize := CheckEntireVisible(FormNormalSize)
242 else if FMinVisiblePart > 0 then
243 FormNormalSize := CheckPartVisible(FormNormalSize, FMinVisiblePart);
244 if not EqualRect(FormNormalSize, Form.BoundsRect) then
245 Form.BoundsRect := FormNormalSize;
246 end;
247 LoadControl(Form);
248end;
249
250procedure TPersistentForm.Save(Form: TForm);
251begin
252 Self.Form := Form;
253 FormNormalSize := Bounds(Form.Left, Form.Top, Form.Width, Form.Height);
254 FormRestoredSize := Bounds(Form.RestoredLeft, Form.RestoredTop, Form.RestoredWidth,
255 Form.RestoredHeight);
256 FormWindowState := Form.WindowState;
257 SaveToRegistry(RegistryContext);
258 SaveControl(Form);
259end;
260
261constructor TPersistentForm.Create(AOwner: TComponent);
262begin
263 inherited;
264 if AOwner is TForm then Form := TForm(AOwner)
265 else Form := nil;
266 FMinVisiblePart := 50;
267 FRegistryContext.RootKey := HKEY_CURRENT_USER;
268end;
269
270end.
271
Note: See TracBrowser for help on using the repository browser.