paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-05 13:38:08 +02:00
Code Issues Packages Projects Releases Wiki Activity

DockedFormEditor: Create ResizeControl dynamically to be full DPI aware. Issue #38702

Browse Source 
git-svn-id: trunk@64933 -
This commit is contained in:
michl 2021-04-06 20:54:52 +00:00
parent 1ddd3cc19b
commit dd531abe78
9 changed files with 899 additions and 1035 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
.gitattributes vendored
View File

@ -1340,18 +1340,17 @@ components/dockedformeditor/languages/dockedstrconsts.uk.po svneol=native#text/p
components/dockedformeditor/languages/dockedstrconsts.zh_CN.po svneol=native#text/plain
components/dockedformeditor/source/dockedanchorcontrol.pas svneol=native#text/pascal
components/dockedformeditor/source/dockedanchordesigner.pas svneol=native#text/pascal
components/dockedformeditor/source/dockedanchorgrip.pas svneol=native#text/pascal
components/dockedformeditor/source/dockedbasicanchordesigner.pas svneol=native#text/pascal
components/dockedformeditor/source/dockeddesignform.pas svneol=native#text/pascal
components/dockedformeditor/source/dockedformaccesses.pas svneol=native#text/pascal
components/dockedformeditor/source/dockedgrip.pas svneol=native#text/pascal
components/dockedformeditor/source/dockedmainide.pas svneol=native#text/pascal
components/dockedformeditor/source/dockedmodulepagecontrol.pas svneol=native#text/pascal
components/dockedformeditor/source/dockedoptionsframe.lfm svneol=native#text/plain
components/dockedformeditor/source/dockedoptionsframe.pas svneol=native#text/pascal
components/dockedformeditor/source/dockedoptionside.pas svneol=native#text/pascal
components/dockedformeditor/source/dockedregister.pas svneol=native#text/pascal
components/dockedformeditor/source/dockedresizeframe.lfm svneol=native#text/plain
components/dockedformeditor/source/dockedresizeframe.pas svneol=native#text/pascal
components/dockedformeditor/source/dockedresizecontrol.pas svneol=native#text/pascal
components/dockedformeditor/source/dockedresizer.pas svneol=native#text/pascal
components/dockedformeditor/source/dockedsourceeditorpagecontrols.pas svneol=native#text/pascal
components/dockedformeditor/source/dockedsourceeditorwindow.pas svneol=native#text/pascal

2
components/dockedformeditor/source/dockedanchordesigner.pas
View File

@ -23,7 +23,7 @@ uses
PropEdits,
// DockedFormEditor
DockedDesignForm, DockedBasicAnchorDesigner, DockedAnchorControl,
DockedOptionsIDE, DockedAnchorGrip, DockedTools, DockedStrConsts;
DockedOptionsIDE, DockedGrip, DockedTools, DockedStrConsts;
type

279
components/dockedformeditor/source/dockedanchorgrip.pas
View File

@ -1,279 +0,0 @@
{
*****************************************************************************
See the file COPYING.modifiedLGPL.txt, included in this distribution,
for details about the license.
*****************************************************************************
Author: Michael W. Vogel
Anchor grips: 1
0 +----+----+ 2
| |
7 + + 3
| |
6 +----+----+ 4
5
}
unit DockedAnchorGrip;
{$mode objfpc}{$H+}
interface
uses
// RTL, FCL
Classes, SysUtils, math,
// LCL
Controls, ExtCtrls, Graphics, Menus;
type
{ TAnchorGrip }
TAnchorGrip = class(TPanel)
private
FShape: TShape;
public
constructor Create(TheOwner: TComponent); override;
end;
{ TAnchorGrips }
TAnchorGrips = class
private const
GRIP_SIZE = 8;
private
FBackGround: TWinControl;
FGrip: array[0..7] of TAnchorGrip;
FGripSize: Integer;
FOnMouseDown: TMouseEvent;
FOnMouseMove: TMouseMoveEvent;
FOnMouseUp: TMouseEvent;
FParent: TWinControl;
function CalculateBestRect(AControl: TControl): TRect;
function GetGrip(AIndex: Integer): TAnchorGrip;
function GetPopupMenu: TPopupMenu;
procedure InitGrip(AGrip: TAnchorGrip; ACursor: TCursor);
procedure SetOnMouseDown(AValue: TMouseEvent);
procedure SetOnMouseMove(AValue: TMouseMoveEvent);
procedure SetOnMouseUp(AValue: TMouseEvent);
procedure SetParent(AValue: TWinControl);
procedure SetPopupMenu(AValue: TPopupMenu);
public
constructor Create;
destructor Destroy; override;
procedure AdjustGrips(AControl: TControl);
procedure BringToFront;
procedure Hide;
procedure SetBounds(ARect: TRect);
public
property BackGround: TWinControl read FBackGround write FBackGround;
property GripSize: Integer read FGripSize;
property GripTopLeft: TAnchorGrip index 0 read GetGrip;
property GripTopCenter: TAnchorGrip index 1 read GetGrip;
property GripTopRight: TAnchorGrip index 2 read GetGrip;
property GripCenterRight: TAnchorGrip index 3 read GetGrip;
property GripBottomRight: TAnchorGrip index 4 read GetGrip;
property GripBottomCenter: TAnchorGrip index 5 read GetGrip;
property GripBottomLeft: TAnchorGrip index 6 read GetGrip;
property GripCenterLeft: TAnchorGrip index 7 read GetGrip;
property OnMouseDown: TMouseEvent read FOnMouseDown write SetOnMouseDown;
property OnMouseMove: TMouseMoveEvent read FOnMouseMove write SetOnMouseMove;
property OnMouseUp: TMouseEvent read FOnMouseUp write SetOnMouseUp;
property Parent: TWinControl read FParent write SetParent;
property PopupMenu: TPopupMenu read GetPopupMenu write SetPopupMenu;
end;
implementation
{ TAnchorGrip }
constructor TAnchorGrip.Create(TheOwner: TComponent);
begin
inherited Create(TheOwner);
BevelOuter := bvNone;
Color := clBlack;
SetInitialBounds(0, 0, 8, 8);
FShape := TShape.Create(Self);
FShape.Align := alClient;
FShape.Brush.Color := clBtnFace;
FShape.Enabled := False;
FShape.Parent := Self;
end;
{ TAnchorGrips }
function TAnchorGrips.CalculateBestRect(AControl: TControl): TRect;
var
LTopLeft, LBottomRight: TPoint;
LGripOffset: Integer;
begin
Result := Rect(0, 0, BackGround.Width, BackGround.Height);
if not Assigned(AControl) then Exit;
if AControl = BackGround then Exit;
// grip in middle of rect border is default, if to small, use dynamic offset
LGripOffset := Max(GripSize div 2, (GripSize * 10 - AControl.Width) div 10);
LTopLeft.x := -LGripOffset;
LBottomRight.x := AControl.Width + LGripOffset;
LGripOffset := Max(GripSize div 2, (GripSize * 10 - AControl.Height) div 10);
LTopLeft.y := -LGripOffset;
LBottomRight.y := AControl.Height + LGripOffset;
LTopLeft := AControl.ClientToParent(LTopLeft, BackGround);
LBottomRight := AControl.ClientToParent(LBottomRight, BackGround);
LTopLeft.x := Max(LTopLeft.x, 0);
LTopLeft.y := Max(LTopLeft.y, 0);
LBottomRight.x := Min(LBottomRight.x, BackGround.Width);
LBottomRight.y := Min(LBottomRight.y, BackGround.Height);
Result := Rect(LTopLeft.x, LTopLeft.y, LBottomRight.x, LBottomRight.y);
end;
function TAnchorGrips.GetGrip(AIndex: Integer): TAnchorGrip;
begin
Result := FGrip[AIndex];
end;
function TAnchorGrips.GetPopupMenu: TPopupMenu;
begin
Result := FGrip[0].PopupMenu;
end;
procedure TAnchorGrips.InitGrip(AGrip: TAnchorGrip; ACursor: TCursor);
begin
AGrip.Parent := FParent;
AGrip.Cursor := ACursor;
end;
procedure TAnchorGrips.SetOnMouseDown(AValue: TMouseEvent);
var
i: Integer;
begin
if FOnMouseDown = AValue then Exit;
FOnMouseDown := AValue;
for i := 0 to 7 do
FGrip[i].OnMouseDown := AValue;
end;
procedure TAnchorGrips.SetOnMouseMove(AValue: TMouseMoveEvent);
var
i: Integer;
begin
if FOnMouseMove = AValue then Exit;
FOnMouseMove := AValue;
for i := 0 to 7 do
FGrip[i].OnMouseMove := AValue;
end;
procedure TAnchorGrips.SetOnMouseUp(AValue: TMouseEvent);
var
i: Integer;
begin
if FOnMouseUp = AValue then Exit;
FOnMouseUp := AValue;
for i := 0 to 7 do
FGrip[i].OnMouseUp := AValue;
end;
procedure TAnchorGrips.SetParent(AValue: TWinControl);
var
i: Integer;
begin
if FParent = AValue then Exit;
FParent := AValue;
for i := 0 to 7 do
FGrip[i].Parent := AValue;
end;
procedure TAnchorGrips.SetPopupMenu(AValue: TPopupMenu);
var
i: Integer;
begin
if GetPopupMenu = AValue then Exit;
for i := 0 to 7 do
FGrip[i].PopupMenu := AValue;
end;
constructor TAnchorGrips.Create;
var
i: Integer;
begin
FGripSize := ScaleX(GRIP_SIZE, 96);
for i := 0 to 7 do
FGrip[i] := TAnchorGrip.Create(nil);
// on mac there is no cursor for crNWSE ( https://bugs.freepascal.org/view.php?id=32194#c101876 )
InitGrip(GripTopLeft, {$IFDEF MACOS}crSizeAll{$ELSE}crSizeNWSE{$ENDIF});
InitGrip(GripTopCenter, crSizeNS);
InitGrip(GripTopRight, {$IFDEF MACOS}crSizeAll{$ELSE}crSizeNESW{$ENDIF});
InitGrip(GripCenterRight, crSizeWE);
InitGrip(GripBottomRight, {$IFDEF MACOS}crSizeAll{$ELSE}crSizeNWSE{$ENDIF});
InitGrip(GripBottomCenter, crSizeNS);
InitGrip(GripBottomLeft, {$IFDEF MACOS}crSizeAll{$ELSE}crSizeNESW{$ENDIF});
InitGrip(GripCenterLeft, crSizeWE);
end;
destructor TAnchorGrips.Destroy;
var
i: Integer;
begin
for i := 7 downto 0 do
FGrip[i].Free;
inherited Destroy;
end;
procedure TAnchorGrips.AdjustGrips(AControl: TControl);
var
LRect: TRect;
begin
if not Assigned(AControl) then
begin
Hide;
Exit;
end;
AControl.BringToFront;
LRect := CalculateBestRect(AControl);
SetBounds(LRect);
BringToFront;
end;
procedure TAnchorGrips.BringToFront;
var
i: Integer;
begin
for i := 0 to 7 do
begin
FGrip[i].Visible := True;
FGrip[i].BringToFront;
end;
end;
procedure TAnchorGrips.Hide;
var
i: Integer;
begin
for i := 0 to 7 do
FGrip[i].Visible := False;
end;
procedure TAnchorGrips.SetBounds(ARect: TRect);
begin
if not Assigned(FParent) then Exit;
FGrip[0].SetBounds(ARect.Left, ARect.Top, GripSize, GripSize);
FGrip[1].SetBounds((ARect.Left + ARect.Right - GripSize) div 2, ARect.Top, GripSize, GripSize);
FGrip[2].SetBounds(ARect.Right - GripSize, ARect.Top, GripSize, GripSize);
FGrip[3].SetBounds(ARect.Right - GripSize, (ARect.Top + ARect.Bottom - GripSize) div 2, GripSize, GripSize);
FGrip[4].SetBounds(ARect.Right - GripSize, ARect.Bottom - GripSize, GripSize, GripSize);
FGrip[5].SetBounds((ARect.Left + ARect.Right - GripSize) div 2, ARect.Bottom - GripSize, GripSize, GripSize);
FGrip[6].SetBounds(ARect.Left, ARect.Bottom - GripSize, GripSize, GripSize);
FGrip[7].SetBounds(ARect.Left, (ARect.Top + ARect.Bottom - GripSize) div 2, GripSize, GripSize);
end;
end.

