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