lazarus/components/sparta/mdi/source/sparta_abstractresizer.pas
2020-12-26 16:37:51 +00:00

385 lines
11 KiB
ObjectPascal

unit sparta_AbstractResizer;
{$mode delphi}{$H+}
interface
uses
Classes, SysUtils, Math,
LCLType, Controls, ExtCtrls, Forms, StdCtrls, Buttons, Dialogs,
sparta_InterfacesMDI, sparta_BasicResizeFrame, sparta_MDI_StrConsts;
type
{ TAbstractResizer }
TAbstractResizer = class(TComponent, IResizer)
protected { IResizer }
function GetActiveResizeFrame: IResizeFrame; virtual; abstract;
function GetActiveDesignedForm: IDesignedForm; virtual; abstract;
public { IResizer }
procedure TryBoundSizerToDesignedForm(Sender: TObject); virtual;
protected
// To perform proper behaviour for scroolbar with "PageSize" we need to remember real
// maximal values (is possible to scroll outside of range 0..(Max - PageSize),
// after mouse click in button responsible for changing value of scrollbar,
// our value is equal to Max :\). Workaround: we need to remember real max value in our own place
FRealMaxH: Integer;
FRealMaxV: Integer;
FSpecialMargin: array[0..3] of Integer;
FDesignScroll: array[0..1] of Boolean;
FParent: TWinControl;
FResizerFrameClass: TResizerFrameClass;
function CreateResizeFrame: TBasicResizeFrame; virtual;
procedure NodePositioning(Sender: TObject; {%H-}PositioningKind: TPositioningKind; PositioningCode: TPositioningCode);
function GetActiveFormAndFrame(out AForm: IDesignedForm; out AFrame: IResizeFrame): Boolean;
procedure SetDesignScroll(AIndex: Integer; AValue: Boolean);
procedure sbScroll(Sender: TObject; ScrollCode: TScrollCode; var ScrollPos: Integer);
public
pMainDTU: TPanel;
pMain: TPanel;
pAddons: TPanel;
pComponents: TPanel;
lInfo: TLabel;
sbShowComponents : TSpeedButton;
sbShowFormEditor: TSpeedButton;
sbShowAnchorEditor: TSpeedButton;
sbShowNonVisualEditor: TSpeedButton;
pDesignTimeUtils: TPanel;
sbV: TScrollBar;
sbH: TScrollBar;
constructor Create(AParent: TWinControl; AResizerFrameClass: TResizerFrameClass); virtual; reintroduce;
property DesignScrollRight: Boolean index SB_Vert read FDesignScroll[SB_Vert] write SetDesignScroll;
property DesignScrollBottom: Boolean index SB_Horz read FDesignScroll[SB_Horz] write SetDesignScroll;
property ActiveResizeFrame: IResizeFrame read GetActiveResizeFrame;
property ActiveDesignedForm: IDesignedForm read GetActiveDesignedForm;
end;
implementation
{ TAbstractResizer }
procedure TAbstractResizer.TryBoundSizerToDesignedForm(Sender: TObject);
var
LWidth, LHeight: Integer;
LScrollPos: Integer;
LResizeFrame: IResizeFrame;
LFrame: TCustomFrame;
LForm: IDesignedForm;
begin
if not GetActiveFormAndFrame(LForm, LResizeFrame) then
Exit;
LFrame := LResizeFrame.Frame;
LFrame.Constraints.MaxWidth := pMain.Width;
LFrame.Constraints.MaxHeight := pMain.Height;
LWidth := LForm.Width + LResizeFrame.BgLeftMargin + LResizeFrame.BgRightMargin + 2*LResizeFrame.SizerRectSize;
LHeight := LForm.Height + LResizeFrame.BgTopMargin + LResizeFrame.BgBottomMargin + 2*LResizeFrame.SizerRectSize;
if not LResizeFrame.NodePositioning then
begin
LFrame.Width := LWidth;
LFrame.Height := LHeight;
// after enlargement and after reducing constrait not work for frame (LCL bug)
if LFrame.Width > LFrame.Constraints.MaxWidth then
LFrame.Width := LFrame.Constraints.MaxWidth;
if LFrame.Height > LFrame.Constraints.MaxHeight then
LFrame.Height := LFrame.Constraints.MaxHeight;
end;
LResizeFrame.PositionNodes;
DesignScrollBottom := LFrame.Width < LWidth;
sbH.Max := LWidth;
FRealMaxH := LWidth - LFrame.Width;
sbH.PageSize := LFrame.Width;
if LResizeFrame.HorizontalScrollPos > FRealMaxH then
begin
LResizeFrame.HorizontalScrollPos := FRealMaxH;
LScrollPos := LResizeFrame.HorizontalScrollPos;
sbScroll(sbH, scEndScroll, LScrollPos);
end;
DesignScrollRight := LFrame.Height < LHeight;
sbV.Max := LHeight;
FRealMaxV := LHeight - LFrame.Height;
sbV.PageSize := LFrame.Height;
if LResizeFrame.VerticalScrollPos > FRealMaxV then
begin
LResizeFrame.VerticalScrollPos := FRealMaxV;
LScrollPos := LResizeFrame.VerticalScrollPos;
sbScroll(sbV, scEndScroll, LScrollPos);
end;
{!}
LResizeFrame.ClientChangeBounds;
// each editor can have scrolls in different positions.
// this is our place where we can call event to set scroll positions.
LScrollPos := LResizeFrame.VerticalScrollPos;
sbScroll(sbV, scEndScroll, LScrollPos);
LScrollPos := LResizeFrame.HorizontalScrollPos;
sbScroll(sbH, scEndScroll, LScrollPos);
if Supports(LForm, IDesignedFormBackground) then
(LForm as IDesignedFormBackground).RefreshValues;
LResizeFrame.DesignerSetFocus;
end;
procedure TAbstractResizer.sbScroll(Sender: TObject; ScrollCode: TScrollCode;
var ScrollPos: Integer);
var
LScrollPos: Integer;
LFrame: IResizeFrame;
LForm: IDesignedForm;
begin
if not GetActiveFormAndFrame(LForm, LFrame) then
Exit;
if ScrollCode <> scEndScroll then
LFrame.HideSizeRects
else
LFrame.ShowSizeRects;
LForm.BeginUpdate;
if Sender = sbV then
begin
// Warning - don't overflow the range! (go to description for FRealMaxV)
ScrollPos := Min(ScrollPos, FRealMaxV);
LFrame.VerticalScrollPos := ScrollPos;
// scroll for form
with LFrame do // -8 when we scaling the form and we don't need to scroll -> there is Max
LScrollPos := Max(ifthen(BgPanel.Top + BgTopMargin <= 0, ScrollPos - SizerRectSize - BgTopMargin, 0), 0);
LForm.VertScrollPosition := LScrollPos;
end;
if Sender = sbH then
begin
ScrollPos := Min(ScrollPos, FRealMaxH);
LFrame.HorizontalScrollPos := ScrollPos;
// scroll for form
with LFrame do
LScrollPos := Max(ifthen(BgPanel.Left + BgLeftMargin <= 0, ScrollPos - SizerRectSize - BgLeftMargin, 0), 0);
LForm.HorzScrollPosition := LScrollPos;
end;
LForm.EndUpdate;
LFrame.PositionNodes;
LForm.Form.Invalidate;
end;
function TAbstractResizer.CreateResizeFrame: TBasicResizeFrame;
begin
Result := FResizerFrameClass.Create(FParent);
Result.Name := '';
Result.Parent := pMain;
Result.Left := 0;
Result.Top := 0;
Result.OnNodePositioning := NodePositioning;
end;
procedure TAbstractResizer.NodePositioning(Sender: TObject;
PositioningKind: TPositioningKind; PositioningCode: TPositioningCode);
var
LForm: IDesignedForm;
LFrame: IResizeFrame;
(*procedure Positioning;
var
LHiddenHeight, LNewHeight: Integer;
LHiddenWidth, LNewWidth: Integer;
begin
LForm.BeginUpdate;
//if pkRight in PositioningKind then
begin
LHiddenWidth := sbH.Position;
if LHiddenWidth > LFrame.DesignedWidthToScroll then
LHiddenWidth := LFrame.DesignedWidthToScroll;
// TODO - better handling of min width - same in TDesignedFormImpl.SetPublishedBounds (sparta_FakeCustom.pas)
LNewWidth := LFrame.NewSize.X + LHiddenWidth;
LForm.Width := LNewWidth;
LForm.RealWidth := LNewWidth;
// perform minimal width (TODO)
{if LNewWidth < DesignedForm.Width then
begin
FResizerFrame.pClient.Width := DesignedForm.Width;
Application.HandleMessage;
Application.ProcessMessages;
end;}
end;
//if pkBottom in PositioningKind then
begin
LHiddenHeight := sbV.Position;
if LHiddenHeight > LFrame.DesignedHeightToScroll then
LHiddenHeight := LFrame.DesignedHeightToScroll;
LNewHeight := LFrame.NewSize.Y+ LHiddenHeight;
LForm.Height := LNewHeight;
LForm.RealHeight := LNewHeight;
// perform minimal height (TODO)
{if LNewHeight < DesignedForm.RealHeight then
begin
if FResizerFrame.pClient.Height < DesignedForm.RealHeight then
FResizerFrame.pClient.Height := DesignedForm.RealHeight;
Application.ProcessMessages;
end;}
end;
LForm.EndUpdate;
end;*)
procedure PositioningEnd;
var
LHiddenHeight, LNewHeight: Integer;
LHiddenWidth, LNewWidth: Integer;
begin
LHiddenWidth := sbH.Position;
if LHiddenWidth > LFrame.DesignedWidthToScroll then
LHiddenWidth := LFrame.DesignedWidthToScroll;
LNewWidth := LFrame.NewSize.X + LHiddenWidth;
LHiddenHeight := sbV.Position;
if LHiddenHeight > LFrame.DesignedHeightToScroll then
LHiddenHeight := LFrame.DesignedHeightToScroll;
LNewHeight := LFrame.NewSize.Y + LHiddenHeight;
LForm.Form.Width := LNewWidth;
LForm.Form.Height := LNewHeight;
end;
begin
if not GetActiveFormAndFrame(LForm, LFrame) then
Exit;
case PositioningCode of
pcPositioningEnd: PositioningEnd;
//pcPositioning: Positioning;
end;
end;
function TAbstractResizer.GetActiveFormAndFrame(out AForm: IDesignedForm; out
AFrame: IResizeFrame): Boolean;
begin
AForm := GetActiveDesignedForm;
if AForm = nil then
Exit(False);
AFrame := GetActiveResizeFrame;
Result := True;
end;
procedure TAbstractResizer.SetDesignScroll(AIndex: Integer; AValue: Boolean);
procedure PerformScroll(AScroll: TScrollBar);
begin
AScroll.Visible := AValue;
AScroll.Position:=0;
end;
begin
if FDesignScroll[AIndex] = AValue then
Exit;
FDesignScroll[AIndex] := AValue;
case AIndex of
SB_Horz: PerformScroll(sbH);
SB_Vert: PerformScroll(sbV);
else
raise EArgumentOutOfRangeException.CreateRes(@SArgumentOutOfRange);
end;
end;
constructor TAbstractResizer.Create(AParent: TWinControl;
AResizerFrameClass: TResizerFrameClass);
begin
inherited Create(AParent);
FResizerFrameClass := AResizerFrameClass;
FParent := AParent;
// create layout
pMainDTU := TPanel.Create(Self);
with pMainDTU do
begin
Parent := AParent;
Align := alTop;
BevelOuter := bvNone;
Height := 0;
end;
pAddons := TPanel.Create(Self);
pAddons.Parent := AParent;
pAddons.Align := alRight;
pAddons.BevelOuter := bvNone;
pAddons.Width:=0;
sbV := TScrollBar.Create(Self);
with sbV do
begin
Kind := sbVertical;
Parent := AParent;
AnchorSideTop.Control := pMainDTU;
AnchorSideTop.Side := asrBottom;
AnchorSideRight.Control := pAddons;
AnchorSideBottom.Side := asrBottom;
Width := 17;
Anchors := [akTop, akRight, akBottom];
Visible := False;
OnScroll := sbScroll;
end;
sbH := TScrollBar.Create(Self);
with sbH do
begin
Parent := AParent;
AnchorSideLeft.Control := AParent;
AnchorSideRight.Side := asrRight;
AnchorSideBottom.Control := AParent;
AnchorSideBottom.Side := asrBottom;
Anchors := [akLeft, akRight, akBottom];
Visible := False;
OnScroll := sbScroll;
end;
pMain := TPanel.Create(Self);
with pMain do
begin
Parent := AParent;
AnchorSideLeft.Control := AParent;
AnchorSideTop.Control := pMainDTU;
AnchorSideTop.Side := asrBottom;
AnchorSideRight.Control := sbV;
AnchorSideBottom.Control := sbH;
Anchors := [akTop, akLeft, akRight, akBottom];
BevelOuter := bvNone;
end;
sbV.AnchorSideBottom.Control := pMain;
sbH.AnchorSideRight.Control := pMain;
pMain.OnChangeBounds:=TryBoundSizerToDesignedForm;
end;
end.