644
components/dockedformeditor/source/dockedgrip.pas Normal file
View File

@ -0,0 +1,644 @@
{
*****************************************************************************
See the file COPYING.modifiedLGPL.txt, included in this distribution,
for details about the license.
*****************************************************************************
Author: Michael W. Vogel
Grips: 1
0 +-----+-----+ 2
| |
7 + + 3
| |
6 +-----+-----+ 4
5
ResizeGrips: Only grips 3, 4, and 5 are used for sizing
ResizeBars: 0 1
+-----+-----+
7 | | 2
+ +
6 | | 3
+-----+-----+
5 4
Only bars 2, 3, 4, and 5 are used for sizing
ResizeContainer is just a container for without any logic.
Logic is added in ResizeControl
}
unit DockedGrip;
{$mode objfpc}{$H+}
interface
uses
// RTL, FCL
Classes, SysUtils, math,
// LCL
Controls, ExtCtrls, Graphics, Menus;
type
{ TGrip }
TGrip = class(TPanel)
private
FActivated: Boolean;
FShape: TShape;
procedure SetActivated(AValue: Boolean);
public
constructor Create(TheOwner: TComponent); override;
public
property Activated: Boolean read FActivated write SetActivated;
end;
{ TBar }
TBar = class(TPanel)
private
FActivated: Boolean;
public
constructor Create(TheOwner: TComponent); override;
public
property Activated: Boolean read FActivated write FActivated;
end;
{ TCustomGrips }
TCustomGrips = class
private const
GRIP_SIZE = 8;
private
FGrip: array[0..7] of TGrip;
FGripSize: Integer;
FOnMouseDown: TMouseEvent;
FOnMouseMove: TMouseMoveEvent;
FOnMouseUp: TMouseEvent;
FParent: TWinControl;
function GetGrip(AIndex: Integer): TGrip;
function GetPopupMenu: TPopupMenu;
procedure InitGrip(AGrip: TGrip; ACursor: TCursor; Activated: Boolean);
procedure SetOnMouseDown(AValue: TMouseEvent);
procedure SetOnMouseMove(AValue: TMouseMoveEvent);
procedure SetOnMouseUp(AValue: TMouseEvent);
procedure SetParent(AValue: TWinControl);
procedure SetPopupMenu(AValue: TPopupMenu);
protected
procedure InitGrips; virtual; abstract;
public
constructor Create;
destructor Destroy; override;
procedure BringToFront;
procedure Hide;
procedure SetBounds(ARect: TRect);
public
property GripSize: Integer read FGripSize;
property GripTopLeft: TGrip index 0 read GetGrip;
property GripTopCenter: TGrip index 1 read GetGrip;
property GripTopRight: TGrip index 2 read GetGrip;
property GripCenterRight: TGrip index 3 read GetGrip;
property GripBottomRight: TGrip index 4 read GetGrip;
property GripBottomCenter: TGrip index 5 read GetGrip;
property GripBottomLeft: TGrip index 6 read GetGrip;
property GripCenterLeft: TGrip index 7 read GetGrip;
property OnMouseDown: TMouseEvent read FOnMouseDown write SetOnMouseDown;
property OnMouseMove: TMouseMoveEvent read FOnMouseMove write SetOnMouseMove;
property OnMouseUp: TMouseEvent read FOnMouseUp write SetOnMouseUp;
property Parent: TWinControl read FParent write SetParent;
property PopupMenu: TPopupMenu read GetPopupMenu write SetPopupMenu;
end;
{ TAnchorGrips }
TAnchorGrips = class(TCustomGrips)
private
FBackGround: TWinControl;
function CalculateRect(AControl: TControl): TRect;
protected
procedure InitGrips; override;
public
procedure AdjustGrips(AControl: TControl);
public
property BackGround: TWinControl read FBackGround write FBackGround;
end;
{ TResizeGrips }
TResizeGrips = class(TCustomGrips)
protected
procedure InitGrips; override;
end;
{ TResizeBars }
TResizeBars = class
private const
BAR_SIZE = 8;
private
FBar: array[0..7] of TBar;
FBarSize: Integer;
FOnMouseDown: TMouseEvent;
FOnMouseMove: TMouseMoveEvent;
FOnMouseUp: TMouseEvent;
FOnPaint: TNotifyEvent;
FParent: TWinControl;
function GetBar(AIndex: Integer): TBar;
function GetPopupMenu: TPopupMenu;
procedure InitBar(ABar: TBar; ACursor: TCursor; Activated: Boolean);
procedure SetOnMouseDown(AValue: TMouseEvent);
procedure SetOnMouseMove(AValue: TMouseMoveEvent);
procedure SetOnMouseUp(AValue: TMouseEvent);
procedure SetOnPaint(AValue: TNotifyEvent);
procedure SetParent(AValue: TWinControl);
procedure SetPopupMenu(AValue: TPopupMenu);
protected
procedure InitBars;
public
constructor Create;
destructor Destroy; override;
procedure SetBounds(ARect: TRect);
public
property BarSize: Integer read FBarSize;
property BarTopLeft: TBar index 0 read GetBar;
property BarTopRight: TBar index 1 read GetBar;
property BarRightTop: TBar index 2 read GetBar;
property BarRightBottom: TBar index 3 read GetBar;
property BarBottomRight: TBar index 4 read GetBar;
property BarBottomLeft: TBar index 5 read GetBar;
property BarLeftBottom: TBar index 6 read GetBar;
property BarLeftTop: TBar index 7 read GetBar;
property OnMouseDown: TMouseEvent read FOnMouseDown write SetOnMouseDown;
property OnMouseMove: TMouseMoveEvent read FOnMouseMove write SetOnMouseMove;
property OnMouseUp: TMouseEvent read FOnMouseUp write SetOnMouseUp;
property OnPaint: TNotifyEvent read FOnPaint write SetOnPaint;
property Parent: TWinControl read FParent write SetParent;
property PopupMenu: TPopupMenu read GetPopupMenu write SetPopupMenu;
end;
{ TResizeContainer }
TResizeContainer = class(TComponent)
private
FAnchorContainer: TWinControl;
FBoundsRect: TRect;
FFakeMenu: TCustomControl;
FFormClient: TWinControl;
FFormContainer: TWinControl;
FParent: TWinControl;
FResizeBars: TResizeBars;
FResizeGrips: TResizeGrips;
public
constructor Create(AWinControl: TWinControl); reintroduce;
destructor Destroy; override;
function IsHorzSizer(AObject: TObject): Boolean;
function IsVertSizer(AObject: TObject): Boolean;
procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
public
property AnchorContainer: TWinControl read FAnchorContainer;
property BoundsRect: TRect read FBoundsRect;
property FakeMenu: TCustomControl read FFakeMenu;
property FormClient: TWinControl read FFormClient;
property FormContainer: TWinControl read FFormContainer;
property Parent: TWinControl read FParent;
property ResizeBars: TResizeBars read FResizeBars;
property ResizeGrips: TResizeGrips read FResizeGrips;
end;
implementation
{ TGrip }
procedure TGrip.SetActivated(AValue: Boolean);
begin
if FActivated = AValue then Exit;
FActivated := AValue;
if AValue then
FShape.Brush.Color := clBtnFace
else
FShape.Brush.Color := clGray;
end;
constructor TGrip.Create(TheOwner: TComponent);
begin
inherited Create(TheOwner);
BevelOuter := bvNone;
Color := clBlack;
SetInitialBounds(0, 0, 8, 8);
FActivated := False;
FShape := TShape.Create(Self);
FShape.Align := alClient;
FShape.Brush.Color := clGray;
FShape.Enabled := False;
FShape.Parent := Self;
end;
{ TBar }
constructor TBar.Create(TheOwner: TComponent);
begin
inherited Create(TheOwner);
BevelOuter := bvNone;
Color := clNone;
SetInitialBounds(0, 0, 8, 8);
FActivated := False;
end;
{ TCustomGrips }
function TCustomGrips.GetGrip(AIndex: Integer): TGrip;
begin
Result := FGrip[AIndex];
end;
function TCustomGrips.GetPopupMenu: TPopupMenu;
begin
Result := FGrip[0].PopupMenu;
end;
procedure TCustomGrips.InitGrip(AGrip: TGrip; ACursor: TCursor; Activated: Boolean);
begin
AGrip.Parent := FParent;
AGrip.Cursor := ACursor;
AGrip.Activated := Activated;
end;
procedure TCustomGrips.SetOnMouseDown(AValue: TMouseEvent);
var
i: Integer;
begin
if FOnMouseDown = AValue then Exit;
FOnMouseDown := AValue;
for i := 0 to 7 do
if FGrip[i].Activated then
FGrip[i].OnMouseDown := AValue;
end;
procedure TCustomGrips.SetOnMouseMove(AValue: TMouseMoveEvent);
var
i: Integer;
begin
if FOnMouseMove = AValue then Exit;
FOnMouseMove := AValue;
for i := 0 to 7 do
if FGrip[i].Activated then
FGrip[i].OnMouseMove := AValue;
end;
procedure TCustomGrips.SetOnMouseUp(AValue: TMouseEvent);
var
i: Integer;
begin
if FOnMouseUp = AValue then Exit;
FOnMouseUp := AValue;
for i := 0 to 7 do
if FGrip[i].Activated then
FGrip[i].OnMouseUp := AValue;
end;
procedure TCustomGrips.SetParent(AValue: TWinControl);
var
i: Integer;
begin
if FParent = AValue then Exit;
FParent := AValue;
for i := 0 to 7 do
FGrip[i].Parent := AValue;
end;
procedure TCustomGrips.SetPopupMenu(AValue: TPopupMenu);
var
i: Integer;
begin
if GetPopupMenu = AValue then Exit;
for i := 0 to 7 do
if FGrip[i].Activated then
FGrip[i].PopupMenu := AValue;
end;
constructor TCustomGrips.Create;
var
i: Integer;
begin
FGripSize := ScaleX(GRIP_SIZE, 96);
for i := 0 to 7 do
FGrip[i] := TGrip.Create(nil);
InitGrips;
end;
destructor TCustomGrips.Destroy;
var
i: Integer;
begin
for i := 7 downto 0 do
FGrip[i].Free;
inherited Destroy;
end;
procedure TCustomGrips.BringToFront;
var
i: Integer;
begin
for i := 0 to 7 do
begin
FGrip[i].Visible := True;
FGrip[i].BringToFront;
end;
end;
procedure TCustomGrips.Hide;
var
i: Integer;
begin
for i := 0 to 7 do
FGrip[i].Visible := False;
end;
procedure TCustomGrips.SetBounds(ARect: TRect);
var
LMiddleLeft, LMiddleTop: Integer;
begin
if not Assigned(FParent) then Exit;
LMiddleLeft := (ARect.Left + ARect.Right - GripSize) div 2;
LMiddleTop := (ARect.Top + ARect.Bottom - GripSize) div 2;
FGrip[0].SetBounds(ARect.Left, ARect.Top, GripSize, GripSize);
FGrip[1].SetBounds(LMiddleLeft, ARect.Top, GripSize, GripSize);
FGrip[2].SetBounds(ARect.Right - GripSize, ARect.Top, GripSize, GripSize);
FGrip[3].SetBounds(ARect.Right - GripSize, LMiddleTop, GripSize, GripSize);
FGrip[4].SetBounds(ARect.Right - GripSize, ARect.Bottom - GripSize, GripSize, GripSize);
FGrip[5].SetBounds(LMiddleLeft, ARect.Bottom - GripSize, GripSize, GripSize);
FGrip[6].SetBounds(ARect.Left, ARect.Bottom - GripSize, GripSize, GripSize);
FGrip[7].SetBounds(ARect.Left, LMiddleTop, GripSize, GripSize);
end;
{ TAnchorGrips }
function TAnchorGrips.CalculateRect(AControl: TControl): TRect;
var
LTopLeft, LBottomRight: TPoint;
LGripOffset: Integer;
begin
Result := Rect(0, 0, BackGround.Width, BackGround.Height);
if not Assigned(AControl) then Exit;
if AControl = BackGround then Exit;
// grip in middle of rect border is default, if to small, use dynamic offset
LGripOffset := Max(GripSize div 2, (GripSize * 10 - AControl.Width) div 10);
LTopLeft.x := -LGripOffset;
LBottomRight.x := AControl.Width + LGripOffset;
LGripOffset := Max(GripSize div 2, (GripSize * 10 - AControl.Height) div 10);
LTopLeft.y := -LGripOffset;
LBottomRight.y := AControl.Height + LGripOffset;
LTopLeft := AControl.ClientToParent(LTopLeft, BackGround);
LBottomRight := AControl.ClientToParent(LBottomRight, BackGround);
LTopLeft.x := Max(LTopLeft.x, 0);
LTopLeft.y := Max(LTopLeft.y, 0);
LBottomRight.x := Min(LBottomRight.x, BackGround.Width);
LBottomRight.y := Min(LBottomRight.y, BackGround.Height);
Result := Rect(LTopLeft.x, LTopLeft.y, LBottomRight.x, LBottomRight.y);
end;
procedure TAnchorGrips.InitGrips;
begin
// on mac there is no cursor for crNWSE ( https://bugs.freepascal.org/view.php?id=32194#c101876 )
InitGrip(GripTopLeft, {$IFDEF MACOS}crSizeAll{$ELSE}crSizeNWSE{$ENDIF}, True);
InitGrip(GripTopCenter, crSizeNS , True);
InitGrip(GripTopRight, {$IFDEF MACOS}crSizeAll{$ELSE}crSizeNESW{$ENDIF}, True);
InitGrip(GripCenterRight, crSizeWE , True);
InitGrip(GripBottomRight, {$IFDEF MACOS}crSizeAll{$ELSE}crSizeNWSE{$ENDIF}, True);
InitGrip(GripBottomCenter, crSizeNS , True);
InitGrip(GripBottomLeft, {$IFDEF MACOS}crSizeAll{$ELSE}crSizeNESW{$ENDIF}, True);
InitGrip(GripCenterLeft, crSizeWE , True);
end;
procedure TAnchorGrips.AdjustGrips(AControl: TControl);
var
LRect: TRect;
begin
if not Assigned(AControl) then
begin
Hide;
Exit;
end;
AControl.BringToFront;
LRect := CalculateRect(AControl);
SetBounds(LRect);
BringToFront;
end;
{ TResizeGrips }
procedure TResizeGrips.InitGrips;
begin
InitGrip(GripTopLeft, crDefault , False);
InitGrip(GripTopCenter, crDefault , False);
InitGrip(GripTopRight, crDefault , False);
InitGrip(GripCenterRight, crSizeWE , True);
InitGrip(GripBottomRight, {$IFDEF MACOS}crSizeAll{$ELSE}crSizeNWSE{$ENDIF}, True);
InitGrip(GripBottomCenter, crSizeNS , True);
InitGrip(GripBottomLeft, crDefault , False);
InitGrip(GripCenterLeft, crDefault , False);
end;
{ TResizeBars }
function TResizeBars.GetBar(AIndex: Integer): TBar;
begin
Result := FBar[AIndex];
end;
function TResizeBars.GetPopupMenu: TPopupMenu;
begin
Result := FBar[0].PopupMenu;
end;
procedure TResizeBars.InitBar(ABar: TBar; ACursor: TCursor; Activated: Boolean);
begin
ABar.Parent := FParent;
ABar.Cursor := ACursor;
ABar.Activated := Activated;
end;
procedure TResizeBars.SetOnMouseDown(AValue: TMouseEvent);
var
i: Integer;
begin
if FOnMouseDown = AValue then Exit;
FOnMouseDown := AValue;
for i := 0 to 7 do
if FBar[i].Activated then
FBar[i].OnMouseDown := AValue;
end;
procedure TResizeBars.SetOnMouseMove(AValue: TMouseMoveEvent);
var
i: Integer;
begin
if FOnMouseMove = AValue then Exit;
FOnMouseMove := AValue;
for i := 0 to 7 do
if FBar[i].Activated then
FBar[i].OnMouseMove := AValue;
end;
procedure TResizeBars.SetOnMouseUp(AValue: TMouseEvent);
var
i: Integer;
begin
if FOnMouseUp = AValue then Exit;
FOnMouseUp := AValue;
for i := 0 to 7 do
if FBar[i].Activated then
FBar[i].OnMouseUp := AValue;
end;
procedure TResizeBars.SetOnPaint(AValue: TNotifyEvent);
var
i: Integer;
begin
if FOnPaint = AValue then Exit;
FOnPaint := AValue;
for i := 0 to 7 do
FBar[i].OnPaint := AValue;
end;
procedure TResizeBars.SetParent(AValue: TWinControl);
var
i: Integer;
begin
if FParent = AValue then Exit;
FParent := AValue;
for i := 0 to 7 do
FBar[i].Parent := AValue;
end;
procedure TResizeBars.SetPopupMenu(AValue: TPopupMenu);
var
i: Integer;
begin
if GetPopupMenu = AValue then Exit;
for i := 0 to 7 do
if FBar[i].Activated then
FBar[i].PopupMenu := AValue;
end;
procedure TResizeBars.InitBars;
begin
InitBar(BarTopLeft, crDefault, False);
InitBar(BarTopRight, crDefault, False);
InitBar(BarRightTop, crSizeWE, True);
InitBar(BarRightBottom, crSizeWE, True);
InitBar(BarBottomRight, crSizeNS, True);
InitBar(BarBottomLeft, crSizeNS, True);
InitBar(BarLeftBottom, crDefault, False);
InitBar(BarLeftTop, crDefault, False);
end;
constructor TResizeBars.Create;
var
i: Integer;
begin
FBarSize := ScaleX(BAR_SIZE, 96);
for i := 0 to 7 do
FBar[i] := TBar.Create(nil);
InitBars;
end;
destructor TResizeBars.Destroy;
var
i: Integer;
begin
for i := 7 downto 0 do
FBar[i].Free;
inherited Destroy;
end;
procedure TResizeBars.SetBounds(ARect: TRect);
var
LMiddleLeft, LMiddleTop: Integer;
begin
if not Assigned(FParent) then Exit;
LMiddleLeft := (ARect.Left + ARect.Right - BarSize) div 2;
LMiddleTop := (ARect.Top + ARect.Bottom - BarSize) div 2;
FBar[0].SetBounds(ARect.Left + BarSize, ARect.Top, LMiddleLeft - ARect.Left - BarSize, BarSize);
FBar[1].SetBounds(LMiddleLeft + BarSize, ARect.Top, ARect.Right - LMiddleLeft - BarSize * 2, BarSize);
FBar[2].SetBounds(ARect.Right - BarSize, ARect.Top + BarSize, BarSize, LMiddleTop - ARect.Top - BarSize);
FBar[3].SetBounds(ARect.Right - BarSize, LMiddleTop + BarSize, BarSize, ARect.Bottom - LMiddleTop - BarSize * 2);
FBar[4].SetBounds(LMiddleLeft + BarSize, ARect.Bottom - BarSize, ARect.Right - LMiddleLeft - BarSize * 2, BarSize);
FBar[5].SetBounds(ARect.Left + BarSize, ARect.Bottom - BarSize, LMiddleLeft - ARect.Left - BarSize, BarSize);
FBar[6].SetBounds(ARect.Left, LMiddleTop + BarSize, BarSize, ARect.Bottom - LMiddleTop - BarSize * 2);
FBar[7].SetBounds(ARect.Left, ARect.Top + BarSize, BarSize, LMiddleTop - ARect.Top - BarSize);
end;
{ TResizeContainer }
constructor TResizeContainer.Create(AWinControl: TWinControl);
begin
inherited Create(AWinControl);
FParent := AWinControl;
FBoundsRect := Rect(0, 0, 0, 0);
FResizeGrips := TResizeGrips.Create;
FResizeGrips.Parent := Parent;
FResizeBars := TResizeBars.Create;
FResizeBars.Parent := Parent;
FFakeMenu := TCustomControl.Create(Parent);
FFakeMenu.Height := 0;
FFakeMenu.Parent := Parent;
FFormClient := TWinControl.Create(Parent);
FFormClient.Color := clBtnFace;
FFormClient.Parent := Parent;
FFormContainer := TWinControl.Create(FFormClient);
FFormContainer.Parent := FFormClient;
FAnchorContainer := TWinControl.Create(Parent);
FAnchorContainer.Visible := False;
FAnchorContainer.Parent := Parent;
end;
destructor TResizeContainer.Destroy;
begin
FResizeBars.Free;
FResizeGrips.Free;
inherited Destroy;
end;
function TResizeContainer.IsHorzSizer(AObject: TObject): Boolean;
begin
Result := (AObject = ResizeGrips.GripCenterRight) or
(AObject = ResizeGrips.GripBottomRight) or
(AObject = ResizeBars.BarRightTop) or
(AObject = ResizeBars.BarRightBottom);
end;
function TResizeContainer.IsVertSizer(AObject: TObject): Boolean;
begin
Result := (AObject = ResizeGrips.GripBottomCenter) or
(AObject = ResizeGrips.GripBottomRight) or
(AObject = ResizeBars.BarBottomLeft) or
(AObject = ResizeBars.BarBottomRight);
end;
procedure TResizeContainer.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
begin
FBoundsRect := Rect(ALeft, ATop, ALeft + AWidth, ATop + AHeight);
FResizeGrips.SetBounds(FBoundsRect);
FResizeBars.SetBounds(FBoundsRect);
FFakeMenu.SetBounds(ALeft + FResizeBars.BarSize, ATop + FResizeBars.BarSize, AWidth - FResizeBars.BarSize * 2, FFakeMenu.Height);
FFormClient.SetBounds(ALeft + FResizeBars.BarSize, ATop + FResizeBars.BarSize + FFakeMenu.Height, AWidth - FResizeBars.BarSize * 2, AHeight - FResizeBars.BarSize * 2 - FFakeMenu.Height);
FAnchorContainer.SetBounds(ALeft + FResizeBars.BarSize, ATop + FResizeBars.BarSize + FFakeMenu.Height, AWidth - FResizeBars.BarSize * 2, AHeight - FResizeBars.BarSize * 2 - FFakeMenu.Height);
end;
end.

