1 unit sparta_AbstractResizer;
2
3 {$mode delphi}{$H+}
4
5 interface
6
7 uses
8 Classes, SysUtils, Math,
9 LCLType, Controls, ExtCtrls, Forms, StdCtrls, Buttons, Dialogs,
10 sparta_InterfacesMDI, sparta_BasicResizeFrame, sparta_MDI_StrConsts;
11
12 type
13
14 { TAbstractResizer }
15
16 TAbstractResizer = class(TComponent, IResizer)
17 protected { IResizer }
GetActiveResizeFramenull18 function GetActiveResizeFrame: IResizeFrame; virtual; abstract;
GetActiveDesignedFormnull19 function GetActiveDesignedForm: IDesignedForm; virtual; abstract;
20 public { IResizer }
21 procedure TryBoundSizerToDesignedForm(Sender: TObject); virtual;
22 protected
23 // To perform proper behaviour for scroolbar with "PageSize" we need to remember real
24 // maximal values (is possible to scroll outside of range 0..(Max - PageSize),
25 // after mouse click in button responsible for changing value of scrollbar,
26 // our value is equal to Max :\). Workaround: we need to remember real max value in our own place
27 FRealMaxH: Integer;
28 FRealMaxV: Integer;
29
30 FSpecialMargin: array[0..3] of Integer;
31 FDesignScroll: array[0..1] of Boolean;
32
33 FParent: TWinControl;
34 FResizerFrameClass: TResizerFrameClass;
35
CreateResizeFramenull36 function CreateResizeFrame: TBasicResizeFrame; virtual;
37 procedure NodePositioning(Sender: TObject; {%H-}PositioningKind: TPositioningKind; PositioningCode: TPositioningCode);
38
GetActiveFormAndFramenull39 function GetActiveFormAndFrame(out AForm: IDesignedForm; out AFrame: IResizeFrame): Boolean;
40
41 procedure SetDesignScroll(AIndex: Integer; AValue: Boolean);
42
43 procedure sbScroll(Sender: TObject; ScrollCode: TScrollCode; var ScrollPos: Integer);
44 public
45 pMainDTU: TPanel;
46 pMain: TPanel;
47 pAddons: TPanel;
48 pComponents: TPanel;
49 lInfo: TLabel;
50 sbShowComponents : TSpeedButton;
51 sbShowFormEditor: TSpeedButton;
52 sbShowAnchorEditor: TSpeedButton;
53 sbShowNonVisualEditor: TSpeedButton;
54 pDesignTimeUtils: TPanel;
55 sbV: TScrollBar;
56 sbH: TScrollBar;
57
58 constructor Create(AParent: TWinControl; AResizerFrameClass: TResizerFrameClass); virtual; reintroduce;
59 property DesignScrollRight: Boolean index SB_Vert read FDesignScroll[SB_Vert] write SetDesignScroll;
60 property DesignScrollBottom: Boolean index SB_Horz read FDesignScroll[SB_Horz] write SetDesignScroll;
61
62 property ActiveResizeFrame: IResizeFrame read GetActiveResizeFrame;
63 property ActiveDesignedForm: IDesignedForm read GetActiveDesignedForm;
64 end;
65
66 implementation
67
68 { TAbstractResizer }
69
70 procedure TAbstractResizer.TryBoundSizerToDesignedForm(Sender: TObject);
71 var
72 LWidth, LHeight: Integer;
73 LScrollPos: Integer;
74 LResizeFrame: IResizeFrame;
75 LFrame: TCustomFrame;
76 LForm: IDesignedForm;
77 begin
78 if not GetActiveFormAndFrame(LForm, LResizeFrame) then
79 Exit;
80
81 LFrame := LResizeFrame.Frame;
82 LFrame.Constraints.MaxWidth := pMain.Width;
83 LFrame.Constraints.MaxHeight := pMain.Height;
84
85 LWidth := LForm.Width + LResizeFrame.BgLeftMargin + LResizeFrame.BgRightMargin + 2*LResizeFrame.SizerRectSize;
86 LHeight := LForm.Height + LResizeFrame.BgTopMargin + LResizeFrame.BgBottomMargin + 2*LResizeFrame.SizerRectSize;
87 if not LResizeFrame.NodePositioning then
88 begin
89 LFrame.Width := LWidth;
90 LFrame.Height := LHeight;
91 // after enlargement and after reducing constrait not work for frame (LCL bug)
92 if LFrame.Width > LFrame.Constraints.MaxWidth then
93 LFrame.Width := LFrame.Constraints.MaxWidth;
94 if LFrame.Height > LFrame.Constraints.MaxHeight then
95 LFrame.Height := LFrame.Constraints.MaxHeight;
96 end;
97
98 LResizeFrame.PositionNodes;
99
100 DesignScrollBottom := LFrame.Width < LWidth;
101 sbH.Max := LWidth;
102 FRealMaxH := LWidth - LFrame.Width;
103 sbH.PageSize := LFrame.Width;
104 if LResizeFrame.HorizontalScrollPos > FRealMaxH then
105 begin
106 LResizeFrame.HorizontalScrollPos := FRealMaxH;
107 LScrollPos := LResizeFrame.HorizontalScrollPos;
108 sbScroll(sbH, scEndScroll, LScrollPos);
109 end;
110
111 DesignScrollRight := LFrame.Height < LHeight;
112 sbV.Max := LHeight;
113 FRealMaxV := LHeight - LFrame.Height;
114 sbV.PageSize := LFrame.Height;
115 if LResizeFrame.VerticalScrollPos > FRealMaxV then
116 begin
117 LResizeFrame.VerticalScrollPos := FRealMaxV;
118 LScrollPos := LResizeFrame.VerticalScrollPos;
119 sbScroll(sbV, scEndScroll, LScrollPos);
120 end;
121
122 {!}
123 LResizeFrame.ClientChangeBounds;
124
125 // each editor can have scrolls in different positions.
126 // this is our place where we can call event to set scroll positions.
127 LScrollPos := LResizeFrame.VerticalScrollPos;
128 sbScroll(sbV, scEndScroll, LScrollPos);
129 LScrollPos := LResizeFrame.HorizontalScrollPos;
130 sbScroll(sbH, scEndScroll, LScrollPos);
131
132 if Supports(LForm, IDesignedFormBackground) then
133 (LForm as IDesignedFormBackground).RefreshValues;
134
135 LResizeFrame.DesignerSetFocus;
136 end;
137
138 procedure TAbstractResizer.sbScroll(Sender: TObject; ScrollCode: TScrollCode;
139 var ScrollPos: Integer);
140 var
141 LScrollPos: Integer;
142 LFrame: IResizeFrame;
143 LForm: IDesignedForm;
144 begin
145 if not GetActiveFormAndFrame(LForm, LFrame) then
146 Exit;
147
148 if ScrollCode <> scEndScroll then
149 LFrame.HideSizeRects
150 else
151 LFrame.ShowSizeRects;
152
153
154 LForm.BeginUpdate;
155 if Sender = sbV then
156 begin
157 // Warning - don't overflow the range! (go to description for FRealMaxV)
158 ScrollPos := Min(ScrollPos, FRealMaxV);
159 LFrame.VerticalScrollPos := ScrollPos;
160 // scroll for form
161 with LFrame do // -8 when we scaling the form and we don't need to scroll -> there is Max
162 LScrollPos := Max(ifthen(BgPanel.Top + BgTopMargin <= 0, ScrollPos - SizerRectSize - BgTopMargin, 0), 0);
163 LForm.VertScrollPosition := LScrollPos;
164 end;
165 if Sender = sbH then
166 begin
167 ScrollPos := Min(ScrollPos, FRealMaxH);
168 LFrame.HorizontalScrollPos := ScrollPos;
169 // scroll for form
170 with LFrame do
171 LScrollPos := Max(ifthen(BgPanel.Left + BgLeftMargin <= 0, ScrollPos - SizerRectSize - BgLeftMargin, 0), 0);
172 LForm.HorzScrollPosition := LScrollPos;
173 end;
174 LForm.EndUpdate;
175
176 LFrame.PositionNodes;
177
178 LForm.Form.Invalidate;
179 end;
180
CreateResizeFramenull181 function TAbstractResizer.CreateResizeFrame: TBasicResizeFrame;
182 begin
183 Result := FResizerFrameClass.Create(FParent);
184 Result.Name := '';
185 Result.Parent := pMain;
186 Result.Left := 0;
187 Result.Top := 0;
188 Result.OnNodePositioning := NodePositioning;
189 end;
190
191 procedure TAbstractResizer.NodePositioning(Sender: TObject;
192 PositioningKind: TPositioningKind; PositioningCode: TPositioningCode);
193
194 var
195 LForm: IDesignedForm;
196 LFrame: IResizeFrame;
197
198 (*procedure Positioning;
199 var
200 LHiddenHeight, LNewHeight: Integer;
201 LHiddenWidth, LNewWidth: Integer;
202 begin
203 LForm.BeginUpdate;
204
205 //if pkRight in PositioningKind then
206 begin
207 LHiddenWidth := sbH.Position;
208 if LHiddenWidth > LFrame.DesignedWidthToScroll then
209 LHiddenWidth := LFrame.DesignedWidthToScroll;
210
211 // TODO - better handling of min width - same in TDesignedFormImpl.SetPublishedBounds (sparta_FakeCustom.pas)
212
213 LNewWidth := LFrame.NewSize.X + LHiddenWidth;
214 LForm.Width := LNewWidth;
215 LForm.RealWidth := LNewWidth;
216
217 // perform minimal width (TODO)
218 {if LNewWidth < DesignedForm.Width then
219 begin
220 FResizerFrame.pClient.Width := DesignedForm.Width;
221 Application.HandleMessage;
222 Application.ProcessMessages;
223 end;}
224 end;
225
226 //if pkBottom in PositioningKind then
227 begin
228 LHiddenHeight := sbV.Position;
229 if LHiddenHeight > LFrame.DesignedHeightToScroll then
230 LHiddenHeight := LFrame.DesignedHeightToScroll;
231
232 LNewHeight := LFrame.NewSize.Y+ LHiddenHeight;
233 LForm.Height := LNewHeight;
234 LForm.RealHeight := LNewHeight;
235
236 // perform minimal height (TODO)
237 {if LNewHeight < DesignedForm.RealHeight then
238 begin
239 if FResizerFrame.pClient.Height < DesignedForm.RealHeight then
240 FResizerFrame.pClient.Height := DesignedForm.RealHeight;
241 Application.ProcessMessages;
242 end;}
243 end;
244
245 LForm.EndUpdate;
246 end;*)
247
248 procedure PositioningEnd;
249 var
250 LHiddenHeight, LNewHeight: Integer;
251 LHiddenWidth, LNewWidth: Integer;
252 begin
253 LHiddenWidth := sbH.Position;
254 if LHiddenWidth > LFrame.DesignedWidthToScroll then
255 LHiddenWidth := LFrame.DesignedWidthToScroll;
256
257 LNewWidth := LFrame.NewSize.X + LHiddenWidth;
258
259 LHiddenHeight := sbV.Position;
260 if LHiddenHeight > LFrame.DesignedHeightToScroll then
261 LHiddenHeight := LFrame.DesignedHeightToScroll;
262
263 LNewHeight := LFrame.NewSize.Y + LHiddenHeight;
264
265 LForm.Form.Width := LNewWidth;
266 LForm.Form.Height := LNewHeight;
267 end;
268
269 begin
270 if not GetActiveFormAndFrame(LForm, LFrame) then
271 Exit;
272
273 case PositioningCode of
274 pcPositioningEnd: PositioningEnd;
275 //pcPositioning: Positioning;
276 end;
277 end;
278
TAbstractResizer.GetActiveFormAndFramenull279 function TAbstractResizer.GetActiveFormAndFrame(out AForm: IDesignedForm; out
280 AFrame: IResizeFrame): Boolean;
281 begin
282 AForm := GetActiveDesignedForm;
283 if AForm = nil then
284 Exit(False);
285
286 AFrame := GetActiveResizeFrame;
287 Result := True;
288 end;
289
290 procedure TAbstractResizer.SetDesignScroll(AIndex: Integer; AValue: Boolean);
291
292 procedure PerformScroll(AScroll: TScrollBar);
293 begin
294 AScroll.Visible := AValue;
295 AScroll.Position:=0;
296 end;
297
298 begin
299 if FDesignScroll[AIndex] = AValue then
300 Exit;
301
302 FDesignScroll[AIndex] := AValue;
303
304 case AIndex of
305 SB_Horz: PerformScroll(sbH);
306 SB_Vert: PerformScroll(sbV);
307 else
308 raise EArgumentOutOfRangeException.CreateRes(@SArgumentOutOfRange);
309 end;
310 end;
311
312 constructor TAbstractResizer.Create(AParent: TWinControl;
313 AResizerFrameClass: TResizerFrameClass);
314 begin
315 inherited Create(AParent);
316
317 FResizerFrameClass := AResizerFrameClass;
318 FParent := AParent;
319 // create layout
320
321 pMainDTU := TPanel.Create(Self);
322 with pMainDTU do
323 begin
324 Parent := AParent;
325 Align := alTop;
326 BevelOuter := bvNone;
327 Height := 0;
328 end;
329
330 pAddons := TPanel.Create(Self);
331 pAddons.Parent := AParent;
332 pAddons.Align := alRight;
333 pAddons.BevelOuter := bvNone;
334 pAddons.Width:=0;
335
336 sbV := TScrollBar.Create(Self);
337 with sbV do
338 begin
339 Kind := sbVertical;
340 Parent := AParent;
341 AnchorSideTop.Control := pMainDTU;
342 AnchorSideTop.Side := asrBottom;
343 AnchorSideRight.Control := pAddons;
344 AnchorSideBottom.Side := asrBottom;
345 Width := 17;
346 Anchors := [akTop, akRight, akBottom];
347 Visible := False;
348 OnScroll := sbScroll;
349 end;
350
351 sbH := TScrollBar.Create(Self);
352 with sbH do
353 begin
354 Parent := AParent;
355 AnchorSideLeft.Control := AParent;
356 AnchorSideRight.Side := asrRight;
357 AnchorSideBottom.Control := AParent;
358 AnchorSideBottom.Side := asrBottom;
359 Anchors := [akLeft, akRight, akBottom];
360 Visible := False;
361 OnScroll := sbScroll;
362 end;
363
364 pMain := TPanel.Create(Self);
365 with pMain do
366 begin
367 Parent := AParent;
368 AnchorSideLeft.Control := AParent;
369 AnchorSideTop.Control := pMainDTU;
370 AnchorSideTop.Side := asrBottom;
371 AnchorSideRight.Control := sbV;
372 AnchorSideBottom.Control := sbH;
373 Anchors := [akTop, akLeft, akRight, akBottom];
374 BevelOuter := bvNone;
375 end;
376
377 sbV.AnchorSideBottom.Control := pMain;
378 sbH.AnchorSideRight.Control := pMain;
379
380 pMain.OnChangeBounds:=TryBoundSizerToDesignedForm;
381 end;
382
383 end.
384
385