mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-20 13:39:21 +02:00
sparta: don't use fake design instances for TForm, TDataModule and TFrame. A little clean-up is needed but functionality should be ok. Fix for issues #29615, #29582, #30525, #31127, #31414, #31620
git-svn-id: trunk@55524 -
This commit is contained in:
hnb
parent
8e31460dbb
commit
dce9f97030
@ -27,7 +27,7 @@ uses
|
||||
type
|
||||
{ TDesignedFormImpl }
|
||||
|
||||
TDesignedFormImpl = class(TFormImpl, IDesignedRealFormHelper, IDesignedForm, IDesignedFormIDE)
|
||||
TDesignedFormImpl = class(TFormImpl, IDesignedRealForm, IDesignedRealFormHelper, IDesignedForm, IDesignedFormIDE)
|
||||
private
|
||||
FLastActiveSourceWindow: TSourceEditorWindowInterface;
|
||||
protected
|
||||
@ -181,7 +181,7 @@ var
|
||||
LMediator: TDesignerMediator;
|
||||
LLookupRoot: TComponent;
|
||||
begin
|
||||
LLookupRoot := (FOwner as TNonFormProxyDesignerForm).LookupRoot;
|
||||
LLookupRoot := (FForm as TNonFormProxyDesignerForm).LookupRoot;
|
||||
if LLookupRoot is TDataModule then
|
||||
with TDataModule(LLookupRoot) do
|
||||
case AIndex of
|
||||
@ -192,7 +192,7 @@ begin
|
||||
end
|
||||
else
|
||||
begin
|
||||
LMediator := (FOwner as TNonControlProxyDesignerForm).Mediator;
|
||||
LMediator := (FForm as TNonControlProxyDesignerForm).Mediator;
|
||||
if (LLookupRoot <> nil) and (LMediator <> nil) then
|
||||
begin
|
||||
LMediator.GetFormBounds(LLookupRoot, LBounds, LClientRect);
|
||||
@ -217,7 +217,7 @@ var
|
||||
LMediator: TDesignerMediator;
|
||||
LLookupRoot: TComponent;
|
||||
begin
|
||||
LLookupRoot := (FOwner as TNonFormProxyDesignerForm).LookupRoot;
|
||||
LLookupRoot := (FForm as TNonFormProxyDesignerForm).LookupRoot;
|
||||
if LLookupRoot is TDataModule then
|
||||
with TDataModule(LLookupRoot) do
|
||||
case AIndex of
|
||||
@ -228,7 +228,7 @@ begin
|
||||
end
|
||||
else
|
||||
begin
|
||||
LMediator := (FOwner as TNonControlProxyDesignerForm).Mediator;
|
||||
LMediator := (FForm as TNonControlProxyDesignerForm).Mediator;
|
||||
if (LLookupRoot <> nil) and (LMediator <> nil) then
|
||||
begin
|
||||
LMediator.GetFormBounds(LLookupRoot, LBounds, LClientRect);
|
||||
@ -254,8 +254,8 @@ end;
|
||||
|
||||
function TDesignedFrameFormImpl.GetPublishedBounds(AIndex: Integer): Integer;
|
||||
begin
|
||||
if (FOwner as TNonFormProxyDesignerForm).LookupRoot <> nil then
|
||||
with (TNonFormProxyDesignerForm(FOwner).LookupRoot as TFrame) do
|
||||
if (FForm as TNonFormProxyDesignerForm).LookupRoot <> nil then
|
||||
with (TNonFormProxyDesignerForm(FForm).LookupRoot as TFrame) do
|
||||
case AIndex of
|
||||
0: Result := Left;
|
||||
1: Result := Top;
|
||||
@ -269,8 +269,8 @@ end;
|
||||
procedure TDesignedFrameFormImpl.SetPublishedBounds(AIndex: Integer;
|
||||
AValue: Integer);
|
||||
begin
|
||||
if (FOwner as TNonFormProxyDesignerForm).LookupRoot <> nil then
|
||||
with (TNonFormProxyDesignerForm(FOwner).LookupRoot as TControl) do
|
||||
if (FForm as TNonFormProxyDesignerForm).LookupRoot <> nil then
|
||||
with (TNonFormProxyDesignerForm(FForm).LookupRoot as TControl) do
|
||||
case AIndex of
|
||||
0: Left := AValue;
|
||||
1: Top := AValue;
|
||||
@ -287,7 +287,7 @@ end;
|
||||
function TFakeCustomFrame.GetDesignedForm: TDesignedFormImpl;
|
||||
begin
|
||||
if not Assigned(FDesignedForm) then
|
||||
FDesignedForm := TDesignedFrameFormImpl.Create(Self);
|
||||
FDesignedForm := TDesignedFrameFormImpl.Create(Self,Self);
|
||||
|
||||
Result := FDesignedForm;
|
||||
end;
|
||||
@ -314,7 +314,16 @@ end;
|
||||
|
||||
procedure TFakeCustomFrame.SetPublishedBounds(AIndex: Integer; AValue: Integer);
|
||||
begin
|
||||
DesignedForm.SetPublishedBounds(AIndex, AValue);
|
||||
//DesignedForm.SetPublishedBounds(AIndex, AValue);
|
||||
|
||||
if LookupRoot <> nil then
|
||||
with LookupRoot as TControl do
|
||||
case AIndex of
|
||||
0: Left := AValue;
|
||||
1: Top := AValue;
|
||||
2: Width := AValue;
|
||||
3: Height := AValue;
|
||||
end;
|
||||
end;
|
||||
|
||||
constructor TFakeCustomFrame.Create(AOwner: TComponent;
|
||||
@ -417,7 +426,7 @@ end;
|
||||
function TFakeCustomNonControl.GetDesignedForm: TDesignedFormImpl;
|
||||
begin
|
||||
if not Assigned(FDesignedForm) then
|
||||
FDesignedForm := TDesignedNonControlFormImpl.Create(Self);
|
||||
FDesignedForm := TDesignedNonControlFormImpl.Create(Self,Self);
|
||||
|
||||
Result := FDesignedForm;
|
||||
end;
|
||||
@ -582,7 +591,7 @@ end;
|
||||
function TFakeCustomForm.GetDesignedForm: TDesignedFormImpl;
|
||||
begin
|
||||
if not Assigned(FDesignedForm) then
|
||||
FDesignedForm := TDesignedFormImpl.Create(Self);
|
||||
FDesignedForm := TDesignedFormImpl.Create(Self,Self);
|
||||
|
||||
Result := FDesignedForm;
|
||||
end;
|
||||
@ -713,7 +722,7 @@ end;
|
||||
|
||||
procedure TDesignedFormImpl.BeginUpdate;
|
||||
begin
|
||||
TFormAccess(FOwner).SetDesigning(False, False);
|
||||
TFormAccess(FForm).SetDesigning(False, False);
|
||||
inherited BeginUpdate;
|
||||
end;
|
||||
|
||||
@ -721,10 +730,10 @@ procedure TDesignedFormImpl.EndUpdate(AModified: Boolean);
|
||||
var
|
||||
OI: TObjectInspectorDlg;
|
||||
begin
|
||||
TFormAccess(FOwner).SetDesigning(True, False);
|
||||
TFormAccess(FForm).SetDesigning(True, False);
|
||||
inherited EndUpdate(AModified);
|
||||
if AModified and (FormEditingHook <> nil)
|
||||
and (FormEditingHook.GetCurrentDesigner = FOwner.Designer) then
|
||||
and (FormEditingHook.GetCurrentDesigner = FForm.Designer) then
|
||||
begin
|
||||
OI := FormEditingHook.GetCurrentObjectInspector;
|
||||
if Assigned(OI) then
|
||||
|
||||
@ -25,7 +25,8 @@ uses
|
||||
{$ELSE}
|
||||
ghashmap, sparta_HashUtils, gvector,
|
||||
{$ENDIF}
|
||||
TypInfo, LCLIntf, LCLType, LMessages, sparta_FakeForm, sparta_FakeFrame, SpartaAPI, sparta_strconsts;
|
||||
TypInfo, LCLIntf, LCLType, LMessages, sparta_FakeForm, sparta_FakeFrame,
|
||||
SpartaAPI, sparta_strconsts, sparta_FakeCustom;
|
||||
|
||||
const
|
||||
WM_SETNOFRAME = WM_USER;
|
||||
@ -52,6 +53,7 @@ type
|
||||
|
||||
procedure SetPopupParent(AVal: TSourceEditorWindowInterface);
|
||||
procedure DoAddForm;
|
||||
procedure FormChangeBounds(Sender: TObject);
|
||||
public
|
||||
{$IFDEF USE_GENERICS_COLLECTIONS}
|
||||
class var AddFormEvents: TList<TNotifyEvent>;
|
||||
@ -120,6 +122,7 @@ type
|
||||
constructor Create(AForm: TSourceEditorWindowInterface);
|
||||
destructor Destroy; override;
|
||||
property ActiveDesignFormData: TDesignFormData read FActiveDesignFormData write SetActiveDesignFormData;
|
||||
procedure BoundToDesignTabSheet;
|
||||
end;
|
||||
|
||||
{ TDTXTabMaster }
|
||||
@ -472,7 +475,7 @@ begin
|
||||
// during docking, form position was in wrong place... we need to delay changing position :)
|
||||
if TheMessage.msg = WM_BoundToDesignTabSheet then
|
||||
if Form.LastActiveSourceWindow <> nil then
|
||||
SourceEditorWindows[Form.LastActiveSourceWindow].OnChangeBounds(nil);
|
||||
SourceEditorWindows[Form.LastActiveSourceWindow].BoundToDesignTabSheet;
|
||||
|
||||
// we need to correct ActiveEditor to right form
|
||||
// this code works correctly on Windows platform
|
||||
@ -554,9 +557,17 @@ begin
|
||||
|
||||
end;
|
||||
|
||||
procedure TDesignFormData.FormChangeBounds(Sender: TObject);
|
||||
begin
|
||||
if not FForm.Update then
|
||||
PostMessage(FForm.Form.Handle, WM_BoundToDesignTabSheet, 0, 0);
|
||||
end;
|
||||
|
||||
constructor TDesignFormData.Create(AForm: TCustomForm);
|
||||
begin
|
||||
FForm := AForm as IDesignedFormIDE;
|
||||
FForm := TDesignedFormImpl.Create(Self, AForm);
|
||||
|
||||
AForm.AddHandlerOnChangeBounds(FormChangeBounds);
|
||||
|
||||
FLastScreenshot := TBitmap.Create;
|
||||
FWndMethod := FForm.Form.WindowProc;
|
||||
@ -670,14 +681,14 @@ begin
|
||||
if (AValue <> nil) then
|
||||
begin
|
||||
with AValue as IDesignedForm do
|
||||
if not AValue.FHiding and (RealBorderStyle <> bsNone) then
|
||||
{if not AValue.FHiding and (RealBorderStyle <> bsNone) then
|
||||
begin
|
||||
BeginUpdate;
|
||||
//BeginUpdate;
|
||||
//RealBorderIcons := [];
|
||||
//RealBorderStyle := bsNone;
|
||||
Form.Show;
|
||||
EndUpdate;
|
||||
end;
|
||||
//Form.Show;
|
||||
//EndUpdate;
|
||||
end;}
|
||||
// important when we want back to tab where was oppened form :<
|
||||
LazarusIDE.DoShowDesignerFormOfSrc(FForm.ActiveEditor);
|
||||
end;
|
||||
@ -715,13 +726,22 @@ begin
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TSourceEditorWindowData.OnChangeBounds(Sender: TObject);
|
||||
procedure TSourceEditorWindowData.BoundToDesignTabSheet;
|
||||
var
|
||||
LPageCtrl: TModulePageControl;
|
||||
begin
|
||||
LPageCtrl := FindModulePageControl(FForm);
|
||||
if LPageCtrl <> nil then
|
||||
//LPageCtrl.BoundToDesignTabSheet;
|
||||
LPageCtrl.BoundToDesignTabSheet;
|
||||
end;
|
||||
|
||||
procedure TSourceEditorWindowData.OnChangeBounds(Sender: TObject);
|
||||
//var
|
||||
// LPageCtrl: TModulePageControl;
|
||||
begin
|
||||
// LPageCtrl := FindModulePageControl(FForm);
|
||||
// if LPageCtrl <> nil then
|
||||
// LPageCtrl.BoundToDesignTabSheet;
|
||||
end;
|
||||
|
||||
procedure TSourceEditorWindowData.AddPageCtrl(ASrcEditor: TSourceEditorInterface; APage: TModulePageControl);
|
||||
@ -1205,13 +1225,13 @@ begin
|
||||
|
||||
// for lfm edition...
|
||||
with LDesignFormData as IDesignedForm do
|
||||
if not LDesignFormData.FHiding and (RealBorderStyle <> bsNone) then
|
||||
if not LDesignFormData.FHiding {and (RealBorderStyle <> bsNone)} then
|
||||
begin
|
||||
BeginUpdate;
|
||||
//BeginUpdate;
|
||||
//RealBorderIcons := [];
|
||||
//RealBorderStyle := bsNone;
|
||||
Form.Show;
|
||||
EndUpdate;
|
||||
//Form.Show;
|
||||
//EndUpdate;
|
||||
LPageCtrl.BoundToDesignTabSheet;
|
||||
|
||||
PostMessage(Form.Handle, WM_BoundToDesignTabSheet, 0, 0);
|
||||
@ -1484,7 +1504,7 @@ begin
|
||||
//PostMessage(LWindow.Handle, WM_BoundToDesignTabSheet, 0, 0);
|
||||
if LDesignForm <> nil then
|
||||
begin
|
||||
LDesignForm.Form.Form.Parent := FindModulePageControl(LWindow).Resizer.ActiveResizeFrame.ClientPanel;
|
||||
LDesignForm.Form.Form.Parent := FindModulePageControl(LWindow).Resizer.ActiveResizeFrame.FormHandler;
|
||||
PostMessage(LDesignForm.Form.Form.Handle, WM_BoundToDesignTabSheet, 0, 0);
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -28,11 +28,11 @@ implementation
|
||||
|
||||
procedure Register;
|
||||
begin
|
||||
FormEditingHook.StandardDesignerBaseClasses[DesignerBaseClassId_TForm] := TFakeForm;
|
||||
FormEditingHook.StandardDesignerBaseClasses[DesignerBaseClassId_TFrame] := THookFrame;
|
||||
//FormEditingHook.StandardDesignerBaseClasses[DesignerBaseClassId_TForm] := TFakeForm;
|
||||
//FormEditingHook.StandardDesignerBaseClasses[DesignerBaseClassId_TFrame] := THookFrame;
|
||||
|
||||
FormEditingHook.NonFormProxyDesignerForm[NonControlProxyDesignerFormId] := TFakeNonControl;
|
||||
FormEditingHook.NonFormProxyDesignerForm[FrameProxyDesignerFormId] := TFakeFrame;
|
||||
//FormEditingHook.NonFormProxyDesignerForm[NonControlProxyDesignerFormId] := TFakeNonControl;
|
||||
//FormEditingHook.NonFormProxyDesignerForm[FrameProxyDesignerFormId] := TFakeFrame;
|
||||
|
||||
Screen.AddHandlerFormAdded(TSpartaMainIDE.Screen_FormAdded);
|
||||
Screen.AddHandlerRemoveForm(TSpartaMainIDE.Screen_FormDel);
|
||||
|
||||
@ -210,7 +210,7 @@ var
|
||||
LForm: IDesignedForm;
|
||||
LFrame: IResizeFrame;
|
||||
|
||||
procedure Positioning;
|
||||
(*procedure Positioning;
|
||||
var
|
||||
LHiddenHeight, LNewHeight: Integer;
|
||||
LHiddenWidth, LNewWidth: Integer;
|
||||
@ -225,7 +225,7 @@ var
|
||||
|
||||
// TODO - better handling of min width - same in TDesignedFormImpl.SetPublishedBounds (sparta_FakeCustom.pas)
|
||||
|
||||
LNewWidth := LFrame.ClientPanel.Width + LHiddenWidth;
|
||||
LNewWidth := LFrame.NewSize.X + LHiddenWidth;
|
||||
LForm.Width := LNewWidth;
|
||||
LForm.RealWidth := LNewWidth;
|
||||
|
||||
@ -244,7 +244,7 @@ var
|
||||
if LHiddenHeight > LFrame.DesignedHeightToScroll then
|
||||
LHiddenHeight := LFrame.DesignedHeightToScroll;
|
||||
|
||||
LNewHeight := LFrame.ClientPanel.Height + LHiddenHeight;
|
||||
LNewHeight := LFrame.NewSize.Y+ LHiddenHeight;
|
||||
LForm.Height := LNewHeight;
|
||||
LForm.RealHeight := LNewHeight;
|
||||
|
||||
@ -258,11 +258,27 @@ var
|
||||
end;
|
||||
|
||||
LForm.EndUpdate;
|
||||
end;
|
||||
end;*)
|
||||
|
||||
procedure PositioningEnd;
|
||||
var
|
||||
LHiddenHeight, LNewHeight: Integer;
|
||||
LHiddenWidth, LNewWidth: Integer;
|
||||
begin
|
||||
TryBoundSizerToDesignedForm(nil);
|
||||
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
|
||||
@ -271,7 +287,7 @@ begin
|
||||
|
||||
case PositioningCode of
|
||||
pcPositioningEnd: PositioningEnd;
|
||||
pcPositioning: Positioning;
|
||||
//pcPositioning: Positioning;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
@ -9,6 +9,9 @@ uses
|
||||
LCLType, sparta_FormBackgroundForMDI;
|
||||
|
||||
type
|
||||
|
||||
{ TFormImpl }
|
||||
|
||||
TFormImpl = class(TComponent, IDesignedRealFormHelper, IDesignedForm)
|
||||
private
|
||||
FDesignedRealForm: IDesignedRealForm;
|
||||
@ -24,7 +27,7 @@ type
|
||||
function GetOnChangeHackedBounds: TNotifyEvent;
|
||||
function PositionDelta: TPoint;
|
||||
protected
|
||||
FOwner: TCustomForm;
|
||||
FForm: TCustomForm;
|
||||
FUpdate: boolean;
|
||||
protected
|
||||
function GetRealBounds(AIndex: Integer): Integer; virtual;
|
||||
@ -66,7 +69,7 @@ type
|
||||
property RealBorderIcons: TBorderIcons read GetRealBorderIcons write SetRealBorderIcons;
|
||||
property RealFormStyle: TFormStyle read GetRealFormStyle write SetRealFormStyle;
|
||||
|
||||
constructor Create(AOwner: TCustomForm); virtual;
|
||||
constructor Create(AOwner: TComponent; AForm: TCustomForm); virtual; reintroduce;
|
||||
destructor Destroy; override;
|
||||
|
||||
procedure BeginUpdate; virtual;
|
||||
@ -141,11 +144,17 @@ type
|
||||
function TFormImpl.GetPublishedBounds(AIndex: Integer): Integer;
|
||||
begin
|
||||
case AIndex of
|
||||
0: Result := FHackLeft;
|
||||
1: Result := FHackTop;
|
||||
2: Result := FHackWidth;
|
||||
3: Result := FHackHeight;
|
||||
0: Result := FForm.Left;
|
||||
1: Result := FForm.Top;
|
||||
2: Result := FForm.Width;
|
||||
3: Result := FForm.Height;
|
||||
end;
|
||||
//case AIndex of
|
||||
// 0: Result := FHackLeft;
|
||||
// 1: Result := FHackTop;
|
||||
// 2: Result := FHackWidth;
|
||||
// 3: Result := FHackHeight;
|
||||
//end;
|
||||
end;
|
||||
|
||||
procedure TFormImpl.SetPublishedBounds(AIndex: Integer; AValue: Integer);
|
||||
@ -177,7 +186,15 @@ end;
|
||||
|
||||
function TFormImpl.GetRealBounds(AIndex: Integer): Integer;
|
||||
begin
|
||||
Result := FDesignedRealForm.GetRealBounds(AIndex);
|
||||
case AIndex of
|
||||
0: Result := FForm.Left;
|
||||
1: Result := FForm.Top;
|
||||
2: Result := FForm.Width;
|
||||
3: Result := FForm.Height;
|
||||
end;
|
||||
|
||||
//FForm.;
|
||||
//Result := 0;// FDesignedRealForm.GetRealBounds(AIndex);
|
||||
end;
|
||||
|
||||
procedure TFormImpl.SetRealBounds(AIndex: Integer; AValue: Integer);
|
||||
@ -206,67 +223,67 @@ procedure TFormImpl.SetRealBounds(AIndex: Integer; AValue: Integer);
|
||||
end;
|
||||
|
||||
begin
|
||||
FDesignedRealForm.SetRealBounds(AIndex, AValue);
|
||||
{FDesignedRealForm.SetRealBounds(AIndex, AValue);
|
||||
|
||||
if AIndex = 2 then
|
||||
AdjustSize;
|
||||
AdjustSize;}
|
||||
end;
|
||||
|
||||
procedure TFormImpl.SetRealBorderStyle(AVal: TFormBorderStyle);
|
||||
begin
|
||||
FDesignedRealForm.SetRealBorderStyle(AVal);
|
||||
//FDesignedRealForm.SetRealBorderStyle(AVal);
|
||||
end;
|
||||
|
||||
procedure TFormImpl.SetRealBorderIcons(AVal: TBorderIcons);
|
||||
begin
|
||||
FDesignedRealForm.SetRealBorderIcons(AVal);
|
||||
//FDesignedRealForm.SetRealBorderIcons(AVal);
|
||||
end;
|
||||
|
||||
procedure TFormImpl.SetRealFormStyle(AVal: TFormStyle);
|
||||
begin
|
||||
FDesignedRealForm.SetRealFormStyle(AVal);
|
||||
//FDesignedRealForm.SetRealFormStyle(AVal);
|
||||
end;
|
||||
|
||||
procedure TFormImpl.SetRealPopupMode(AVal: TPopupMode);
|
||||
begin
|
||||
FDesignedRealForm.SetRealPopupMode(AVal);
|
||||
//FDesignedRealForm.SetRealPopupMode(AVal);
|
||||
end;
|
||||
|
||||
procedure TFormImpl.SetRealPopupParent(AVal: TCustomForm);
|
||||
begin
|
||||
FDesignedRealForm.SetRealPopupParent(AVal);
|
||||
//FDesignedRealForm.SetRealPopupParent(AVal);
|
||||
end;
|
||||
|
||||
function TFormImpl.GetRealBorderStyle: TFormBorderStyle;
|
||||
begin
|
||||
Result := FDesignedRealForm.GetRealBorderStyle;
|
||||
Result := bsNone;//FDesignedRealForm.GetRealBorderStyle;
|
||||
end;
|
||||
|
||||
function TFormImpl.GetRealBorderIcons: TBorderIcons;
|
||||
begin
|
||||
Result := FDesignedRealForm.GetRealBorderIcons;
|
||||
Result := [];//FDesignedRealForm.GetRealBorderIcons;
|
||||
end;
|
||||
|
||||
function TFormImpl.GetRealFormStyle: TFormStyle;
|
||||
begin
|
||||
Result := FDesignedRealForm.GetRealFormStyle;
|
||||
Result := fsNormal;//FDesignedRealForm.GetRealFormStyle;
|
||||
end;
|
||||
|
||||
function TFormImpl.GetRealPopupMode: TPopupMode;
|
||||
begin
|
||||
Result := FDesignedRealForm.GetRealPopupMode;
|
||||
Result := pmNone//FDesignedRealForm.GetRealPopupMode;
|
||||
end;
|
||||
|
||||
function TFormImpl.GetRealPopupParent: TCustomForm;
|
||||
begin
|
||||
Result := FDesignedRealForm.GetRealPopupParent;
|
||||
Result := nil//FDesignedRealForm.GetRealPopupParent;
|
||||
end;
|
||||
|
||||
//////
|
||||
|
||||
function TFormImpl.GetForm: TCustomForm;
|
||||
begin
|
||||
Result := FOwner;
|
||||
Result := FForm;
|
||||
end;
|
||||
|
||||
function TFormImpl.GetUpdate: Boolean;
|
||||
@ -319,12 +336,12 @@ end;
|
||||
|
||||
function TFormImpl.GetHorzScrollPosition: Integer;
|
||||
begin
|
||||
Result := -(RealLeft + PositionDelta.x);
|
||||
Result := -(RealLeft {+ PositionDelta.x});
|
||||
end;
|
||||
|
||||
function TFormImpl.GetVertScrollPosition: Integer;
|
||||
begin
|
||||
Result := -(RealTop + PositionDelta.y);
|
||||
Result := -(RealTop {+ PositionDelta.y});
|
||||
end;
|
||||
|
||||
procedure TFormImpl.BeginUpdate;
|
||||
@ -339,14 +356,14 @@ end;
|
||||
|
||||
procedure TFormImpl.ShowWindow;
|
||||
begin
|
||||
if FOwner.Parent = nil then
|
||||
LCLIntf.ShowWindow(FOwner.Handle, SW_SHOW);
|
||||
if FForm.Parent = nil then
|
||||
LCLIntf.ShowWindow(FForm.Handle, SW_SHOW);
|
||||
end;
|
||||
|
||||
procedure TFormImpl.HideWindow;
|
||||
begin
|
||||
if FOwner.Parent = nil then
|
||||
LCLIntf.ShowWindow(FOwner.Handle, SW_HIDE);
|
||||
if FForm.Parent = nil then
|
||||
LCLIntf.ShowWindow(FForm.Handle, SW_HIDE);
|
||||
end;
|
||||
|
||||
function TFormImpl.QueryInterface(constref IID: TGUID; out Obj
|
||||
@ -354,13 +371,13 @@ function TFormImpl.QueryInterface(constref IID: TGUID; out Obj
|
||||
begin
|
||||
Result := inherited QueryInterface(IID, Obj);
|
||||
if Result <> S_OK then
|
||||
Result := TFormAccess(FOwner).QueryInterface(IID, Obj);
|
||||
Result := TFormAccess(FForm).QueryInterface(IID, Obj);
|
||||
end;
|
||||
|
||||
procedure TFormImpl.DoChangeHackedBounds;
|
||||
begin
|
||||
if not FUpdate and Assigned(FOnChangeHackedBounds) then
|
||||
FOnChangeHackedBounds(FOwner);
|
||||
FOnChangeHackedBounds(FForm);
|
||||
end;
|
||||
|
||||
function TFormImpl.GetLogicalClientRect(ALogicalClientRect: TRect): TRect;
|
||||
@ -368,10 +385,11 @@ begin
|
||||
Result:=ALogicalClientRect;
|
||||
end;
|
||||
|
||||
constructor TFormImpl.Create(AOwner: TCustomForm);
|
||||
constructor TFormImpl.Create(AOwner: TComponent; AForm: TCustomForm);
|
||||
begin
|
||||
FOwner := AOwner;
|
||||
FDesignedRealForm := FOwner as IDesignedRealForm;
|
||||
inherited Create(AOwner);
|
||||
FForm := AForm;
|
||||
FDesignedRealForm := Self as IDesignedRealForm;
|
||||
end;
|
||||
|
||||
destructor TFormImpl.Destroy;
|
||||
@ -385,7 +403,7 @@ end;
|
||||
function TFormContainer.GetDesignedForm: TFormImpl;
|
||||
begin
|
||||
if not Assigned(FDesignedForm) then
|
||||
FDesignedForm := TFormImpl.Create(Self);
|
||||
FDesignedForm := TFormImpl.Create(Self, Self);
|
||||
|
||||
Result := FDesignedForm;
|
||||
end;
|
||||
|
||||
@ -1,24 +1,28 @@
|
||||
object BasicResizeFrame: TBasicResizeFrame
|
||||
Left = 0
|
||||
Height = 460
|
||||
Height = 690
|
||||
Top = 0
|
||||
Width = 320
|
||||
ClientHeight = 460
|
||||
ClientWidth = 320
|
||||
Width = 480
|
||||
ClientHeight = 690
|
||||
ClientWidth = 480
|
||||
Color = clDefault
|
||||
ParentColor = True
|
||||
DesignTimePPI = 144
|
||||
ParentFont = False
|
||||
TabOrder = 0
|
||||
DesignLeft = 789
|
||||
DesignTop = 488
|
||||
object pR: TPanel
|
||||
AnchorSideTop.Control = Owner
|
||||
Cursor = crSizeWE
|
||||
Left = 295
|
||||
Height = 443
|
||||
Top = 0
|
||||
Width = 8
|
||||
Left = 446
|
||||
Height = 664
|
||||
Top = 166
|
||||
Width = 12
|
||||
Anchors = []
|
||||
BevelOuter = bvNone
|
||||
ClientHeight = 443
|
||||
ClientWidth = 8
|
||||
ClientHeight = 664
|
||||
ClientWidth = 12
|
||||
Color = clNone
|
||||
ParentColor = False
|
||||
TabOrder = 0
|
||||
@ -28,12 +32,12 @@ object BasicResizeFrame: TBasicResizeFrame
|
||||
AnchorSideBottom.Control = pR
|
||||
AnchorSideBottom.Side = asrBottom
|
||||
Left = 0
|
||||
Height = 429
|
||||
Top = 7
|
||||
Width = 1
|
||||
Height = 644
|
||||
Top = 10
|
||||
Width = 2
|
||||
Anchors = [akTop, akLeft, akBottom]
|
||||
BorderSpacing.Top = 7
|
||||
BorderSpacing.Bottom = 7
|
||||
BorderSpacing.Top = 10
|
||||
BorderSpacing.Bottom = 10
|
||||
BevelOuter = bvNone
|
||||
Color = clWhite
|
||||
ParentColor = False
|
||||
@ -44,13 +48,13 @@ object BasicResizeFrame: TBasicResizeFrame
|
||||
AnchorSideLeft.Control = Owner
|
||||
Cursor = crSizeNS
|
||||
Left = 0
|
||||
Height = 8
|
||||
Top = 435
|
||||
Width = 303
|
||||
Height = 12
|
||||
Top = 656
|
||||
Width = 454
|
||||
Anchors = [akLeft, akRight]
|
||||
BevelOuter = bvNone
|
||||
ClientHeight = 8
|
||||
ClientWidth = 303
|
||||
ClientHeight = 12
|
||||
ClientWidth = 454
|
||||
Color = clNone
|
||||
ParentColor = False
|
||||
TabOrder = 1
|
||||
@ -59,27 +63,27 @@ object BasicResizeFrame: TBasicResizeFrame
|
||||
AnchorSideTop.Control = pB
|
||||
AnchorSideRight.Control = pB
|
||||
AnchorSideRight.Side = asrBottom
|
||||
Left = 7
|
||||
Height = 1
|
||||
Left = 10
|
||||
Height = 2
|
||||
Top = 0
|
||||
Width = 289
|
||||
Width = 434
|
||||
Anchors = [akTop, akLeft, akRight]
|
||||
BorderSpacing.Left = 7
|
||||
BorderSpacing.Right = 7
|
||||
BorderSpacing.Left = 10
|
||||
BorderSpacing.Right = 10
|
||||
TabOrder = 0
|
||||
end
|
||||
end
|
||||
object pL: TPanel
|
||||
AnchorSideLeft.Control = Owner
|
||||
AnchorSideTop.Control = Owner
|
||||
Left = 0
|
||||
Height = 443
|
||||
Top = 0
|
||||
Width = 8
|
||||
Left = 3
|
||||
Height = 664
|
||||
Top = 166
|
||||
Width = 12
|
||||
Anchors = []
|
||||
BevelOuter = bvNone
|
||||
ClientHeight = 443
|
||||
ClientWidth = 8
|
||||
ClientHeight = 664
|
||||
ClientWidth = 12
|
||||
Color = clNone
|
||||
ParentColor = False
|
||||
TabOrder = 2
|
||||
@ -89,13 +93,13 @@ object BasicResizeFrame: TBasicResizeFrame
|
||||
AnchorSideRight.Side = asrBottom
|
||||
AnchorSideBottom.Control = pL
|
||||
AnchorSideBottom.Side = asrBottom
|
||||
Left = 7
|
||||
Height = 429
|
||||
Top = 7
|
||||
Width = 1
|
||||
Left = 10
|
||||
Height = 644
|
||||
Top = 10
|
||||
Width = 2
|
||||
Anchors = [akTop, akRight, akBottom]
|
||||
BorderSpacing.Top = 7
|
||||
BorderSpacing.Bottom = 7
|
||||
BorderSpacing.Top = 10
|
||||
BorderSpacing.Bottom = 10
|
||||
BevelOuter = bvNone
|
||||
Color = clWhite
|
||||
ParentColor = False
|
||||
@ -106,13 +110,13 @@ object BasicResizeFrame: TBasicResizeFrame
|
||||
AnchorSideLeft.Control = Owner
|
||||
AnchorSideTop.Control = Owner
|
||||
Left = 0
|
||||
Height = 8
|
||||
Top = 0
|
||||
Width = 303
|
||||
Height = 12
|
||||
Top = 3
|
||||
Width = 454
|
||||
Anchors = [akLeft, akRight]
|
||||
BevelOuter = bvNone
|
||||
ClientHeight = 8
|
||||
ClientWidth = 303
|
||||
ClientHeight = 12
|
||||
ClientWidth = 454
|
||||
Color = clNone
|
||||
ParentColor = False
|
||||
TabOrder = 3
|
||||
@ -122,13 +126,13 @@ object BasicResizeFrame: TBasicResizeFrame
|
||||
AnchorSideRight.Side = asrBottom
|
||||
AnchorSideBottom.Control = pT
|
||||
AnchorSideBottom.Side = asrBottom
|
||||
Left = 7
|
||||
Height = 1
|
||||
Top = 7
|
||||
Width = 289
|
||||
Left = 10
|
||||
Height = 2
|
||||
Top = 10
|
||||
Width = 434
|
||||
Anchors = [akLeft, akRight, akBottom]
|
||||
BorderSpacing.Left = 7
|
||||
BorderSpacing.Right = 7
|
||||
BorderSpacing.Left = 10
|
||||
BorderSpacing.Right = 10
|
||||
BevelOuter = bvNone
|
||||
Color = clWhite
|
||||
ParentColor = False
|
||||
@ -136,9 +140,9 @@ object BasicResizeFrame: TBasicResizeFrame
|
||||
end
|
||||
end
|
||||
object iResizerLineImg: TImage
|
||||
Left = 216
|
||||
Left = 324
|
||||
Height = 6
|
||||
Top = 32
|
||||
Top = 48
|
||||
Width = 6
|
||||
AutoSize = True
|
||||
Picture.Data = {
|
||||
@ -158,16 +162,14 @@ object BasicResizeFrame: TBasicResizeFrame
|
||||
AnchorSideTop.Side = asrBottom
|
||||
AnchorSideRight.Control = pR
|
||||
AnchorSideBottom.Control = pB
|
||||
Left = 8
|
||||
Height = 427
|
||||
Top = 8
|
||||
Width = 287
|
||||
Left = 15
|
||||
Height = 641
|
||||
Top = 15
|
||||
Width = 431
|
||||
Anchors = [akTop, akLeft, akRight, akBottom]
|
||||
BevelOuter = bvNone
|
||||
ClientHeight = 427
|
||||
ClientWidth = 287
|
||||
Color = clDefault
|
||||
ParentColor = True
|
||||
ClientHeight = 641
|
||||
ClientWidth = 431
|
||||
TabOrder = 4
|
||||
object pFakeMenu: TPanel
|
||||
AnchorSideLeft.Control = pBG
|
||||
@ -175,9 +177,9 @@ object BasicResizeFrame: TBasicResizeFrame
|
||||
AnchorSideRight.Control = pBG
|
||||
AnchorSideRight.Side = asrBottom
|
||||
Left = 0
|
||||
Height = 50
|
||||
Height = 75
|
||||
Top = 0
|
||||
Width = 287
|
||||
Width = 431
|
||||
Anchors = [akTop, akLeft, akRight]
|
||||
BevelOuter = bvNone
|
||||
TabOrder = 0
|
||||
@ -192,14 +194,26 @@ object BasicResizeFrame: TBasicResizeFrame
|
||||
AnchorSideTop.Side = asrBottom
|
||||
AnchorSideRight.Control = pR
|
||||
AnchorSideBottom.Control = pB
|
||||
Left = 0
|
||||
Height = 152
|
||||
Top = 0
|
||||
Width = 152
|
||||
Left = 57
|
||||
Height = 228
|
||||
Top = 57
|
||||
Width = 228
|
||||
Anchors = []
|
||||
BevelOuter = bvNone
|
||||
Color = clDefault
|
||||
ParentColor = True
|
||||
ClientHeight = 228
|
||||
ClientWidth = 228
|
||||
Color = clGreen
|
||||
ParentColor = False
|
||||
TabOrder = 5
|
||||
object pFormHandler: TPanel
|
||||
Left = 32
|
||||
Height = 50
|
||||
Top = 112
|
||||
Width = 170
|
||||
BevelOuter = bvNone
|
||||
Color = clDefault
|
||||
ParentColor = False
|
||||
TabOrder = 0
|
||||
end
|
||||
end
|
||||
end
|
||||
|
||||
@ -18,6 +18,7 @@ type
|
||||
TResizerFrameClass = class of TBasicResizeFrame;
|
||||
TBasicResizeFrame = class(TFrame, IResizeFrame)
|
||||
iResizerLineImg: TImage;
|
||||
pFormHandler: TPanel;
|
||||
pFakeMenu: TPanel;
|
||||
pBG: TPanel;
|
||||
pB: TPanel;
|
||||
@ -59,6 +60,7 @@ type
|
||||
FPositioningKind: TPositioningKind;
|
||||
FMaxWidth, FMaxHeight: Integer;
|
||||
FLastClientWidth, FLastClientHeight: Integer;
|
||||
FLastDesignedWidthToScroll, FLastDesignedHeightToScroll: Integer;
|
||||
FOldHasMainMenu: Boolean;
|
||||
FDesignerModified: Boolean;
|
||||
FSizerLineWidth: Integer;
|
||||
@ -92,6 +94,8 @@ type
|
||||
function LeftSizerLineWidth: Integer;
|
||||
function HorizontalSizerLineLength: Integer;
|
||||
|
||||
procedure AdjustFormHandler;
|
||||
|
||||
function GetMenuHeight: Integer;
|
||||
protected
|
||||
FNodes: TObjectList;
|
||||
@ -116,7 +120,8 @@ type
|
||||
function GetBackgroundPanel: TPanel;
|
||||
function GetBackgroundMargin(const AIndex: Integer): Integer;
|
||||
|
||||
function GetClientPanel: TPanel;
|
||||
function GetNewSize: TPoint;
|
||||
function GetFormHandler: TPanel;
|
||||
function GetNodePositioning: Boolean;
|
||||
function GetDesignedForm: IDesignedForm;
|
||||
procedure SetDesignedForm(const AValue: IDesignedForm);
|
||||
@ -436,6 +441,7 @@ begin
|
||||
if (Enabled) and (Sender is TWinControl) then
|
||||
begin
|
||||
FNodePositioning:=True;
|
||||
BeginFormSizeUpdate(Sender);
|
||||
|
||||
// when we start resizing the rules do not apply to us :)
|
||||
FMaxWidth := Constraints.MaxWidth;
|
||||
@ -459,7 +465,6 @@ begin
|
||||
BorderSpacing.Bottom := Max(Self.Height - (pB.Top - BgBottomMargin), 0);
|
||||
end;
|
||||
|
||||
BeginFormSizeUpdate(Sender);
|
||||
|
||||
{$IF Defined(LCLWin32) or Defined(LCLWin64)}
|
||||
SetCapture(TWinControl(Sender).Handle);
|
||||
@ -619,6 +624,7 @@ begin
|
||||
if Assigned(OnNodePositioning) then
|
||||
OnNodePositioning(Sender, FPositioningKind, pcPositioningEnd);
|
||||
FPositioningKind := [];
|
||||
FNodePositioning := False;
|
||||
|
||||
pClient.Align := alNone;
|
||||
BorderSpacing.Left := 0;
|
||||
@ -632,6 +638,10 @@ begin
|
||||
// after resizing, TFrame is frozen in Windows OS
|
||||
// this is trick to workaraund IDE bug. Also for proper size for normal form
|
||||
TryBoundDesignedForm;
|
||||
// for small resizes, designed form is moved on the top and on the bottom
|
||||
// is showed white block - to stop this we need to move pClient to right position
|
||||
PositionNodes;
|
||||
ShowSizeControls;
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -725,6 +735,14 @@ begin
|
||||
Result := Width - RightMargin;
|
||||
end;
|
||||
|
||||
procedure TBasicResizeFrame.AdjustFormHandler;
|
||||
begin
|
||||
pFormHandler.Left:=(-FDesignedForm.Form.Left)-(FDesignedForm.PositionDelta.x+ifthen(FHorizontalScrollPos-SizerLineWidth>0,FHorizontalScrollPos-SizerLineWidth,0));
|
||||
pFormHandler.Top:=(-FDesignedForm.Form.Top)-(FDesignedForm.PositionDelta.y+ifthen(FVerticalScrollPos-SizerLineWidth>0,FVerticalScrollPos-SizerLineWidth,0));
|
||||
pFormHandler.Width:=(FDesignedForm.Form.Width+abs(FDesignedForm.Form.Left)+FDesignedForm.PositionDelta.x);;
|
||||
pFormHandler.Height:=(FDesignedForm.Form.Height+abs(FDesignedForm.Form.Top)+FDesignedForm.PositionDelta.y);
|
||||
end;
|
||||
|
||||
function TBasicResizeFrame.GetBackgroundMargin(const AIndex: Integer): Integer;
|
||||
begin
|
||||
if FBackground = nil then
|
||||
@ -736,9 +754,14 @@ begin
|
||||
Result := Result + GetMenuHeight;
|
||||
end;
|
||||
|
||||
function TBasicResizeFrame.GetClientPanel: TPanel;
|
||||
function TBasicResizeFrame.GetNewSize: TPoint;
|
||||
begin
|
||||
Result := pClient;
|
||||
Result := TPoint.Create(FLastClientWidth,FLastClientHeight);
|
||||
end;
|
||||
|
||||
function TBasicResizeFrame.GetFormHandler: TPanel;
|
||||
begin
|
||||
Result := pFormHandler;
|
||||
end;
|
||||
|
||||
function TBasicResizeFrame.GetNodePositioning: Boolean;
|
||||
@ -795,9 +818,9 @@ begin
|
||||
|
||||
// for GTK2 resizing form (pClient is hidden under pBG)
|
||||
{$IF DEFINED(LCLGtk2) OR DEFINED(LCLQt) OR DEFINED(LCLQt5)}
|
||||
pClient.SendToBack; // <--- this is a must.
|
||||
pFormHandler.SendToBack; // <--- this is a must.
|
||||
{$ENDIF}
|
||||
pClient.BringToFront;
|
||||
pFormHandler.BringToFront;
|
||||
|
||||
pFakeMenu.Visible := HasMainMenu;
|
||||
if pFakeMenu.Visible then
|
||||
@ -812,6 +835,8 @@ end;
|
||||
|
||||
procedure TBasicResizeFrame.BeginFormSizeUpdate(Sender: TObject);
|
||||
begin
|
||||
FLastDesignedWidthToScroll:=DesignedWidthToScroll;
|
||||
FLastDesignedHeightToScroll:=DesignedHeightToScroll;
|
||||
end;
|
||||
|
||||
procedure TBasicResizeFrame.EndFormSizeUpdate(Sender: TObject);
|
||||
@ -862,8 +887,10 @@ function TBasicResizeFrame.DesignedWidthToScroll: Integer;
|
||||
begin
|
||||
if DesignedForm = nil then
|
||||
Exit(0);
|
||||
|
||||
Result := DesignedForm.Width - FLastClientWidth;
|
||||
if FNodePositioning then
|
||||
Result := FLastDesignedWidthToScroll
|
||||
else
|
||||
Result := abs(DesignedForm.Width - FLastClientWidth);
|
||||
//Result := DesignedForm.Width - DesignedForm.RealWidth;
|
||||
end;
|
||||
|
||||
@ -878,7 +905,10 @@ begin
|
||||
if DesignedForm = nil then
|
||||
Exit(0);
|
||||
|
||||
Result := DesignedForm.Height - FLastClientHeight;
|
||||
if FNodePositioning then
|
||||
Result := FLastDesignedHeightToScroll
|
||||
else
|
||||
Result := abs(DesignedForm.Height - FLastClientHeight);
|
||||
//Result := DesignedForm.Height - DesignedForm.RealHeight;
|
||||
end;
|
||||
|
||||
@ -1035,6 +1065,8 @@ begin
|
||||
pClient.Width := Width - pClient.Left - Max(Width - (pR.Left - BgRightMargin), 0);
|
||||
end;
|
||||
|
||||
AdjustFormHandler;
|
||||
|
||||
for Node := 0 to 7 do
|
||||
begin
|
||||
with AroundControl do
|
||||
|
||||
@ -55,7 +55,7 @@ begin
|
||||
begin
|
||||
FDesignedForm.BeginUpdate;
|
||||
|
||||
FDesignedForm.Form.Parent := FResizerFrame.pClient;
|
||||
FDesignedForm.Form.Parent := FResizerFrame.pFormHandler;
|
||||
{$IFNDEF WINDOWS}
|
||||
FDesignedForm.Form.BorderStyle := bsNone;
|
||||
{$ENDIF}
|
||||
|
||||
@ -52,6 +52,7 @@ type
|
||||
|
||||
procedure ShowWindow;
|
||||
procedure HideWindow;
|
||||
function PositionDelta: TPoint;
|
||||
|
||||
// hacked values
|
||||
function GetPublishedBounds(AIndex: Integer): Integer;
|
||||
@ -102,7 +103,8 @@ type
|
||||
procedure SetHorizontalScrollPos(AValue: Integer);
|
||||
function GetBackgroundPanel: TPanel;
|
||||
function GetBackgroundMargin(const AIndex: Integer): Integer;
|
||||
function GetClientPanel: TPanel;
|
||||
function GetNewSize: TPoint;
|
||||
function GetFormHandler: TPanel;
|
||||
function GetNodePositioning: Boolean;
|
||||
function GetDesignedForm: IDesignedForm;
|
||||
procedure SetDesignedForm(const AValue: IDesignedForm);
|
||||
@ -120,7 +122,8 @@ type
|
||||
property BgRightMargin: Integer index 2 read GetBackgroundMargin;
|
||||
property BgBottomMargin: Integer index 3 read GetBackgroundMargin;
|
||||
|
||||
property ClientPanel: TPanel read GetClientPanel;
|
||||
property NewSize: TPoint read GetNewSize;
|
||||
property FormHandler: TPanel read GetFormHandler;
|
||||
property NodePositioning: Boolean read GetNodePositioning;
|
||||
property DesignedForm: IDesignedForm read GetDesignedForm write SetDesignedForm;
|
||||
|
||||
|
||||
@ -37,7 +37,7 @@ var
|
||||
|
||||
procedure Register;
|
||||
begin
|
||||
FormEditingHook.StandardDesignerBaseClasses[DesignerBaseClassId_TForm] := TFakeFormBG;
|
||||
//FormEditingHook.StandardDesignerBaseClasses[DesignerBaseClassId_TForm] := TFakeFormBG;
|
||||
Manager := TStarterDesignTimeUtilsManager.Create;
|
||||
DTUManager := Manager;
|
||||
end;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user