2
components/dockedformeditor/source/dockedmainide.pas
View File

@ -708,7 +708,7 @@ begin
LPageCtrl := GetCurrentPageControl;
if not Assigned(LPageCtrl) then Exit;
if not Assigned(LPageCtrl.Resizer) then Exit;
LPageCtrl.Resizer.ResizeFrame.OnModified;
LPageCtrl.Resizer.ResizeControl.OnModified;
end;
class procedure TDockedMainIDE.OnDesignPersistentAdded(APersistent: TPersistent; Select: Boolean);

12
components/dockedformeditor/source/dockedmodulepagecontrol.pas
View File

@ -28,7 +28,7 @@ uses
SrcEditorIntf, FormEditingIntf,
// DockedFormEditor
DockedDesignForm, DockedResizer, DockedOptionsIDE, DockedAnchorDesigner,
DockedTools, DockedStrConsts;
{%H-}DockedTools, DockedStrConsts;
type
@ -225,17 +225,17 @@ begin
if ActivePage = FTabSheetDesigner then
begin
Resizer.Parent := FTabSheetDesigner;
Resizer.ResizeFrame.PanelFormClient.Visible := True;
Resizer.ResizeFrame.PanelAnchorContainer.Visible := False;
Resizer.ResizeControl.FormClient.Visible := True;
Resizer.ResizeControl.AnchorContainer.Visible := False;
end
else if ActivePage = FTabSheetAnchors then
begin
Resizer.Parent := FTabSheetAnchors;
Resizer.ResizeFrame.PanelFormClient.Visible := False;
Resizer.ResizeFrame.PanelAnchorContainer.Visible := True;
Resizer.ResizeControl.FormClient.Visible := False;
Resizer.ResizeControl.AnchorContainer.Visible := True;
if not Assigned(DesignForm.AnchorDesigner) then
begin
DesignForm.AnchorDesigner := TAnchorDesigner.Create(DesignForm, Resizer.ResizeFrame.PanelAnchorContainer);
DesignForm.AnchorDesigner := TAnchorDesigner.Create(DesignForm, Resizer.ResizeControl.AnchorContainer);
DesignForm.AnchorDesigner.OnDesignerSetFocus := @DesignerSetFocus;
end;
DesignForm.AnchorDesigner.Refresh;

