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