mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-05-29 19:02:52 +02:00
385 lines
11 KiB
ObjectPascal
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.
|
|
|