347
components/dockedformeditor/source/dockedresizeframe.pas → components/dockedformeditor/source/dockedresizecontrol.pas
View File

@ -7,21 +7,9 @@
Authors: Maciej Izak
Michael W. Vogel
Don't change DesignTimePPI of ResizeFrame (dockedresizeframe.lfm)!
There always has to be the default (none entry = 96 PPI) value!
Size grips: 1
0 +----+----+ 2
| |
7 + + 3
| |
6 +----+----+ 4
5
Only grips 3, 4, and 5 are used for sizing
}
unit DockedResizeFrame;
unit DockedResizeControl;
{$mode objfpc}{$H+}
{ $define DEBUGDOCKEDFORMEDITOR}
@ -35,65 +23,27 @@ uses
Forms, ExtCtrls, StdCtrls, Controls, LCLType, Menus, Graphics, LCLIntf,
LMessages, LCLProc,
// DockedFormEditor
DockedOptionsIDE, DockedDesignForm;
DockedOptionsIDE, DockedDesignForm, DockedGrip;
type
{ TResizeFrame }
{ TResizeControl }
TResizeFrame = class(TFrame)
PanelAnchorContainer: TPanel;
PanelBarBottomLeft: TPanel;
PanelBarLeftTop: TPanel;
PanelBarRightBottom: TPanel;
PanelBarBottomRight: TPanel;
PanelBarLeftBottom: TPanel;
PanelBarTopRight: TPanel;
PanelBarRightTop: TPanel;
PanelGripLeftCenter: TPanel;
PanelGripBottomRight: TPanel;
PanelGripBottomCenter: TPanel;
PanelGripBottomLeft: TPanel;
PanelGripTopRight: TPanel;
PanelGripRightCenter: TPanel;
PanelResizer: TPanel;
PanelBarTopLeft: TPanel;
PanelGripTopLeft: TPanel;
PanelGripTopCenter: TPanel;
PanelFormContainer: TPanel;
PanelFakeMenu: TPanel;
PanelBackground: TPanel;
PanelFormClient: TPanel;
ShapeGripLeftCenter: TShape;
ShapeGripBottomRight: TShape;
ShapeGripBottomCenter: TShape;
ShapeGripBottomLeft: TShape;
ShapeGripTopRight: TShape;
ShapeGripRightCenter: TShape;
ShapeGripTopLeft: TShape;
ShapeGripTopCenter: TShape;
procedure PanelBarPaint(Sender: TObject);
procedure PanelFakeMenuPaint(Sender: TObject);
private const
SIZER_GRIP_SIZE = 8;
TResizeControl = class(TWinControl)
private
FBitmapBarActive: TBitmap;
FBitmapBarInactive: TBitmap;
FDesignForm: TDesignForm;
FDesignerModified: Boolean;
FFakeFocusControl: TWinControl;
FHorzScrollPos: Integer;
FNewFormSize: TPoint;
FOldBounds: TRect;
FOldFakeMenuNeeded: Boolean;
FOldMousePos: TPoint;
FOldResizerBounds: TRect;
FOnResized: TNotifyEvent;
FResizeContainer: TResizeContainer;
FResizing: Boolean;
FSizerGripSize: Integer;
FVertScrollPos: Integer;
procedure ActivateResizeGrip(APanel: TPanel; ACursor: TCursor);
procedure ActivateResizeGrips;
procedure AdjustFormContainer;
procedure AppOnIdle(Sender: TObject; var {%H-}Done: Boolean);
procedure BeginFormSizeUpdate(Sender: TObject);
@ -104,11 +54,16 @@ type
procedure FakeKeyDown(Sender: TObject; var Key: Word; {%H-}Shift: TShiftState);
procedure FakeKeyUp(Sender: TObject; var Key: Word; {%H-}Shift: TShiftState);
function FakeMenuNeeded: Boolean;
procedure FakeMenuPaint(Sender: TObject);
procedure FakeUTF8KeyPress(Sender: TObject; var UTF8Key: TUTF8Char);
function GetAnchorContainer: TWinControl;
function GetFakeMenu: TCustomControl;
function GetFormClient: TWinControl;
function GetFormContainer: TWinControl;
function GetMenuHeight: Integer;
function IsHorzSizer(Sender: TObject): Boolean;
function IsVertSizer(Sender: TObject): Boolean;
function GetSizerGripSize: Integer;
procedure RefreshAnchorDesigner;
procedure ResizeBarPaint(Sender: TObject);
procedure SizerMouseDown(Sender: TObject; {%H-}Button: TMouseButton; {%H-}Shift: TShiftState; {%H-}X, {%H-}Y: Integer);
procedure SizerMouseMove(Sender: TObject; {%H-}Shift: TShiftState; {%H-}X, {%H-}Y: Integer);
procedure SizerMouseUp(Sender: TObject; {%H-}Button: TMouseButton; {%H-}Shift: TShiftState; {%H-}X, {%H-}Y: Integer);
@ -117,90 +72,28 @@ type
public
constructor Create(TheOwner: TComponent); override;
destructor Destroy; override;
procedure AdjustPanelResizer;
procedure AdjustBounds(ScrollOffset: TPoint);
procedure ClientChangeBounds(Sender: TObject); overload;
procedure DesignerSetFocus;
procedure OnModified;
function IsFocused: Boolean;
function IsFocused: Boolean;
public
property AnchorContainer: TWinControl read GetAnchorContainer;
property DesignForm: TDesignForm read FDesignForm write SetDesignForm;
property HorzScrollPos: Integer read FHorzScrollPos write FHorzScrollPos;
property VertScrollPos: Integer read FVertScrollPos write FVertScrollPos;
property FakeMenu: TCustomControl read GetFakeMenu;
property FormClient: TWinControl read GetFormClient;
property FormContainer: TWinControl read GetFormContainer;
property NewFormSize: TPoint read FNewFormSize;
property Resizing: Boolean read FResizing;
property OnResized: TNotifyEvent read FOnResized write FOnResized;
property SizerGripSize: Integer read FSizerGripSize;
property Resizing: Boolean read FResizing;
property SizerGripSize: Integer read GetSizerGripSize;
end;
implementation
{$R *.lfm}
{ TResizerFrame }
procedure TResizeFrame.PanelBarPaint(Sender: TObject);
var
LPanel: TPanel;
begin
if FResizing then Exit;
if not (Sender is TPanel) then Exit;
LPanel := TPanel(Sender);
LPanel.Canvas.Brush.Style := bsImage;
if IsFocused then
LPanel.Canvas.Brush.Bitmap := FBitmapBarActive
else
LPanel.Canvas.Brush.Bitmap := FBitmapBarInactive;
LPanel.Canvas.FillRect(1, 1, LPanel.ClientWidth - 1, LPanel.ClientHeight - 1);
end;
procedure TResizeFrame.PanelFakeMenuPaint(Sender: TObject);
var
MenuRect: Types.TRect;
Menu: TMainMenu;
X, Y, I: Integer;
LCanvas: TCanvas;
begin
if not FakeMenuNeeded then Exit;
MenuRect := PanelFakeMenu.ClientRect;
LCanvas := PanelFakeMenu.Canvas;
LCanvas.Brush.Color := clMenuBar;
LCanvas.FillRect(MenuRect);
Menu := FDesignForm.Form.Menu;
LCanvas.Font.Color := clMenuText;
X := 5;
Y := (MenuRect.Top+MenuRect.Bottom-LCanvas.TextHeight('Hg')) div 2;
for I := 0 to Menu.Items.Count-1 do
if Menu.Items[I].Visible then
begin
LCanvas.TextOut(X, Y, Menu.Items[I].Caption);
Inc(X, LCanvas.TextWidth(Menu.Items[I].Caption) + 10);
end;
end;
procedure TResizeFrame.ActivateResizeGrip(APanel: TPanel; ACursor: TCursor);
begin
APanel.OnMouseDown := @SizerMouseDown;
APanel.OnMouseMove := @SizerMouseMove;
APanel.OnMouseUp := @SizerMouseUp;
APanel.Cursor := ACursor;
end;
procedure TResizeFrame.ActivateResizeGrips;
begin
ActivateResizeGrip(PanelBarRightTop, crSizeWE);
ActivateResizeGrip(PanelGripRightCenter, crSizeWE);
ActivateResizeGrip(PanelBarRightBottom, crSizeWE);
// on mac there is no cursor for crNWSE ( https://bugs.freepascal.org/view.php?id=32194#c101876 )
ActivateResizeGrip(PanelGripBottomRight, {$IFDEF MACOS}crSizeAll{$ELSE}crSizeNWSE{$ENDIF});
ActivateResizeGrip(PanelBarBottomRight, crSizeNS);
ActivateResizeGrip(PanelGripBottomCenter, crSizeNS);
ActivateResizeGrip(PanelBarBottomLeft, crSizeNS);
end;
procedure TResizeFrame.AdjustFormContainer;
procedure TResizeControl.AdjustFormContainer;
var
LLeft, LTop, LWidth, LHeight: Integer;
begin
@ -214,11 +107,11 @@ begin
LHeight := FDesignForm.Form.Height
+ Abs(FDesignForm.Form.Top)
+ FDesignForm.ClientOffset.Y;
PanelFormContainer.SetBounds(LLeft, LTop, LWidth, LHeight);
FormContainer.SetBounds(LLeft, LTop, LWidth, LHeight);
RefreshAnchorDesigner;
end;
procedure TResizeFrame.AppOnIdle(Sender: TObject; var Done: Boolean);
procedure TResizeControl.AppOnIdle(Sender: TObject; var Done: Boolean);
var
LFakeMenuNeeded: Boolean;
begin
@ -234,19 +127,18 @@ begin
Application.NotifyUserInputHandler(Self, 0); // force repaint invisible components
end else
if LFakeMenuNeeded then
PanelFakeMenu.Invalidate; // always repaint menu on modification
FakeMenu.Invalidate; // always repaint menu on modification
RefreshAnchorDesigner;
FDesignerModified := False;
end;
end;
procedure TResizeFrame.BeginFormSizeUpdate(Sender: TObject);
procedure TResizeControl.BeginFormSizeUpdate(Sender: TObject);
begin
// PanelBackground.Visible := False;
FDesignForm.BeginUpdate;
end;
procedure TResizeFrame.CreateBarBitmaps;
procedure TResizeControl.CreateBarBitmaps;
begin
FBitmapBarActive := TBitmap.Create;
FBitmapBarActive.SetSize(2, 2);
@ -263,7 +155,7 @@ begin
FBitmapBarInactive.Canvas.Pixels[1, 1] := clGray;
end;
function TResizeFrame.CurrentSizingOffset(Sender: TObject): TPoint;
function TResizeControl.CurrentSizingOffset(Sender: TObject): TPoint;
var
LNewPos: TPoint;
begin
@ -271,22 +163,21 @@ begin
LNewPos := Result;
GetCursorPos(LNewPos);
if LNewPos = FOldMousePos then Exit;
if IsHorzSizer(Sender) then Result.X := LNewPos.X - FOldMousePos.X;
if IsVertSizer(Sender) then Result.Y := LNewPos.Y - FOldMousePos.Y;
if FResizeContainer.IsHorzSizer(Sender) then Result.X := LNewPos.X - FOldMousePos.X;
if FResizeContainer.IsVertSizer(Sender) then Result.Y := LNewPos.Y - FOldMousePos.Y;
end;
procedure TResizeFrame.EndFormSizeUpdate(Sender: TObject);
procedure TResizeControl.EndFormSizeUpdate(Sender: TObject);
begin
FDesignForm.EndUpdate;
// PanelBackground.Visible := True;
end;
procedure TResizeFrame.FakeExitEnter(Sender: TObject);
procedure TResizeControl.FakeExitEnter(Sender: TObject);
begin
Repaint;
end;
procedure TResizeFrame.FakeKeyDown(Sender: TObject; var Key: Word;
procedure TResizeControl.FakeKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
var
LWndProc: TWndMethod;
@ -294,7 +185,7 @@ var
begin
case Key of
VK_ESCAPE:
if Assigned(DesignForm) and Assigned(DesignForm.AnchorDesigner) and PanelAnchorContainer.Visible then
if Assigned(DesignForm) and Assigned(DesignForm.AnchorDesigner) and AnchorContainer.Visible then
begin
DesignForm.AnchorDesigner.Abort;
Exit;
@ -309,7 +200,7 @@ begin
Key := LMsg.CharCode;
end;
procedure TResizeFrame.FakeKeyUp(Sender: TObject; var Key: Word;
procedure TResizeControl.FakeKeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
var
LWndProc: TWndMethod;
@ -323,7 +214,7 @@ begin
Key := LMsg.CharCode;
end;
function TResizeFrame.FakeMenuNeeded: Boolean;
function TResizeControl.FakeMenuNeeded: Boolean;
var
i: Integer;
begin
@ -343,12 +234,59 @@ begin
Exit(True);
end;
procedure TResizeFrame.FakeUTF8KeyPress(Sender: TObject; var UTF8Key: TUTF8Char);
procedure TResizeControl.FakeMenuPaint(Sender: TObject);
var
MenuRect: Types.TRect;
Menu: TMainMenu;
X, Y, I: Integer;
LCanvas: TCanvas;
begin
if not FakeMenuNeeded then Exit;
MenuRect := FakeMenu.ClientRect;
LCanvas := FakeMenu.Canvas;
LCanvas.Brush.Color := clMenuBar;
LCanvas.FillRect(MenuRect);
Menu := FDesignForm.Form.Menu;
LCanvas.Font.Color := clMenuText;
X := 5;
Y := (MenuRect.Top+MenuRect.Bottom-LCanvas.TextHeight('Hg')) div 2;
for I := 0 to Menu.Items.Count-1 do
if Menu.Items[I].Visible then
begin
LCanvas.TextOut(X, Y, Menu.Items[I].Caption);
Inc(X, LCanvas.TextWidth(Menu.Items[I].Caption) + 10);
end;
end;
procedure TResizeControl.FakeUTF8KeyPress(Sender: TObject; var UTF8Key: TUTF8Char);
begin
FDesignForm.Form.IntfUTF8KeyPress(UTF8Key, 1, False);
end;
function TResizeFrame.GetMenuHeight: Integer;
function TResizeControl.GetAnchorContainer: TWinControl;
begin
Result := FResizeContainer.AnchorContainer;
end;
function TResizeControl.GetFakeMenu: TCustomControl;
begin
Result := FResizeContainer.FakeMenu;
end;
function TResizeControl.GetFormClient: TWinControl;
begin
Result := FResizeContainer.FormClient;
end;
function TResizeControl.GetFormContainer: TWinControl;
begin
Result := FResizeContainer.FormContainer;
end;
function TResizeControl.GetMenuHeight: Integer;
begin
// some WS (Gtk2) return too big SM_CYMENU, just set it according to font height
// no problem, it is used only for the fake main menu
@ -356,44 +294,40 @@ begin
{$IFDEF LCLWin32}
Result := lclintf.GetSystemMetrics(SM_CYMENU);
{$ELSE}
if PanelBackground.HandleAllocated then
Result := PanelBackground.Canvas.TextHeight('Hg') * 4 div 3
if FakeMenu.HandleAllocated then
Result := FakeMenu.Canvas.TextHeight('Hg') * 4 div 3
else
Result := 20;
{$ENDIF}
end;
function TResizeFrame.IsHorzSizer(Sender: TObject): Boolean;
var
LPanel: TPanel absolute Sender;
function TResizeControl.GetSizerGripSize: Integer;
begin
Result := False;
if not (Sender is TPanel) then Exit;
if LPanel = PanelBarRightTop then Exit(True);
if LPanel = PanelBarRightBottom then Exit(True);
if LPanel = PanelGripRightCenter then Exit(True);
if LPanel = PanelGripBottomRight then Exit(True);
Result := FResizeContainer.ResizeGrips.GripSize;
end;
function TResizeFrame.IsVertSizer(Sender: TObject): Boolean;
var
LPanel: TPanel absolute Sender;
procedure TResizeControl.RefreshAnchorDesigner;
begin
Result := False;
if not (Sender is TPanel) then Exit;
if LPanel = PanelBarBottomLeft then Exit(True);
if LPanel = PanelBarBottomRight then Exit(True);
if LPanel = PanelGripBottomRight then Exit(True);
if LPanel = PanelGripBottomCenter then Exit(True);
end;
procedure TResizeFrame.RefreshAnchorDesigner;
begin
if Assigned(DesignForm) and Assigned(DesignForm.AnchorDesigner) and PanelAnchorContainer.Visible then
if Assigned(DesignForm) and Assigned(DesignForm.AnchorDesigner) and AnchorContainer.Visible then
DesignForm.AnchorDesigner.Refresh;
end;
procedure TResizeFrame.SizerMouseDown(Sender: TObject; Button: TMouseButton;
procedure TResizeControl.ResizeBarPaint(Sender: TObject);
var
LPanel: TPanel;
begin
if FResizing then Exit;
if not (Sender is TPanel) then Exit;
LPanel := TPanel(Sender);
LPanel.Canvas.Brush.Style := bsImage;
if IsFocused then
LPanel.Canvas.Brush.Bitmap := FBitmapBarActive
else
LPanel.Canvas.Brush.Bitmap := FBitmapBarInactive;
LPanel.Canvas.FillRect(1, 1, LPanel.ClientWidth - 1, LPanel.ClientHeight - 1);
end;
procedure TResizeControl.SizerMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if not Enabled then Exit;
@ -406,27 +340,27 @@ begin
SetCapture(TWinControl(Sender).Handle);
{$ENDIF}
GetCursorPos(FOldMousePos);
FOldResizerBounds := PanelResizer.BoundsRect;
FOldBounds := FResizeContainer.BoundsRect;
end;
procedure TResizeFrame.SizerMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
procedure TResizeControl.SizerMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
var
SizeOffset: TPoint;
begin
if not FResizing then Exit;
if not (Sender is TPanel) then Exit;
SizeOffset := CurrentSizingOffset(Sender);
PanelResizer.SetBounds(FOldResizerBounds.Left, FOldResizerBounds.Top, FOldResizerBounds.Width + SizeOffset.X, FOldResizerBounds.Height + SizeOffset.Y);
FResizeContainer.SetBounds(FOldBounds.Left, FOldBounds.Top, FOldBounds.Width + SizeOffset.X, FOldBounds.Height + SizeOffset.Y);
if DockedOptions.ForceRefreshing then
begin
ClientChangeBounds(nil);
if Assigned(OnResized) and PanelFormClient.Visible then
if Assigned(OnResized) and FormClient.Visible then
OnResized(Sender);
end;
end;
procedure TResizeFrame.SizerMouseUp(Sender: TObject; Button: TMouseButton;
procedure TResizeControl.SizerMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if not FResizing then Exit;
@ -444,7 +378,7 @@ begin
DesignerSetFocus;
end;
procedure TResizeFrame.SetDesignForm(const AValue: TDesignForm);
procedure TResizeControl.SetDesignForm(const AValue: TDesignForm);
begin
FDesignForm := AValue;
if Assigned(AValue) then
@ -456,20 +390,27 @@ begin
Application.RemoveOnIdleHandler(@AppOnIdle);
end;
procedure TResizeFrame.TryBoundDesignForm;
procedure TResizeControl.TryBoundDesignForm;
begin
if DesignForm = nil then Exit;
if FakeMenuNeeded then
PanelFakeMenu.Height := GetMenuHeight
FakeMenu.Height := GetMenuHeight
else
PanelFakeMenu.Height := 0;
FakeMenu.Height := 0;
end;
constructor TResizeFrame.Create(TheOwner: TComponent);
constructor TResizeControl.Create(TheOwner: TComponent);
begin
inherited Create(TheOwner);
FSizerGripSize := ScaleX(SIZER_GRIP_SIZE, 96);
FResizeContainer := TResizeContainer.Create(Self);
FResizeContainer.ResizeGrips.OnMouseDown := @SizerMouseDown;
FResizeContainer.ResizeGrips.OnMouseMove := @SizerMouseMove;
FResizeContainer.ResizeGrips.OnMouseUp := @SizerMouseUp;
FResizeContainer.ResizeBars.OnMouseDown := @SizerMouseDown;
FResizeContainer.ResizeBars.OnMouseMove := @SizerMouseMove;
FResizeContainer.ResizeBars.OnMouseUp := @SizerMouseUp;
FResizeContainer.ResizeBars.OnPaint := @ResizeBarPaint;
FFakeFocusControl := TEdit.Create(Self);
FFakeFocusControl.Parent := Self;
@ -480,15 +421,15 @@ begin
FFakeFocusControl.OnEnter := @FakeExitEnter;
FFakeFocusControl.OnExit := @FakeExitEnter;
ActivateResizeGrips;
CreateBarBitmaps;
PanelFormClient.OnChangeBounds := @ClientChangeBounds;
PanelAnchorContainer.OnChangeBounds := @ClientChangeBounds;
AdjustPanelResizer;
FakeMenu.OnPaint := @FakeMenuPaint;
FormClient.OnChangeBounds := @ClientChangeBounds;
AnchorContainer.OnChangeBounds := @ClientChangeBounds;
AdjustBounds(Point(0, 0));
end;
destructor TResizeFrame.Destroy;
destructor TResizeControl.Destroy;
begin
DesignForm := nil;
FBitmapBarInactive.Free;
@ -496,47 +437,47 @@ begin
inherited Destroy;
end;
procedure TResizeFrame.AdjustPanelResizer;
procedure TResizeControl.AdjustBounds(ScrollOffset: TPoint);
var
LWidth, LHeight: Integer;
begin
if FDesignForm = nil then Exit;
LWidth := FDesignForm.Width + 2 * SizerGripSize;
LHeight := FDesignForm.Height + 2 * SizerGripSize;
{$IFDEF DEBUGDOCKEDFORMEDITOR} DebugLn('TResizeFrame.AdjustPanelResizer: New Resizer Panel Width:', DbgS(Width), ' Height: ', DbgS(Height)); {$ENDIF}
PanelResizer.SetBounds(-FHorzScrollPos, -FVertScrollPos, LWidth, LHeight);
{$IFDEF DEBUGDOCKEDFORMEDITOR} DebugLn('TResizeControl.AdjustBounds: New ResizeControl Width:', DbgS(Width), ' Height: ', DbgS(Height)); {$ENDIF}
FResizeContainer.SetBounds(-ScrollOffset.x, -ScrollOffset.y, LWidth, LHeight);
AdjustFormContainer;
end;
procedure TResizeFrame.ClientChangeBounds(Sender: TObject);
procedure TResizeControl.ClientChangeBounds(Sender: TObject);
begin
if (DesignForm = nil) then Exit;
if not DockedOptions.ForceRefreshing and Resizing then Exit;
{$IFDEF DEBUGDOCKEDFORMEDITOR} DebugLn('TResizeFrame.ClientChangeBounds Form Width:', DbgS(PanelFormClient.Width), ' Height: ', DbgS(PanelFormClient.Height)); {$ENDIF}
if PanelFormClient.Visible then
{$IFDEF DEBUGDOCKEDFORMEDITOR} DebugLn('TResizeControl.ClientChangeBounds Form Width:', DbgS(FormClient.Width), ' Height: ', DbgS(FormClient.Height)); {$ENDIF}
if FormClient.Visible then
begin
FNewFormSize.X := PanelFormClient.Width;
FNewFormSize.Y := PanelFormClient.Height + PanelFakeMenu.Height;
end else if PanelAnchorContainer.Visible then
FNewFormSize.X := FormClient.Width;
FNewFormSize.Y := FormClient.Height + FakeMenu.Height;
end else if AnchorContainer.Visible then
begin
FNewFormSize.X := PanelAnchorContainer.Width;
FNewFormSize.Y := PanelAnchorContainer.Height;
FNewFormSize.X := AnchorContainer.Width;
FNewFormSize.Y := AnchorContainer.Height + FakeMenu.Height;
end;
end;
procedure TResizeFrame.DesignerSetFocus;
procedure TResizeControl.DesignerSetFocus;
begin
if FFakeFocusControl.CanSetFocus then
FFakeFocusControl.SetFocus;
end;
procedure TResizeFrame.OnModified;
procedure TResizeControl.OnModified;
begin
FDesignerModified := True;
Invalidate;
end;
function TResizeFrame.IsFocused: Boolean;
function TResizeControl.IsFocused: Boolean;
begin
Result := FFakeFocusControl.Focused;
end;

443
components/dockedformeditor/source/dockedresizeframe.lfm
View File

@ -1,443 +0,0 @@
object ResizeFrame: TResizeFrame
Left = 0
Height = 240
Top = 0
Width = 320
ClientHeight = 240
ClientWidth = 320
ParentFont = False
TabOrder = 0
DesignLeft = 784
DesignTop = 483
object PanelResizer: TPanel
Left = 0
Height = 200
Top = 0
Width = 280
BevelOuter = bvNone
ClientHeight = 200
ClientWidth = 280
DoubleBuffered = False
ParentDoubleBuffered = False
TabOrder = 0
object PanelGripTopLeft: TPanel
Left = 0
Height = 8
Top = 0
Width = 8
BevelOuter = bvNone
ClientHeight = 8
ClientWidth = 8
Color = clBlack
ParentColor = False
TabOrder = 0
object ShapeGripTopLeft: TShape
AnchorSideLeft.Control = PanelGripTopLeft
AnchorSideTop.Control = PanelGripTopLeft
Left = 0
Height = 8
Top = 0
Width = 8
Align = alClient
Anchors = [akTop, akLeft, akRight]
Brush.Color = clGray
Enabled = False
end
end
object PanelBarTopLeft: TPanel
AnchorSideLeft.Control = PanelGripTopLeft
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = PanelResizer
AnchorSideRight.Control = PanelGripTopCenter
Left = 8
Height = 8
Top = 0
Width = 131
Anchors = [akTop, akLeft, akRight]
BevelOuter = bvNone
Color = clNone
ParentColor = False
TabOrder = 1
OnPaint = PanelBarPaint
end
object PanelGripTopCenter: TPanel
Left = 139
Height = 8
Top = 0
Width = 8
Anchors = [akTop]
BevelOuter = bvNone
ClientHeight = 8
ClientWidth = 8
Color = clBlack
ParentColor = False
TabOrder = 2
object ShapeGripTopCenter: TShape
AnchorSideTop.Control = PanelGripTopCenter
Left = 0
Height = 8
Top = 0
Width = 8
Align = alClient
Anchors = [akTop, akLeft, akRight]
Brush.Color = clGray
Enabled = False
end
end
object PanelBarTopRight: TPanel
AnchorSideLeft.Control = PanelGripTopCenter
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = PanelResizer
AnchorSideRight.Control = PanelGripTopRight
Left = 147
Height = 8
Top = 0
Width = 125
Anchors = [akTop, akLeft, akRight]
BevelOuter = bvNone
Color = clNone
ParentColor = False
TabOrder = 3
OnPaint = PanelBarPaint
end
object PanelGripTopRight: TPanel
AnchorSideTop.Control = PanelResizer
AnchorSideRight.Control = PanelResizer
AnchorSideRight.Side = asrBottom
Left = 272
Height = 8
Top = 0
Width = 8
Anchors = [akTop, akRight]
BevelOuter = bvNone
ClientHeight = 8
ClientWidth = 8
Color = clBlack
ParentColor = False
TabOrder = 4
object ShapeGripTopRight: TShape
AnchorSideTop.Control = PanelGripTopRight
Left = 0
Height = 8
Top = 0
Width = 8
Align = alClient
Anchors = [akTop, akLeft, akRight]
Brush.Color = clGray
Enabled = False
end
end
object PanelBarRightTop: TPanel
AnchorSideTop.Control = PanelGripTopRight
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = PanelResizer
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = PanelGripRightCenter
Left = 272
Height = 91
Top = 8
Width = 8
Anchors = [akTop, akRight, akBottom]
BevelOuter = bvNone
Color = clNone
ParentColor = False
TabOrder = 5
OnPaint = PanelBarPaint
end
object PanelGripRightCenter: TPanel
AnchorSideRight.Control = PanelResizer
AnchorSideRight.Side = asrBottom
Left = 272
Height = 8
Top = 99
Width = 8
Anchors = [akRight]
BevelOuter = bvNone
ClientHeight = 8
ClientWidth = 8
Color = clBlack
ParentColor = False
TabOrder = 6
object ShapeGripRightCenter: TShape
AnchorSideTop.Control = PanelGripRightCenter
Left = 0
Height = 8
Top = 0
Width = 8
Align = alClient
Anchors = [akTop, akLeft, akRight]
Brush.Color = clBtnFace
Enabled = False
end
end
object PanelBarRightBottom: TPanel
AnchorSideTop.Control = PanelGripRightCenter
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = PanelResizer
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = PanelGripBottomRight
Left = 272
Height = 85
Top = 107
Width = 8
Anchors = [akTop, akRight, akBottom]
BevelOuter = bvNone
Color = clNone
ParentColor = False
TabOrder = 7
OnPaint = PanelBarPaint
end
object PanelGripBottomRight: TPanel
AnchorSideRight.Control = PanelResizer
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = PanelResizer
AnchorSideBottom.Side = asrBottom
Left = 272
Height = 8
Top = 192
Width = 8
Anchors = [akRight, akBottom]
BevelOuter = bvNone
ClientHeight = 8
ClientWidth = 8
Color = clBlack
ParentColor = False
TabOrder = 8
object ShapeGripBottomRight: TShape
AnchorSideTop.Control = PanelGripBottomRight
Left = 0
Height = 8
Top = 0
Width = 8
Align = alClient
Anchors = [akTop, akLeft, akRight]
Brush.Color = clBtnFace
Enabled = False
end
end
object PanelBarBottomRight: TPanel
AnchorSideLeft.Control = PanelGripBottomCenter
AnchorSideLeft.Side = asrBottom
AnchorSideRight.Control = PanelGripBottomRight
AnchorSideBottom.Control = PanelResizer
AnchorSideBottom.Side = asrBottom
Left = 147
Height = 8
Top = 192
Width = 125
Anchors = [akLeft, akRight, akBottom]
BevelOuter = bvNone
Color = clNone
ParentColor = False
TabOrder = 9
OnPaint = PanelBarPaint
end
object PanelGripBottomCenter: TPanel
AnchorSideBottom.Control = PanelResizer
AnchorSideBottom.Side = asrBottom
Left = 139
Height = 8
Top = 192
Width = 8
Anchors = [akBottom]
BevelOuter = bvNone
ClientHeight = 8
ClientWidth = 8
Color = clBlack
ParentColor = False
TabOrder = 10
object ShapeGripBottomCenter: TShape
AnchorSideTop.Control = PanelGripBottomCenter
Left = 0
Height = 8
Top = 0
Width = 8
Align = alClient
Anchors = [akTop, akLeft, akRight]
Brush.Color = clBtnFace
Enabled = False
end
end
object PanelBarBottomLeft: TPanel
AnchorSideLeft.Control = PanelGripBottomLeft
AnchorSideLeft.Side = asrBottom
AnchorSideRight.Control = PanelGripBottomCenter
AnchorSideBottom.Control = PanelResizer
AnchorSideBottom.Side = asrBottom
Left = 8
Height = 8
Top = 192
Width = 131
Anchors = [akLeft, akRight, akBottom]
BevelOuter = bvNone
Color = clNone
ParentColor = False
TabOrder = 11
OnPaint = PanelBarPaint
end
object PanelGripBottomLeft: TPanel
AnchorSideLeft.Control = PanelResizer
AnchorSideBottom.Control = PanelResizer
AnchorSideBottom.Side = asrBottom
Left = 0
Height = 8
Top = 192
Width = 8
Anchors = [akLeft, akBottom]
BevelOuter = bvNone
ClientHeight = 8
ClientWidth = 8
Color = clBlack
ParentColor = False
TabOrder = 12
object ShapeGripBottomLeft: TShape
AnchorSideLeft.Control = PanelGripBottomLeft
AnchorSideTop.Control = PanelGripBottomLeft
Left = 0
Height = 8
Top = 0
Width = 8
Align = alClient
Anchors = [akTop, akLeft, akRight]
Brush.Color = clGray
Enabled = False
end
end
object PanelBarLeftBottom: TPanel
AnchorSideLeft.Control = PanelResizer
AnchorSideTop.Control = PanelGripLeftCenter
AnchorSideTop.Side = asrBottom
AnchorSideBottom.Control = PanelGripBottomLeft
Left = 0
Height = 85
Top = 107
Width = 8
Anchors = [akTop, akLeft, akBottom]
BevelOuter = bvNone
Color = clNone
ParentColor = False
TabOrder = 13
OnPaint = PanelBarPaint
end
object PanelGripLeftCenter: TPanel
AnchorSideLeft.Control = PanelResizer
Left = 0
Height = 8
Top = 99
Width = 8
Anchors = [akLeft]
BevelOuter = bvNone
ClientHeight = 8
ClientWidth = 8
Color = clBlack
ParentColor = False
TabOrder = 14
object ShapeGripLeftCenter: TShape
AnchorSideLeft.Control = PanelGripLeftCenter
AnchorSideTop.Control = PanelGripLeftCenter
Left = 0
Height = 8
Top = 0
Width = 8
Align = alClient
Anchors = [akTop, akLeft, akRight]
Brush.Color = clGray
Enabled = False
end
end
object PanelBarLeftTop: TPanel
AnchorSideLeft.Control = PanelResizer
AnchorSideTop.Control = PanelGripTopLeft
AnchorSideTop.Side = asrBottom
AnchorSideBottom.Control = PanelGripLeftCenter
Left = 0
Height = 91
Top = 8
Width = 8
Anchors = [akTop, akLeft, akBottom]
BevelOuter = bvNone
Color = clNone
ParentColor = False
TabOrder = 15
OnPaint = PanelBarPaint
end
object PanelBackground: TPanel
AnchorSideLeft.Control = PanelGripTopLeft
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = PanelGripTopLeft
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = PanelGripBottomRight
AnchorSideBottom.Control = PanelBarBottomRight
Left = 8
Height = 184
Top = 8
Width = 264
Anchors = [akTop, akLeft, akRight, akBottom]
BevelOuter = bvNone
ClientHeight = 184
ClientWidth = 264
TabOrder = 16
object PanelFakeMenu: TPanel
AnchorSideLeft.Control = PanelBackground
AnchorSideTop.Control = PanelBackground
AnchorSideRight.Control = PanelBackground
AnchorSideRight.Side = asrBottom
Left = 0
Height = 50
Top = 0
Width = 264
Anchors = [akTop, akLeft, akRight]
BevelOuter = bvNone
TabOrder = 0
OnPaint = PanelFakeMenuPaint
end
object PanelFormClient: TPanel
AnchorSideLeft.Control = PanelBackground
AnchorSideTop.Control = PanelFakeMenu
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = PanelBackground
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = PanelBackground
AnchorSideBottom.Side = asrBottom
Left = 0
Height = 134
Top = 50
Width = 264
Anchors = [akTop, akLeft, akRight, akBottom]
BevelOuter = bvNone
ClientHeight = 134
ClientWidth = 264
Color = clBtnFace
ParentColor = False
TabOrder = 1
object PanelFormContainer: TPanel
Left = 24
Height = 33
Top = 56
Width = 113
BevelOuter = bvNone
ParentColor = False
TabOrder = 0
end
end
object PanelAnchorContainer: TPanel
AnchorSideLeft.Control = PanelBackground
AnchorSideTop.Control = PanelFakeMenu
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = PanelBackground
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = PanelBackground
AnchorSideBottom.Side = asrBottom
Left = 0
Height = 134
Top = 50
Width = 264
Anchors = [akTop, akLeft, akRight, akBottom]
BevelOuter = bvNone
ParentColor = False
TabOrder = 2
Visible = False
end
end
end
end

200
components/dockedformeditor/source/dockedresizer.pas
View File

@ -7,8 +7,8 @@
Authors: Maciej Izak
Michael W. Vogel
The Resizer is a visual control that own two ScrollBars and a window
(ResizerFrame) that shows the design form.
The Resizer is a visual control that own two ScrollBars and the ResizeControl
that shows the design form.
}
unit DockedResizer;
@ -25,7 +25,7 @@ uses
LCLType, Controls, ExtCtrls, Forms, StdCtrls, Buttons, Dialogs, LCLIntf,
LCLProc,
// DockedFormEditor
DockedResizeFrame, DockedDesignForm, DockedStrConsts;
DockedResizeControl, DockedDesignForm, DockedStrConsts;
type
@ -33,15 +33,19 @@ type
TResizer = class(TWinControl)
private
FDesignScroll: array[0..1] of Boolean;
FDesignForm: TDesignForm;
FPostponedAdjustResizeControl: Boolean;
// 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;
FPostponedAdjustPanelResizer: Boolean;
FDesignScroll: array[0..1] of Boolean;
FDesignForm: TDesignForm;
FResizeControl: TResizeControl;
FScrollBarHorz: TScrollBar;
FScrollBarVert: TScrollBar;
FScrollPos: TPoint;
procedure FormResized(Sender: TObject);
function GetFormContainer: TWinControl;
procedure ScrollBarHorzMouseWheel(Sender: TObject; {%H-}Shift: TShiftState;
@ -52,10 +56,6 @@ type
procedure SetDesignScroll(AIndex: Integer; AValue: Boolean);
procedure ScrollBarScroll(Sender: TObject; ScrollCode: TScrollCode; var ScrollPos: Integer);
public
ResizeFrame: TResizeFrame;
ScrollBarVert: TScrollBar;
ScrollBarHorz: TScrollBar;
constructor Create(TheOwner: TWinControl); reintroduce;
destructor Destroy; override;
procedure AdjustResizer(Sender: TObject);
@ -65,6 +65,7 @@ type
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 FormContainer: TWinControl read GetFormContainer;
property ResizeControl: TResizeControl read FResizeControl;
end;
implementation
@ -73,14 +74,14 @@ implementation
procedure TResizer.FormResized(Sender: TObject);
begin
DesignForm.Form.Width := ResizeFrame.NewFormSize.X;
DesignForm.Form.Height := ResizeFrame.NewFormSize.Y;
DesignForm.Form.Width := ResizeControl.NewFormSize.X;
DesignForm.Form.Height := ResizeControl.NewFormSize.Y;
SetTimer(DesignForm.Form.Handle, WM_BOUNDTODESIGNTABSHEET, 10, nil);
end;
function TResizer.GetFormContainer: TWinControl;
begin
Result := ResizeFrame.PanelFormContainer;
Result := ResizeControl.FormContainer;
end;
procedure TResizer.ScrollBarHorzMouseWheel(Sender: TObject; Shift: TShiftState;
@ -88,9 +89,9 @@ procedure TResizer.ScrollBarHorzMouseWheel(Sender: TObject; Shift: TShiftState;
var
LScrollPos: Integer;
begin
LScrollPos := ResizeFrame.HorzScrollPos - WheelDelta;
ScrollBarHorz.Position := LScrollPos;
ScrollBarScroll(ScrollBarHorz, scEndScroll, LScrollPos);
LScrollPos := FScrollPos.x - WheelDelta;
FScrollBarHorz.Position := LScrollPos;
ScrollBarScroll(FScrollBarHorz, scEndScroll, LScrollPos);
Handled := True;
end;
@ -99,9 +100,9 @@ procedure TResizer.ScrollBarVertMouseWheel(Sender: TObject; Shift: TShiftState;
var
LScrollPos: Integer;
begin
LScrollPos := ResizeFrame.VertScrollPos - WheelDelta;
ScrollBarVert.Position := LScrollPos;
ScrollBarScroll(ScrollBarVert, scEndScroll, LScrollPos);
LScrollPos := FScrollPos.y - WheelDelta;
FScrollBarVert.Position := LScrollPos;
ScrollBarScroll(FScrollBarVert, scEndScroll, LScrollPos);
Handled := True;
end;
@ -117,13 +118,13 @@ begin
if Assigned(FDesignForm) then
begin
FDesignForm.BeginUpdate;
FDesignForm.Form.Parent := ResizeFrame.PanelFormContainer;
FDesignForm.Form.Parent := ResizeControl.FormContainer;
FDesignForm.EndUpdate;
FDesignForm.OnChangeHackedBounds := @AdjustResizer;
if Assigned(FDesignForm.AnchorDesigner) then
FDesignForm.AnchorDesigner.Parent := ResizeFrame.PanelAnchorContainer;
FDesignForm.AnchorDesigner.Parent := ResizeControl.AnchorContainer;
end;
ResizeFrame.DesignForm := AValue;
ResizeControl.DesignForm := AValue;
end;
procedure TResizer.SetDesignScroll(AIndex: Integer; AValue: Boolean);
@ -138,8 +139,8 @@ begin
if FDesignScroll[AIndex] = AValue then Exit;
FDesignScroll[AIndex] := AValue;
case AIndex of
SB_Horz: PerformScroll(ScrollBarHorz);
SB_Vert: PerformScroll(ScrollBarVert);
SB_Horz: PerformScroll(FScrollBarHorz);
SB_Vert: PerformScroll(FScrollBarVert);
else
raise EArgumentOutOfRangeException.CreateRes(@SArgumentOutOfRange);
end;
@ -154,41 +155,41 @@ begin
scLineUp: ScrollPos := ScrollPos - 50;
scPageDown:
begin
if Sender = ScrollBarHorz then ScrollPos := ScrollPos + ResizeFrame.Width;
if Sender = ScrollBarVert then ScrollPos := ScrollPos + ResizeFrame.Height;
if Sender = FScrollBarHorz then ScrollPos := ScrollPos + ResizeControl.Width;
if Sender = FScrollBarVert then ScrollPos := ScrollPos + ResizeControl.Height;
end;
scPageUp:
begin
if Sender = ScrollBarHorz then ScrollPos := ScrollPos - ResizeFrame.Width;
if Sender = ScrollBarVert then ScrollPos := ScrollPos - ResizeFrame.Height;
if Sender = FScrollBarHorz then ScrollPos := ScrollPos - ResizeControl.Width;
if Sender = FScrollBarVert then ScrollPos := ScrollPos - ResizeControl.Height;
end;
end;
DesignForm.BeginUpdate;
if Sender = ScrollBarVert then
if Sender = FScrollBarVert then
begin
// Warning - don't overflow the range! (go to description for FRealMaxV)
ScrollPos := Min(ScrollPos, FRealMaxV);
ScrollPos := Max(ScrollPos, 0);
ResizeFrame.VertScrollPos := ScrollPos;
FScrollPos.y := ScrollPos;
// scroll for form
LScrollPos := Max(ScrollPos - ResizeFrame.SizerGripSize, 0);
LScrollPos := Max(ScrollPos - ResizeControl.SizerGripSize, 0);
DesignForm.VertScrollPosition := LScrollPos;
end;
if Sender = ScrollBarHorz then
if Sender = FScrollBarHorz then
begin
ScrollPos := Min(ScrollPos, FRealMaxH);
ScrollPos := Max(ScrollPos, 0);
ResizeFrame.HorzScrollPos := ScrollPos;
FScrollPos.x := ScrollPos;
// scroll for form
LScrollPos := Max(ScrollPos - ResizeFrame.SizerGripSize, 0);
LScrollPos := Max(ScrollPos - ResizeControl.SizerGripSize, 0);
DesignForm.HorzScrollPosition := LScrollPos;
end;
DesignForm.EndUpdate;
if not FPostponedAdjustPanelResizer then
if not FPostponedAdjustResizeControl then
begin
ResizeFrame.AdjustPanelResizer;
ResizeFrame.DesignerSetFocus;
ResizeControl.AdjustBounds(FScrollPos);
ResizeControl.DesignerSetFocus;
end;
DesignForm.Form.Invalidate;
end;
@ -198,53 +199,54 @@ begin
inherited Create(TheOwner);
Align := alClient;
FPostponedAdjustPanelResizer := False;
FPostponedAdjustResizeControl := False;
FScrollPos := Point(0, 0);
ScrollBarVert := TScrollBar.Create(nil);
ScrollBarVert.Kind := sbVertical;
ScrollBarVert.Parent := Self;
ScrollBarVert.AnchorSideTop.Control := Self;
ScrollBarVert.AnchorSideRight.Control := Self;
ScrollBarVert.AnchorSideRight.Side := asrRight;
ScrollBarVert.AnchorSideBottom.Side := asrBottom;
ScrollBarVert.Anchors := [akTop, akRight, akBottom];
ScrollBarVert.Visible := False;
ScrollBarVert.OnScroll := @ScrollBarScroll;
ScrollBarVert.AddHandlerOnMouseWheel(@ScrollBarVertMouseWheel);
FScrollBarVert := TScrollBar.Create(nil);
FScrollBarVert.Kind := sbVertical;
FScrollBarVert.Parent := Self;
FScrollBarVert.AnchorSideTop.Control := Self;
FScrollBarVert.AnchorSideRight.Control := Self;
FScrollBarVert.AnchorSideRight.Side := asrRight;
FScrollBarVert.AnchorSideBottom.Side := asrBottom;
FScrollBarVert.Anchors := [akTop, akRight, akBottom];
FScrollBarVert.Visible := False;
FScrollBarVert.OnScroll := @ScrollBarScroll;
FScrollBarVert.AddHandlerOnMouseWheel(@ScrollBarVertMouseWheel);
ScrollBarHorz := TScrollBar.Create(nil);
ScrollBarHorz.Parent := Self;
ScrollBarHorz.AnchorSideLeft.Control := Self;
ScrollBarHorz.AnchorSideRight.Side := asrRight;
ScrollBarHorz.AnchorSideBottom.Control := Self;
ScrollBarHorz.AnchorSideBottom.Side := asrBottom;
ScrollBarHorz.Anchors := [akLeft, akRight, akBottom];
ScrollBarHorz.Visible := False;
ScrollBarHorz.OnScroll := @ScrollBarScroll;
ScrollBarHorz.AddHandlerOnMouseWheel(@ScrollBarHorzMouseWheel);
FScrollBarHorz := TScrollBar.Create(nil);
FScrollBarHorz.Parent := Self;
FScrollBarHorz.AnchorSideLeft.Control := Self;
FScrollBarHorz.AnchorSideRight.Side := asrRight;
FScrollBarHorz.AnchorSideBottom.Control := Self;
FScrollBarHorz.AnchorSideBottom.Side := asrBottom;
FScrollBarHorz.Anchors := [akLeft, akRight, akBottom];
FScrollBarHorz.Visible := False;
FScrollBarHorz.OnScroll := @ScrollBarScroll;
FScrollBarHorz.AddHandlerOnMouseWheel(@ScrollBarHorzMouseWheel);
ResizeFrame := TResizeFrame.Create(nil);
ResizeFrame.Name := '';
ResizeFrame.Parent := Self;
ResizeFrame.AnchorSideLeft.Control := Self;
ResizeFrame.AnchorSideTop.Control := Self;
ResizeFrame.AnchorSideRight.Control := ScrollBarVert;
ResizeFrame.AnchorSideBottom.Control := ScrollBarHorz;
ResizeFrame.Anchors := [akTop, akLeft, akRight, akBottom];
FResizeControl := TResizeControl.Create(nil);
FResizeControl.Name := '';
FResizeControl.Parent := Self;
FResizeControl.AnchorSideLeft.Control := Self;
FResizeControl.AnchorSideTop.Control := Self;
FResizeControl.AnchorSideRight.Control := FScrollBarVert;
FResizeControl.AnchorSideBottom.Control := FScrollBarHorz;
FResizeControl.Anchors := [akTop, akLeft, akRight, akBottom];
ScrollBarVert.AnchorSideBottom.Control := ResizeFrame;
ScrollBarHorz.AnchorSideRight.Control := ResizeFrame;
FScrollBarVert.AnchorSideBottom.Control := ResizeControl;
FScrollBarHorz.AnchorSideRight.Control := ResizeControl;
ResizeFrame.OnResized := @FormResized;
ResizeFrame.OnChangeBounds := @AdjustResizer;
FResizeControl.OnResized := @FormResized;
FResizeControl.OnChangeBounds := @AdjustResizer;
end;
destructor TResizer.Destroy;
begin
Pointer(FDesignForm) := nil;
FreeAndNil(ResizeFrame);
FreeAndNil(ScrollBarVert);
FreeAndNil(ScrollBarHorz);
FreeAndNil(FResizeControl);
FreeAndNil(FScrollBarVert);
FreeAndNil(FScrollBarHorz);
inherited Destroy;
end;
@ -254,58 +256,58 @@ var
LScrollPos: Integer;
begin
if not Assigned(FDesignForm) then Exit;
LWidth := FDesignForm.Width + 2 * ResizeFrame.SizerGripSize;
LHeight := FDesignForm.Height + 2 * ResizeFrame.SizerGripSize;
LWidth := FDesignForm.Width + 2 * ResizeControl.SizerGripSize;
LHeight := FDesignForm.Height + 2 * ResizeControl.SizerGripSize;
{$IFDEF DEBUGDOCKEDFORMEDITOR} DebugLn('TResizer.AdjustResizer Resizer Width:', DbgS(LWidth), ' Height:', DbgS(LHeight)); {$ENDIF}
FPostponedAdjustPanelResizer := True;
if ResizeFrame.Width < LWidth then
FPostponedAdjustResizeControl := True;
if ResizeControl.Width < LWidth then
begin
// if designer frame is smaller as scrollbar, show scrollbar
DesignScrollBottom := True;
ScrollBarHorz.Max := LWidth;
FRealMaxH := LWidth - ResizeFrame.Width;
ScrollBarHorz.PageSize := ResizeFrame.Width;
if ResizeFrame.HorzScrollPos > FRealMaxH then
FScrollBarHorz.Max := LWidth;
FRealMaxH := LWidth - ResizeControl.Width;
FScrollBarHorz.PageSize := ResizeControl.Width;
if FScrollPos.x > FRealMaxH then
begin
ResizeFrame.HorzScrollPos := FRealMaxH;
LScrollPos := ResizeFrame.HorzScrollPos;
ScrollBarScroll(ScrollBarHorz, scEndScroll, LScrollPos);
FScrollPos.x := FRealMaxH;
LScrollPos := FScrollPos.x;
ScrollBarScroll(FScrollBarHorz, scEndScroll, LScrollPos);
end;
end else begin
// invisible ScrollBar
DesignScrollBottom := False;
LScrollPos := 0;
ScrollBarScroll(ScrollBarHorz, scEndScroll, LScrollPos);
ScrollBarScroll(FScrollBarHorz, scEndScroll, LScrollPos);
end;
if ResizeFrame.Height < LHeight then
if ResizeControl.Height < LHeight then
begin
// if designer frame is higher as scrollbar, show scrollbar
DesignScrollRight := True;
ScrollBarVert.Max := LHeight;
FRealMaxV := LHeight - ResizeFrame.Height;
ScrollBarVert.PageSize := ResizeFrame.Height;
if ResizeFrame.VertScrollPos > FRealMaxV then
FScrollBarVert.Max := LHeight;
FRealMaxV := LHeight - ResizeControl.Height;
FScrollBarVert.PageSize := ResizeControl.Height;
if FScrollPos.y > FRealMaxV then
begin
ResizeFrame.VertScrollPos := FRealMaxV;
LScrollPos := ResizeFrame.VertScrollPos;
ScrollBarScroll(ScrollBarVert, scEndScroll, LScrollPos);
FScrollPos.y := FRealMaxV;
LScrollPos := FScrollPos.y;
ScrollBarScroll(FScrollBarVert, scEndScroll, LScrollPos);
end;
end else begin
DesignScrollRight := False;
LScrollPos := 0;
ScrollBarScroll(ScrollBarVert, scEndScroll, LScrollPos);
ScrollBarScroll(FScrollBarVert, scEndScroll, LScrollPos);
end;
FPostponedAdjustPanelResizer := False;
FPostponedAdjustResizeControl := False;
ResizeFrame.AdjustPanelResizer;
ResizeFrame.ClientChangeBounds(nil);
ResizeControl.AdjustBounds(FScrollPos);
ResizeControl.ClientChangeBounds(nil);
end;
procedure TResizer.DesignerSetFocus;
begin
ResizeFrame.DesignerSetFocus;
ResizeControl.DesignerSetFocus;
if Assigned(FDesignForm) and Assigned(FDesignForm.AnchorDesigner) then
FDesignForm.AnchorDesigner.OnMouseWheel := @ScrollBarVertMouseWheel;
end;