From 951fac12162adb536ab2c78e34f3abba40b33905 Mon Sep 17 00:00:00 2001 From: juha Date: Thu, 19 Nov 2015 00:19:56 +0000 Subject: [PATCH] Move Sparta DockedFormEditor package from freesparta branch to trunk. git-svn-id: trunk@50411 - --- .gitattributes | 14 + .../source/sparta_designedform.pas | 147 ++ .../source/sparta_fakecustom.pas | 1045 ++++++++++ .../source/sparta_fakeform.pas | 215 +++ .../source/sparta_fakeframe.pas | 29 + .../source/sparta_fakenoncontrol.pas | 29 + .../source/sparta_hashutils.pas | 30 + .../source/sparta_mainide.pas | 1713 +++++++++++++++++ .../source/sparta_reg_dockedformeditor.pas | 65 + .../source/sparta_resizer.pas | 452 +++++ .../source/sparta_resizerframe.lfm | 188 ++ .../source/sparta_resizerframe.pas | 832 ++++++++ .../dockedformeditor/source/spartaapi.pas | 123 ++ .../sparta_dockedformeditor.lpk | 84 + .../sparta_dockedformeditor.pas | 25 + 15 files changed, 4991 insertions(+) create mode 100644 components/sparta/dockedformeditor/source/sparta_designedform.pas create mode 100644 components/sparta/dockedformeditor/source/sparta_fakecustom.pas create mode 100644 components/sparta/dockedformeditor/source/sparta_fakeform.pas create mode 100644 components/sparta/dockedformeditor/source/sparta_fakeframe.pas create mode 100644 components/sparta/dockedformeditor/source/sparta_fakenoncontrol.pas create mode 100644 components/sparta/dockedformeditor/source/sparta_hashutils.pas create mode 100644 components/sparta/dockedformeditor/source/sparta_mainide.pas create mode 100644 components/sparta/dockedformeditor/source/sparta_reg_dockedformeditor.pas create mode 100644 components/sparta/dockedformeditor/source/sparta_resizer.pas create mode 100644 components/sparta/dockedformeditor/source/sparta_resizerframe.lfm create mode 100644 components/sparta/dockedformeditor/source/sparta_resizerframe.pas create mode 100644 components/sparta/dockedformeditor/source/spartaapi.pas create mode 100644 components/sparta/dockedformeditor/sparta_dockedformeditor.lpk create mode 100644 components/sparta/dockedformeditor/sparta_dockedformeditor.pas diff --git a/.gitattributes b/.gitattributes index a72ff81a0b..82c58bb927 100644 --- a/.gitattributes +++ b/.gitattributes @@ -3530,6 +3530,20 @@ components/simpleideintf/examples/testh2pastool.lpr svneol=native#text/plain components/simpleideintf/simpleide.pas svneol=native#text/plain components/simpleideintf/simpleideintf.lpk svneol=native#text/plain components/simpleideintf/simpleideintf.pas svneol=native#text/plain +components/sparta/dockedformeditor/source/sparta_designedform.pas svneol=native#text/pascal +components/sparta/dockedformeditor/source/sparta_fakecustom.pas svneol=native#text/pascal +components/sparta/dockedformeditor/source/sparta_fakeform.pas svneol=native#text/pascal +components/sparta/dockedformeditor/source/sparta_fakeframe.pas svneol=native#text/pascal +components/sparta/dockedformeditor/source/sparta_fakenoncontrol.pas svneol=native#text/pascal +components/sparta/dockedformeditor/source/sparta_hashutils.pas svneol=native#text/pascal +components/sparta/dockedformeditor/source/sparta_mainide.pas svneol=native#text/pascal +components/sparta/dockedformeditor/source/sparta_reg_dockedformeditor.pas svneol=native#text/pascal +components/sparta/dockedformeditor/source/sparta_resizer.pas svneol=native#text/pascal +components/sparta/dockedformeditor/source/sparta_resizerframe.lfm svneol=native#text/plain +components/sparta/dockedformeditor/source/sparta_resizerframe.pas svneol=native#text/pascal +components/sparta/dockedformeditor/source/spartaapi.pas svneol=native#text/pascal +components/sparta/dockedformeditor/sparta_dockedformeditor.lpk svneol=native#text/plain +components/sparta/dockedformeditor/sparta_dockedformeditor.pas svneol=native#text/pascal components/sqldb/Makefile svneol=native#text/plain components/sqldb/Makefile.compiled svneol=native#text/plain components/sqldb/Makefile.fpc svneol=native#text/plain diff --git a/components/sparta/dockedformeditor/source/sparta_designedform.pas b/components/sparta/dockedformeditor/source/sparta_designedform.pas new file mode 100644 index 0000000000..547b0d89ff --- /dev/null +++ b/components/sparta/dockedformeditor/source/sparta_designedform.pas @@ -0,0 +1,147 @@ +{ + ***************************************************************************** + See the file COPYING.modifiedLGPL.txt, included in this distribution, + for details about the license. + ***************************************************************************** + + Author: Maciej Izak + + DaThoX 2004-2015 + FreeSparta.com +} + +unit sparta_DesignedForm; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, Controls, Forms, SrcEditorIntf; + +type + IDesignedRealForm = interface + ['{AAEC32EE-4ABE-4691-A172-FC67B66118DD}'] + // bounds + function GetRealBounds(AIndex: Integer): Integer; + procedure SetRealBounds(AIndex: Integer; AValue: Integer); + + property RealLeft: Integer index 0 read GetRealBounds write SetRealBounds; + property RealTop: Integer index 1 read GetRealBounds write SetRealBounds; + property RealWidth: Integer index 2 read GetRealBounds write SetRealBounds; + property RealHeight: Integer index 3 read GetRealBounds write SetRealBounds; + + // setters + procedure SetRealBorderStyle(AVal: TFormBorderStyle); + procedure SetRealBorderIcons(AVal: TBorderIcons); + procedure SetRealFormStyle(AVal: TFormStyle); + procedure SetRealPopupMode(AVal: TPopupMode); + procedure SetRealPopupParent(AVal: TCustomForm); + + // getters + function GetRealBorderStyle: TFormBorderStyle; + function GetRealBorderIcons: TBorderIcons; + function GetRealFormStyle: TFormStyle; + function GetRealPopupMode: TPopupMode; + function GetRealPopupParent: TCustomForm; + + // properties + property RealBorderStyle: TFormBorderStyle read GetRealBorderStyle write SetRealBorderStyle; + property RealBorderIcons: TBorderIcons read GetRealBorderIcons write SetRealBorderIcons; + property RealFormStyle: TFormStyle read GetRealFormStyle write SetRealFormStyle; + + property RealPopupMode: TPopupMode read GetRealPopupMode write SetRealPopupMode; + property RealPopupParent: TCustomForm read GetRealPopupParent write SetRealPopupParent; + end; + + IDesignedRealFormHelper = interface(IDesignedRealForm) + function GetLogicalClientRect(ALogicalClientRect: TRect): TRect; + end; + + IDesignedForm = interface(IDesignedRealForm) + ['{5D30C0DE-4D51-4FB5-99FC-88900FAE6B66}'] + procedure BeginUpdate; + procedure EndUpdate(AModified: Boolean = False); + + function GetUpdate: Boolean; + property Update: Boolean read GetUpdate; + + procedure ShowWindow; + procedure HideWindow; + + // hacked values + function GetPublishedBounds(AIndex: Integer): Integer; + procedure SetPublishedBounds(AIndex: Integer; AValue: Integer); + property Left: Integer index 0 read GetPublishedBounds write SetPublishedBounds; + property Top: Integer index 1 read GetPublishedBounds write SetPublishedBounds; + property Width: Integer index 2 read GetPublishedBounds write SetPublishedBounds; + property Height: Integer index 3 read GetPublishedBounds write SetPublishedBounds; + + // design form scroll system + procedure SetHorzScrollPosition(AValue: Integer); + procedure SetVertScrollPosition(AValue: Integer); + function GetHorzScrollPosition: Integer; + function GetVertScrollPosition: Integer; + property HorzScrollPosition: Integer read GetHorzScrollPosition write SetHorzScrollPosition; + property VertScrollPosition: Integer read GetVertScrollPosition write SetVertScrollPosition; + + // on notify change + procedure SetOnChangeHackedBounds(const AValue: TNotifyEvent); + function GetOnChangeHackedBounds: TNotifyEvent; + property OnChangeHackedBounds: TNotifyEvent read GetOnChangeHackedBounds write SetOnChangeHackedBounds; + + // + function GetForm: TCustomForm; + property Form: TCustomForm read GetForm; + + // for last active window + function GetLastActiveSourceWindow: TSourceEditorWindowInterface; + procedure SetLastActiveSourceWindow(AValue: TSourceEditorWindowInterface); + property LastActiveSourceWindow: TSourceEditorWindowInterface read GetLastActiveSourceWindow write SetLastActiveSourceWindow; + end; + + IDesignedFakeControl = interface + ['{31708772-D9FF-42D8-88AD-D27663393177}'] + end; + + IDesignedFakeForm = interface + ['{A887F50D-13A3-4048-AFFD-F07816FDD08A}'] + // other hacked values + procedure SetFormBorderStyle(ANewStyle: TFormBorderStyle); + procedure SetBorderIcons(AVal: TBorderIcons); + procedure SetFormStyle(AValue : TFormStyle); + procedure SetCaption(const AValue: string); + function GetBorderStyle: TFormBorderStyle; + function GetBorderIcons: TBorderIcons; + function GetFormStyle: TFormStyle; + function GetCaption: string; + + property BorderIcons: TBorderIcons read GetBorderIcons write SetBorderIcons; + property BorderStyle: TFormBorderStyle read GetBorderStyle write SetFormBorderStyle; + property FormStyle: TFormStyle read GetFormStyle write SetFormStyle; + property Caption: string read GetCaption write SetCaption; + end; + + IDesignedFormBackground = interface + ['{AC7F6594-1C2D-4424-977B-28053A79CE99}'] + function GetMargin(const AIndex: Integer): Integer; + + property LeftMargin: Integer index 0 read GetMargin; + property TopMargin: Integer index 1 read GetMargin; + property RightMargin: Integer index 2 read GetMargin; + property BottomMargin: Integer index 3 read GetMargin; + + procedure SetParent(AValue: TWinControl); + function GetParent: TWinControl; + property Parent: TWinControl read GetParent write SetParent; + + function GetDesignedForm: IDesignedForm; + property DesignedForm: IDesignedForm read GetDesignedForm; + + procedure RefreshValues; + end; + +implementation + +end. + diff --git a/components/sparta/dockedformeditor/source/sparta_fakecustom.pas b/components/sparta/dockedformeditor/source/sparta_fakecustom.pas new file mode 100644 index 0000000000..3c4eb278e9 --- /dev/null +++ b/components/sparta/dockedformeditor/source/sparta_fakecustom.pas @@ -0,0 +1,1045 @@ +{ + ***************************************************************************** + See the file COPYING.modifiedLGPL.txt, included in this distribution, + for details about the license. + ***************************************************************************** + + Author: Maciej Izak + + DaThoX 2004-2015 + FreeSparta.com +} + +unit sparta_FakeCustom; + +{$mode delphi}{$H+} + +interface + +uses + Classes, SysUtils, Forms, FormEditingIntf, Controls, TypInfo, LCLIntf, + LCLType, sparta_DesignedForm, Math, +{$IFDEF USE_GENERICS_COLLECTIONS} + Generics.Defaults, +{$ENDIF} + SrcEditorIntf; + +type + { TDesignedFormImpl } + +{$IFDEF USE_GENERICS_COLLECTIONS} + TDesignedFormImpl = class(TSingletonImplementation, IDesignedRealFormHelper, IDesignedForm) +{$ELSE} + TDesignedFormImpl = class(TComponent, IDesignedRealFormHelper, IDesignedForm) +{$ENDIF} + private + FOwner: TForm; + FDesignedRealForm: IDesignedRealForm; + FHackLeft: Integer; + FHackTop: Integer; + FHackWidth: Integer; + FHackHeight: Integer; + + private + FHorzScrollPosition: Integer; + FVertScrollPosition: Integer; + FOnChangeHackedBounds: TNotifyEvent; + FLastActiveSourceWindow: TSourceEditorWindowInterface; + + procedure SetOnChangeHackedBounds(const AValue: TNotifyEvent); + function GetOnChangeHackedBounds: TNotifyEvent; + function PositionDelta: TPoint; + protected + FUpdate: boolean; + protected + function GetRealBounds(AIndex: Integer): Integer; virtual; + procedure SetRealBounds(AIndex: Integer; AValue: Integer); virtual; + function GetPublishedBounds(AIndex: Integer): Integer; virtual; + procedure SetPublishedBounds(AIndex: Integer; AValue: Integer); virtual; + + procedure SetHorzScrollPosition(AValue: Integer); virtual; + procedure SetVertScrollPosition(AValue: Integer); virtual; + + // own custom form scrool system + function GetHorzScrollPosition: Integer; virtual; + function GetVertScrollPosition: Integer; virtual; + + procedure SetRealBorderStyle(AVal: TFormBorderStyle); virtual; + procedure SetRealBorderIcons(AVal: TBorderIcons); virtual; + procedure SetRealFormStyle(AVal: TFormStyle); virtual; + procedure SetRealPopupMode(AVal: TPopupMode); virtual; + procedure SetRealPopupParent(AVal: TCustomForm); virtual; + + function GetRealBorderStyle: TFormBorderStyle; virtual; + function GetRealBorderIcons: TBorderIcons; virtual; + function GetRealFormStyle: TFormStyle; virtual; + function GetRealPopupMode: TPopupMode; virtual; + function GetRealPopupParent: TCustomForm; virtual; + + function GetLastActiveSourceWindow: TSourceEditorWindowInterface; virtual; + procedure SetLastActiveSourceWindow(AValue: TSourceEditorWindowInterface); virtual; + + function GetForm: TCustomForm; virtual; + function GetUpdate: Boolean; virtual; + protected + procedure DoChangeHackedBounds; virtual; + + function GetLogicalClientRect(ALogicalClientRect: TRect): TRect; virtual; + public + property RealLeft: Integer index 0 read GetRealBounds write SetRealBounds; + property RealTop: Integer index 1 read GetRealBounds write SetRealBounds; + property RealWidth: Integer index 2 read GetRealBounds write SetRealBounds; + property RealHeight: Integer index 3 read GetRealBounds write SetRealBounds; + property RealBorderStyle: TFormBorderStyle read GetRealBorderStyle write SetRealBorderStyle; + property RealBorderIcons: TBorderIcons read GetRealBorderIcons write SetRealBorderIcons; + property RealFormStyle: TFormStyle read GetRealFormStyle write SetRealFormStyle; + + constructor Create(AOwner: TForm); virtual; + + procedure BeginUpdate; virtual; + procedure EndUpdate(AModified: Boolean = False); virtual; + + procedure ShowWindow; virtual; + procedure HideWindow; virtual; + + property Update: Boolean read GetUpdate; + public + property Left: Integer index 0 read GetPublishedBounds write SetPublishedBounds; + property Top: Integer index 1 read GetPublishedBounds write SetPublishedBounds; + property Width: Integer index 2 read GetPublishedBounds write SetPublishedBounds; + property Height: Integer index 3 read GetPublishedBounds write SetPublishedBounds; + public + function QueryInterface(constref IID: TGUID; out Obj): HResult; override; + end; + + { TFakeCustomForm } + + TFakeCustomForm = class(TForm, IDesignedRealForm, IDesignedForm) + private + FDesignedForm: TDesignedFormImpl; + function GetDesignedForm: TDesignedFormImpl; + protected + property DesignedForm: TDesignedFormImpl read GetDesignedForm implements IDesignedForm; + function GetLogicalClientRect: TRect; override; + protected + function GetRealBounds(AIndex: Integer): Integer; virtual; + procedure SetRealBounds(AIndex: Integer; AValue: Integer); virtual; + function GetPublishedBounds(AIndex: Integer): Integer; virtual; + procedure SetPublishedBounds(AIndex: Integer; AValue: Integer); virtual; + + procedure SetRealBorderStyle(AVal: TFormBorderStyle); virtual; + procedure SetRealBorderIcons(AVal: TBorderIcons); virtual; + procedure SetRealFormStyle(AVal: TFormStyle); virtual; + procedure SetRealPopupMode(AVal: TPopupMode); virtual; + procedure SetRealPopupParent(AVal: TCustomForm); virtual; + + function GetRealBorderStyle: TFormBorderStyle; virtual; + function GetRealBorderIcons: TBorderIcons; virtual; + function GetRealFormStyle: TFormStyle; virtual; + function GetRealPopupMode: TPopupMode; virtual; + function GetRealPopupParent: TCustomForm; virtual; + public + constructor CreateNew(AOwner: TComponent; Num: Integer = 0); override; + destructor Destroy; override; + published + property Left: Integer index 0 read GetPublishedBounds write SetPublishedBounds; + property Top: Integer index 1 read GetPublishedBounds write SetPublishedBounds; + property Width: Integer index 2 read GetPublishedBounds write SetPublishedBounds; + property Height: Integer index 3 read GetPublishedBounds write SetPublishedBounds; + property ClientWidth: Integer index 2 read GetPublishedBounds write SetPublishedBounds; + property ClientHeight: Integer index 3 read GetPublishedBounds write SetPublishedBounds; + end; + + { TDesignedNonControlFormImpl } + + TDesignedNonControlFormImpl = class(TDesignedFormImpl) + protected + function GetPublishedBounds(AIndex: Integer): Integer; override; + procedure SetPublishedBounds(AIndex: Integer; AValue: Integer); override; + end; + + { TFakeCustomNonControl } + + TFakeCustomNonControl = class(TNonControlProxyDesignerForm, IDesignedRealForm, IDesignedForm) + private + FDesignedForm: TDesignedFormImpl; + function GetDesignedForm: TDesignedFormImpl; + protected + property DesignedForm: TDesignedFormImpl read GetDesignedForm implements IDesignedForm; + function GetLogicalClientRect: TRect; override; + protected + function GetRealBounds(AIndex: Integer): Integer; virtual; + procedure SetRealBounds(AIndex: Integer; AValue: Integer); virtual; + function GetPublishedBounds(AIndex: Integer): Integer; override; + procedure SetPublishedBounds(AIndex: Integer; AValue: Integer); override; + + procedure SetRealBorderStyle(AVal: TFormBorderStyle); virtual; + procedure SetRealBorderIcons(AVal: TBorderIcons); virtual; + procedure SetRealFormStyle(AVal: TFormStyle); virtual; + procedure SetRealPopupMode(AVal: TPopupMode); virtual; + procedure SetRealPopupParent(AVal: TCustomForm); virtual; + + function GetRealBorderStyle: TFormBorderStyle; virtual; + function GetRealBorderIcons: TBorderIcons; virtual; + function GetRealFormStyle: TFormStyle; virtual; + function GetRealPopupMode: TPopupMode; virtual; + function GetRealPopupParent: TCustomForm; virtual; + protected + procedure SetLookupRoot(AValue: TComponent); override; + procedure SetMediator(AValue: TDesignerMediator); override; + public + constructor Create(AOwner: TComponent; ANonFormDesigner: INonFormDesigner); override; + destructor Destroy; override; + function DockedDesigner: boolean; override; + procedure SetBounds(ALeft, ATop, AWidth, AHeight: integer); override; + end; + + + { TDesignedFrameFormImpl } + + TDesignedFrameFormImpl = class(TDesignedFormImpl) + protected + function GetPublishedBounds(AIndex: Integer): Integer; override; + procedure SetPublishedBounds(AIndex: Integer; AValue: Integer); override; + end; + + { TFakeCustomFrame } + + TFakeCustomFrame = class(TFrameProxyDesignerForm, IDesignedRealForm, IDesignedForm) + private + FDesignedForm: TDesignedFormImpl; + function GetDesignedForm: TDesignedFormImpl; + protected + property DesignedForm: TDesignedFormImpl read GetDesignedForm implements IDesignedForm; + function GetLogicalClientRect: TRect; override; + protected + function GetRealBounds(AIndex: Integer): Integer; virtual; + procedure SetRealBounds(AIndex: Integer; AValue: Integer); virtual; + function GetPublishedBounds(AIndex: Integer): Integer; override; + procedure SetPublishedBounds(AIndex: Integer; AValue: Integer); override; + + procedure SetRealBorderStyle(AVal: TFormBorderStyle); virtual; + procedure SetRealBorderIcons(AVal: TBorderIcons); virtual; + procedure SetRealFormStyle(AVal: TFormStyle); virtual; + procedure SetRealPopupMode(AVal: TPopupMode); virtual; + procedure SetRealPopupParent(AVal: TCustomForm); virtual; + + function GetRealBorderStyle: TFormBorderStyle; virtual; + function GetRealBorderIcons: TBorderIcons; virtual; + function GetRealFormStyle: TFormStyle; virtual; + function GetRealPopupMode: TPopupMode; virtual; + function GetRealPopupParent: TCustomForm; virtual; + protected + procedure SetLookupRoot(AValue: TComponent); override; + public + constructor Create(AOwner: TComponent; ANonFormDesigner: INonFormDesigner); override; + destructor Destroy; override; + + function DockedDesigner: boolean; override; + end; + +implementation + +uses + sparta_MainIDE; + +type + TFormHack = class(TForm); + +{ TDesignedNonControlFormImpl } + +function TDesignedNonControlFormImpl.GetPublishedBounds(AIndex: Integer + ): Integer; +var + LBounds, LClientRect: TRect; + LMediator: TDesignerMediator; + LLookupRoot: TComponent; +begin + LLookupRoot := (FOwner as TNonFormProxyDesignerForm).LookupRoot; + if LLookupRoot is TDataModule then + with TDataModule(LLookupRoot) do + case AIndex of + 0: Result := DesignOffset.x; + 1: Result := DesignOffset.y; + 2: Result := DesignSize.x; + 3: Result := DesignSize.y; + end + else + begin + LMediator := (FOwner as TNonControlProxyDesignerForm).Mediator; + if (LLookupRoot <> nil) and (LMediator <> nil) then + begin + LMediator.GetFormBounds(LLookupRoot, LBounds, LClientRect); + //WriteLn(Format('get Bounds >>> %d %d %d %d',[LBounds.Left,LBounds.Top,LBounds.Right,LBounds.Bottom])); + //WriteLn(Format('get Client Rect >>> %d %d %d %d',[LClientRect.Left,LClientRect.Top,LClientRect.Right,LClientRect.Bottom])); + case AIndex of + 0: Result := LBounds.Left; + 1: Result := LBounds.Top; + 2: Result := LClientRect.Right; + 3: Result := LClientRect.Bottom; + end; + end; + end; + //else + //Result := inherited GetPublishedBounds(AIndex); +end; + +procedure TDesignedNonControlFormImpl.SetPublishedBounds(AIndex: Integer; + AValue: Integer); +var + LBounds, LClientRect: TRect; + LMediator: TDesignerMediator; + LLookupRoot: TComponent; +begin + LLookupRoot := (FOwner as TNonFormProxyDesignerForm).LookupRoot; + if LLookupRoot is TDataModule then + with TDataModule(LLookupRoot) do + case AIndex of + 0: DesignOffset := Point(AValue, DesignOffset.y); + 1: DesignOffset := Point(DesignOffset.x, AValue); + 2: DesignSize := Point(AValue, DesignSize.y); + 3: DesignSize := Point(DesignSize.x, AValue); + end + else + begin + LMediator := (FOwner as TNonControlProxyDesignerForm).Mediator; + if (LLookupRoot <> nil) and (LMediator <> nil) then + begin + LMediator.GetFormBounds(LLookupRoot, LBounds, LClientRect); + //WriteLn(Format('set Bounds >>> %d %d %d %d',[LBounds.Left,LBounds.Top,LBounds.Right,LBounds.Bottom])); + //WriteLn(Format('set Client Rect >>> %d %d %d %d',[LClientRect.Left,LClientRect.Top,LClientRect.Right,LClientRect.Bottom])); + case AIndex of + 0: LBounds := Rect(AValue, LBounds.Top, AValue + LClientRect.Right, LBounds.Bottom); + 1: LBounds := Rect(LBounds.Left, AValue, LBounds.Right, AValue + LClientRect.Bottom); + 2: LClientRect := Rect(0, 0, AValue, LClientRect.Bottom); + 3: LClientRect := Rect(0, 0, LClientRect.Right, AValue); + end; + if AIndex in [2, 3] then + LBounds := Rect(LBounds.Left, LBounds.Top, LBounds.Left + LClientRect.Right, LBounds.Top + LClientRect.Bottom); + LMediator.SetFormBounds(LLookupRoot,LBounds,LClientRect); + end; + end; + + // refresh for OI + inherited SetPublishedBounds(AIndex, AValue); +end; + +{ TDesignedFrameFormImpl } + +function TDesignedFrameFormImpl.GetPublishedBounds(AIndex: Integer): Integer; +begin + if (FOwner as TNonFormProxyDesignerForm).LookupRoot <> nil then + with (TNonFormProxyDesignerForm(FOwner).LookupRoot as TFrame) do + case AIndex of + 0: Result := Left; + 1: Result := Top; + 2: Result := Width; + 3: Result := Height; + end + else + Result:=inherited GetPublishedBounds(AIndex); +end; + +procedure TDesignedFrameFormImpl.SetPublishedBounds(AIndex: Integer; + AValue: Integer); +begin + if (FOwner as TNonFormProxyDesignerForm).LookupRoot <> nil then + with (TNonFormProxyDesignerForm(FOwner).LookupRoot as TControl) do + case AIndex of + 0: Left := AValue; + 1: Top := AValue; + 2: Width := AValue; + 3: Height := AValue; + end; + + // refresh for OI + inherited SetPublishedBounds(AIndex, AValue); +end; + +{ TFakeCustomFrame } + +function TFakeCustomFrame.GetDesignedForm: TDesignedFormImpl; +begin + if not Assigned(FDesignedForm) then + FDesignedForm := TDesignedFrameFormImpl.Create(Self); + + Result := FDesignedForm; +end; + +function TFakeCustomFrame.GetLogicalClientRect: TRect; +begin + Result := DesignedForm.GetLogicalClientRect(inherited GetLogicalClientRect); +end; + +function TFakeCustomFrame.GetRealBounds(AIndex: Integer): Integer; +begin + Result := inherited GetPublishedBounds(AIndex); +end; + +procedure TFakeCustomFrame.SetRealBounds(AIndex: Integer; AValue: Integer); +begin + inherited SetPublishedBounds(AIndex, AValue); +end; + +function TFakeCustomFrame.GetPublishedBounds(AIndex: Integer): Integer; +begin + Result := DesignedForm.GetPublishedBounds(AIndex); +end; + +procedure TFakeCustomFrame.SetPublishedBounds(AIndex: Integer; AValue: Integer); +begin + DesignedForm.SetPublishedBounds(AIndex, AValue); +end; + +constructor TFakeCustomFrame.Create(AOwner: TComponent; + ANonFormDesigner: INonFormDesigner); +begin + inherited Create(AOwner, ANonFormDesigner); + + //NonFormDesignerOptions := NonFormDesignerOptions - [nfdokSetBounds]; + + Left := inherited Left; + Top := inherited Top; + Width := inherited Width; + Height := inherited Height; +end; + +destructor TFakeCustomFrame.Destroy; +begin + // we need to call "Screen.RemoveForm" to perform + // references back to nil by IDesignedForm to FDesignedForm + inherited Destroy; + if Assigned(FDesignedForm) then + FDesignedForm.Free; +end; + +function TFakeCustomFrame.DockedDesigner: boolean; +begin + Result := True; +end; + +procedure TFakeCustomFrame.SetRealBorderStyle(AVal: TFormBorderStyle); +begin + inherited BorderStyle := AVal; +end; + +procedure TFakeCustomFrame.SetRealBorderIcons(AVal: TBorderIcons); +begin + inherited BorderIcons := AVal; +end; + +procedure TFakeCustomFrame.SetRealFormStyle(AVal: TFormStyle); +begin + inherited FormStyle := AVal; +end; + +procedure TFakeCustomFrame.SetRealPopupMode(AVal: TPopupMode); +begin + inherited PopupMode := AVal; +end; + +procedure TFakeCustomFrame.SetRealPopupParent(AVal: TCustomForm); +begin + inherited PopupParent := AVal; +end; + +function TFakeCustomFrame.GetRealBorderStyle: TFormBorderStyle; +begin + Result := inherited BorderStyle; +end; + +function TFakeCustomFrame.GetRealBorderIcons: TBorderIcons; +begin + Result := inherited BorderIcons; +end; + +function TFakeCustomFrame.GetRealFormStyle: TFormStyle; +begin + Result := inherited FormStyle; +end; + +function TFakeCustomFrame.GetRealPopupMode: TPopupMode; +begin + Result := inherited PopupMode; +end; + +function TFakeCustomFrame.GetRealPopupParent: TCustomForm; +begin + Result := inherited PopupParent; +end; + +procedure TFakeCustomFrame.SetLookupRoot(AValue: TComponent); +begin + inherited SetLookupRoot(AValue); + + if AValue <> nil then + begin + Left := (LookupRoot as TFrame).Left; + Top := (LookupRoot as TFrame).Top; + Width := (LookupRoot as TFrame).Width; + Height := (LookupRoot as TFrame).Height; + + DesignedForm.RealWidth := Width; + DesignedForm.RealHeight := Height; + end + else + TSpartaMainIDE.TryFreeFormData(Self); +end; + +{ TFakeCustomNonControl } + +function TFakeCustomNonControl.GetDesignedForm: TDesignedFormImpl; +begin + if not Assigned(FDesignedForm) then + FDesignedForm := TDesignedNonControlFormImpl.Create(Self); + + Result := FDesignedForm; +end; + +function TFakeCustomNonControl.GetLogicalClientRect: TRect; +begin + Result := DesignedForm.GetLogicalClientRect(inherited GetLogicalClientRect); +end; + +function TFakeCustomNonControl.GetRealBounds(AIndex: Integer): Integer; +begin + Result := inherited GetPublishedBounds(AIndex); +end; + +procedure TFakeCustomNonControl.SetRealBounds(AIndex: Integer; AValue: Integer); +begin + inherited SetPublishedBounds(AIndex, AValue); +end; + +function TFakeCustomNonControl.GetPublishedBounds(AIndex: Integer): Integer; +begin + Result := DesignedForm.GetPublishedBounds(AIndex); +end; + +procedure TFakeCustomNonControl.SetPublishedBounds(AIndex: Integer; AValue: Integer); +begin + DesignedForm.SetPublishedBounds(AIndex, AValue); +end; + +constructor TFakeCustomNonControl.Create(AOwner: TComponent; + ANonFormDesigner: INonFormDesigner); +begin + inherited Create(AOwner, ANonFormDesigner); + + //NonFormDesignerOptions := []; + + Left := inherited Left; + Top := inherited Top; + Width := inherited Width; + Height := inherited Height; +end; + +destructor TFakeCustomNonControl.Destroy; +begin + // we need to call "Screen.RemoveForm" to perform + // references back to nil by IDesignedForm to FDesignedForm + inherited Destroy; + if Assigned(FDesignedForm) then + FDesignedForm.Free; +end; + +function TFakeCustomNonControl.DockedDesigner: boolean; +begin + Result := True; +end; + +procedure TFakeCustomNonControl.SetBounds(ALeft, ATop, AWidth, AHeight: integer + ); +begin + SetDesignerFormBounds(ALeft, ATop, AWidth, AHeight); +end; + +procedure TFakeCustomNonControl.SetRealBorderStyle(AVal: TFormBorderStyle); +begin + inherited BorderStyle := AVal; +end; + +procedure TFakeCustomNonControl.SetRealBorderIcons(AVal: TBorderIcons); +begin + inherited BorderIcons := AVal; +end; + +procedure TFakeCustomNonControl.SetRealFormStyle(AVal: TFormStyle); +begin + inherited FormStyle := AVal; +end; + +procedure TFakeCustomNonControl.SetRealPopupMode(AVal: TPopupMode); +begin + inherited PopupMode := AVal; +end; + +procedure TFakeCustomNonControl.SetRealPopupParent(AVal: TCustomForm); +begin + inherited PopupParent := AVal; +end; + +function TFakeCustomNonControl.GetRealBorderStyle: TFormBorderStyle; +begin + Result := inherited BorderStyle; +end; + +function TFakeCustomNonControl.GetRealBorderIcons: TBorderIcons; +begin + Result := inherited BorderIcons; +end; + +function TFakeCustomNonControl.GetRealFormStyle: TFormStyle; +begin + Result := inherited FormStyle; +end; + +function TFakeCustomNonControl.GetRealPopupMode: TPopupMode; +begin + Result := inherited PopupMode; +end; + +function TFakeCustomNonControl.GetRealPopupParent: TCustomForm; +begin + Result := inherited PopupParent; +end; + +procedure TFakeCustomNonControl.SetLookupRoot(AValue: TComponent); +var + LBounds, LClientRect: TRect; +begin + inherited SetLookupRoot(AValue); + + if AValue <> nil then + begin + if LookupRoot is TDataModule then + begin + Width := (LookupRoot as TDataModule).DesignSize.x; + Height := (LookupRoot as TDataModule).DesignSize.y; + end + else if (LookupRoot <> nil) and (Mediator <> nil) then + begin + Mediator.GetFormBounds(LookupRoot,LBounds,LClientRect); + //WriteLn(Format('Bounds >>> %d %d %d %d',[LBounds.Left,LBounds.Top,LBounds.Right,LBounds.Bottom])); + //WriteLn(Format('Client Rect >>> %d %d %d %d',[LClientRect.Left,LClientRect.Top,LClientRect.Right,LClientRect.Bottom])); + Width := LClientRect.Right; + Height := LClientRect.Bottom; + end else + ;//WriteLn('o kurwa eh'); + + DesignedForm.RealWidth := Width; + DesignedForm.RealHeight := Height; + end + else + TSpartaMainIDE.TryFreeFormData(Self); +end; + +procedure TFakeCustomNonControl.SetMediator(AValue: TDesignerMediator); +var + LBounds, LClientRect: TRect; +begin + inherited SetMediator(AValue); + + if (LookupRoot <> nil) and (Mediator <> nil) then + begin + Mediator.GetFormBounds(LookupRoot,LBounds,LClientRect); + //WriteLn(Format('Bounds >>> %d %d %d %d',[LBounds.Left,LBounds.Top,LBounds.Right,LBounds.Bottom])); + //WriteLn(Format('Client Rect >>> %d %d %d %d',[LClientRect.Left,LClientRect.Top,LClientRect.Right,LClientRect.Bottom])); + Width := LClientRect.Right; + Height := LClientRect.Bottom; + end else + ;//WriteLn('o kurwa eh'); +end; + +{ TFakeCustomForm } + +function TFakeCustomForm.GetDesignedForm: TDesignedFormImpl; +begin + if not Assigned(FDesignedForm) then + FDesignedForm := TDesignedFormImpl.Create(Self); + + Result := FDesignedForm; +end; + +function TFakeCustomForm.GetLogicalClientRect: TRect; +begin + Result := DesignedForm.GetLogicalClientRect(inherited GetLogicalClientRect); +end; + +function TFakeCustomForm.GetRealBounds(AIndex: Integer): Integer; +begin + case AIndex of + 0: Result := inherited Left; + 1: Result := inherited Top; + 2: Result := inherited Width; + 3: Result := inherited Height; + end; +end; + +procedure TFakeCustomForm.SetRealBounds(AIndex: Integer; AValue: Integer); +begin + case AIndex of + 0: inherited Left := AValue; + 1: inherited Top := AValue; + 2: inherited Width := AValue; + 3: inherited Height := AValue; + end; +end; + +function TFakeCustomForm.GetPublishedBounds(AIndex: Integer): Integer; +begin + Result := DesignedForm.GetPublishedBounds(AIndex); +end; + +procedure TFakeCustomForm.SetPublishedBounds(AIndex: Integer; AValue: Integer); +begin + case AIndex of + 0, 1: DesignedForm.SetPublishedBounds(AIndex, AValue); + 2, 3: + begin + DesignedForm.SetPublishedBounds(AIndex, AValue); + SetRealBounds(AIndex, DesignedForm.GetPublishedBounds(AIndex)); + end; + end; +end; + +constructor TFakeCustomForm.CreateNew(AOwner: TComponent; Num: Integer); +begin + inherited CreateNew(AOwner, Num); + + Left := inherited Left; + Top := inherited Top; + Width := inherited Width; + Height := inherited Height; +end; + +destructor TFakeCustomForm.Destroy; +begin + // we need to call "Screen.RemoveForm" to perform + // references back to nil by IDesignedForm to FDesignedForm + inherited Destroy; + if Assigned(FDesignedForm) then + FDesignedForm.Free; +end; + +procedure TFakeCustomForm.SetRealBorderStyle(AVal: TFormBorderStyle); +begin + inherited BorderStyle := AVal; +end; + +procedure TFakeCustomForm.SetRealBorderIcons(AVal: TBorderIcons); +begin + inherited BorderIcons := AVal; +end; + +procedure TFakeCustomForm.SetRealFormStyle(AVal: TFormStyle); +begin + inherited FormStyle := AVal; +end; + +procedure TFakeCustomForm.SetRealPopupMode(AVal: TPopupMode); +begin + inherited PopupMode := AVal; +end; + +procedure TFakeCustomForm.SetRealPopupParent(AVal: TCustomForm); +begin + inherited PopupParent := AVal; +end; + +function TFakeCustomForm.GetRealBorderStyle: TFormBorderStyle; +begin + Result := inherited BorderStyle; +end; + +function TFakeCustomForm.GetRealBorderIcons: TBorderIcons; +begin + Result := inherited BorderIcons; +end; + +function TFakeCustomForm.GetRealFormStyle: TFormStyle; +begin + Result := inherited FormStyle; +end; + +function TFakeCustomForm.GetRealPopupMode: TPopupMode; +begin + Result := inherited PopupMode; +end; + +function TFakeCustomForm.GetRealPopupParent: TCustomForm; +begin + Result := inherited PopupParent; +end; + + +{ TDesignedFormImpl } + +function TDesignedFormImpl.GetPublishedBounds(AIndex: Integer): Integer; +begin + case AIndex of + 0: Result := FHackLeft; + 1: Result := FHackTop; + 2: Result := FHackWidth; + 3: Result := FHackHeight; + end; +end; + +procedure TDesignedFormImpl.SetPublishedBounds(AIndex: Integer; AValue: Integer); +begin + if AIndex = 2 then + if AValue < 135 then + AValue := 135; + + if AIndex in [2, 3] then + if AValue > 4096 then + AValue := 4096; + + case AIndex of + 0: FHackLeft := AValue; + 1: FHackTop := AValue; + 2: FHackWidth := AValue; + 3: FHackHeight := AValue; + end; + DoChangeHackedBounds; +end; + +{----------------------------------------------- + Real values inherited for design form +{----------------------------------------------} + +function TDesignedFormImpl.GetRealBounds(AIndex: Integer): Integer; +begin + Result := FDesignedRealForm.GetRealBounds(AIndex); +end; + +procedure TDesignedFormImpl.SetRealBounds(AIndex: Integer; AValue: Integer); +begin + FDesignedRealForm.SetRealBounds(AIndex, AValue); +end; + +procedure TDesignedFormImpl.SetRealBorderStyle(AVal: TFormBorderStyle); +begin + FDesignedRealForm.SetRealBorderStyle(AVal); +end; + +procedure TDesignedFormImpl.SetRealBorderIcons(AVal: TBorderIcons); +begin + FDesignedRealForm.SetRealBorderIcons(AVal); +end; + +procedure TDesignedFormImpl.SetRealFormStyle(AVal: TFormStyle); +begin + FDesignedRealForm.SetRealFormStyle(AVal); +end; + +procedure TDesignedFormImpl.SetRealPopupMode(AVal: TPopupMode); +begin + FDesignedRealForm.SetRealPopupMode(AVal); +end; + +procedure TDesignedFormImpl.SetRealPopupParent(AVal: TCustomForm); +begin + FDesignedRealForm.SetRealPopupParent(AVal); +end; + +function TDesignedFormImpl.GetRealBorderStyle: TFormBorderStyle; +begin + Result := FDesignedRealForm.GetRealBorderStyle; +end; + +function TDesignedFormImpl.GetRealBorderIcons: TBorderIcons; +begin + Result := FDesignedRealForm.GetRealBorderIcons; +end; + +function TDesignedFormImpl.GetRealFormStyle: TFormStyle; +begin + Result := FDesignedRealForm.GetRealFormStyle; +end; + +function TDesignedFormImpl.GetRealPopupMode: TPopupMode; +begin + Result := FDesignedRealForm.GetRealPopupMode; +end; + +function TDesignedFormImpl.GetRealPopupParent: TCustomForm; +begin + Result := FDesignedRealForm.GetRealPopupParent; +end; + +////// + +function TDesignedFormImpl.GetLastActiveSourceWindow: TSourceEditorWindowInterface; +begin + Result := FLastActiveSourceWindow; +end; + +procedure TDesignedFormImpl.SetLastActiveSourceWindow( + AValue: TSourceEditorWindowInterface); +begin + FLastActiveSourceWindow := AValue; +end; + +function TDesignedFormImpl.GetForm: TCustomForm; +begin + Result := FOwner; +end; + +function TDesignedFormImpl.GetUpdate: Boolean; +begin + Result := FUpdate; +end; + +function TDesignedFormImpl.GetOnChangeHackedBounds: TNotifyEvent; +begin + Result := FOnChangeHackedBounds; +end; + +function TDesignedFormImpl.PositionDelta: TPoint; + + procedure FormBorderDelta; + var + LTestCtrl: TWinControl; + LTestRec, LFormRect: TRect; + LForm: TCustomForm; + begin + LForm := GetForm; + LTestCtrl := TWinControl.Create(Self); + try + LTestCtrl.Parent := LForm; + LTestCtrl.Left := 0; + LTestCtrl.Top := 0; + + GetWindowRect(LForm.Handle, LFormRect); + GetWindowRect(LTestCtrl.Handle, LTestRec); + + Result.x := Result.x + Max(LTestRec.Left - LFormRect.Left, 0); + Result.y := Result.y + Max(LTestRec.Top - LFormRect.Top, 0); + finally + LTestCtrl.free; + end; + end; + + procedure MainMenuDelta; + var + LForm: TCustomForm; + begin + LForm := GetForm; + if LForm.Menu <> nil then + if LForm.Menu.Items.Count>0 then + Result.y := Result.y - LCLIntf.GetSystemMetrics(SM_CYMENU); + end; + +begin + Result := Point(0, 0); + {$IFDEF WINDOWS} + FormBorderDelta; + MainMenuDelta; + {$ENDIF} +end; + +procedure TDesignedFormImpl.SetOnChangeHackedBounds(const AValue: TNotifyEvent); +begin + FOnChangeHackedBounds := AValue; +end; + +/////// positions + +procedure TDesignedFormImpl.SetHorzScrollPosition(AValue: Integer); +begin + RealLeft := -PositionDelta.x - AValue; +end; + +procedure TDesignedFormImpl.SetVertScrollPosition(AValue: Integer); +begin + RealTop := -PositionDelta.y - AValue; +end; + +function TDesignedFormImpl.GetHorzScrollPosition: Integer; +begin + Result := -(RealLeft + PositionDelta.x); +end; + +function TDesignedFormImpl.GetVertScrollPosition: Integer; +begin + Result := -(RealTop + PositionDelta.y); +end; + +procedure TDesignedFormImpl.BeginUpdate; +begin + TFormHack(FOwner).SetDesigning(False, False); + FUpdate := True; +end; + +procedure TDesignedFormImpl.EndUpdate(AModified: Boolean); +begin + TFormHack(FOwner).SetDesigning(True, False); + FUpdate := False; + if AModified and (FormEditingHook <> nil) then + if (FormEditingHook.GetCurrentDesigner = FOwner.Designer) and (FormEditingHook.GetCurrentObjectInspector <> nil) then + FormEditingHook.GetCurrentObjectInspector.RefreshPropertyValues; +end; + +procedure TDesignedFormImpl.ShowWindow; +begin +{$IFDEF USE_POPUP_PARENT_DESIGNER} + LCLIntf.ShowWindow(FOwner.Handle, SW_SHOW); +{$ELSE} + if FOwner.ParentWindow = 0 then + LCLIntf.ShowWindow(FOwner.Handle, SW_SHOW); +{$ENDIF} +end; + +procedure TDesignedFormImpl.HideWindow; +begin +{$IFDEF USE_POPUP_PARENT_DESIGNER} + LCLIntf.ShowWindow(FOwner.Handle, SW_HIDE); +{$ELSE} + if FOwner.ParentWindow = 0 then + LCLIntf.ShowWindow(FOwner.Handle, SW_HIDE); +{$ENDIF} +end; + +function TDesignedFormImpl.QueryInterface(constref IID: TGUID; out Obj + ): HResult; +begin + Result := inherited QueryInterface(IID, Obj); + if Result <> S_OK then + Result := TFormHack(FOwner).QueryInterface(IID, Obj); +end; + +procedure TDesignedFormImpl.DoChangeHackedBounds; +begin + if not FUpdate and Assigned(FOnChangeHackedBounds) then + FOnChangeHackedBounds(FOwner); +end; + +function TDesignedFormImpl.GetLogicalClientRect(ALogicalClientRect: TRect): TRect; +var + i: Integer; +begin + Result:=ALogicalClientRect; + + Result.Right := Width; + if (FOwner.Menu <> nil) and (FOwner.Menu.Items.Count <> 0) then + begin + for i := 0 to FOwner.Menu.Items.Count - 1 do + if FOwner.Menu.Items[i].Visible then + begin + Result.Bottom:= Height - LCLIntf.GetSystemMetrics(SM_CYMENU); + Exit; + end; + end; + + Result.Bottom:= Height; +end; + +constructor TDesignedFormImpl.Create(AOwner: TForm); +begin + FOwner := AOwner; + FDesignedRealForm := FOwner as IDesignedRealForm; +end; + +end. + diff --git a/components/sparta/dockedformeditor/source/sparta_fakeform.pas b/components/sparta/dockedformeditor/source/sparta_fakeform.pas new file mode 100644 index 0000000000..4eb95befa7 --- /dev/null +++ b/components/sparta/dockedformeditor/source/sparta_fakeform.pas @@ -0,0 +1,215 @@ +{ + ***************************************************************************** + See the file COPYING.modifiedLGPL.txt, included in this distribution, + for details about the license. + ***************************************************************************** + + Author: Maciej Izak + + DaThoX 2004-2015 + FreeSparta.com +} + +unit sparta_FakeForm; + +{$mode delphi}{$H+} + +interface + +uses + Classes, SysUtils, Forms, Controls, TypInfo, LCLIntf, + LCLType, sparta_DesignedForm, sparta_FakeCustom; + + +const + BorderStylesAllowAutoScroll = [bsSizeable, bsSizeToolWin]; + +type + { TFakeForm } + + TFakeForm = class(TFakeCustomForm, IDesignedFakeForm) + private + FHackVisible: Boolean; + FHackAutoScroll: Boolean; + FHackBorderStyle: TFormBorderStyle; + FHackBorderIcons: TBorderIcons; + FHackFormStyle: TFormStyle; + + FPopupMode: TPopupMode; + FPopupParent: TCustomForm; + + FHorzScrollBar: TControlScrollBar; + FVertScrollBar: TControlScrollBar; + + FControlForHackedConstraints: TControl; + FHackConstraints: TSizeConstraints; + + function IsAutoScrollStored: Boolean; + procedure SetHorzScrollBar(AValue: TControlScrollBar); + procedure SetVertScrollBar(AValue: TControlScrollBar); + procedure SetPopupMode(const AValue: TPopupMode); + procedure SetPopupParent(const AValue: TCustomForm); + + procedure SetFormBorderStyle(ANewStyle: TFormBorderStyle); + procedure SetBorderIcons(AVal: TBorderIcons); + procedure SetFormStyle(AValue : TFormStyle); + procedure SetCaption(const AValue: string); + function GetBorderStyle: TFormBorderStyle; + function GetBorderIcons: TBorderIcons; + function GetFormStyle: TFormStyle; + function GetCaption: string; + public + property RealPopupMode: TPopupMode read GetRealPopupMode write SetRealPopupMode; + property RealPopupParent: TCustomForm read GetRealPopupParent write SetRealPopupParent; + + constructor CreateNew(AOwner: TComponent; Num: Integer = 0); override; + destructor Destroy; override; + published + property AutoScroll: Boolean read FHackAutoScroll write FHackAutoScroll stored IsAutoScrollStored default False; + property BorderIcons: TBorderIcons read GetBorderIcons write SetBorderIcons default [biSystemMenu, biMinimize, biMaximize]; + property BorderStyle: TFormBorderStyle read GetBorderStyle write SetFormBorderStyle default bsSizeable; + property FormStyle: TFormStyle read GetFormStyle write SetFormStyle default fsNormal; + + property PopupMode: TPopupMode read FPopupMode write SetPopupMode default pmNone; + property PopupParent: TCustomForm read FPopupParent write SetPopupParent; + + property HorzScrollBar: TControlScrollBar read FHorzScrollBar write SetHorzScrollBar; + property VertScrollBar: TControlScrollBar read FVertScrollBar write SetVertScrollBar; + + property Constraints: TSizeConstraints read FHackConstraints write FHackConstraints; + property Caption: string read GetCaption write SetCaption; + property Visible: boolean read FHackVisible write FHackVisible; + end; + +implementation + +{ TFakeForm } + +procedure TFakeForm.SetHorzScrollBar(AValue: TControlScrollBar); +begin + FHorzScrollBar.Assign(AValue); +end; + +function TFakeForm.IsAutoScrollStored: Boolean; +begin + Result := BorderStyle in BorderStylesAllowAutoScroll; +end; + +procedure TFakeForm.SetFormBorderStyle(ANewStyle: TFormBorderStyle); +begin + if FHackBorderStyle = ANewStyle then exit; + + if not (ANewStyle in BorderStylesAllowAutoScroll) then + AutoScroll := False; + + FHackBorderStyle := ANewStyle; +end; + +procedure TFakeForm.SetBorderIcons(AVal: TBorderIcons); +begin + FHackBorderIcons := AVal; +end; + +procedure TFakeForm.SetFormStyle(AValue: TFormStyle); +var + LHackFormStyle: TFormStyle; +Begin + if FHackFormStyle = AValue then + exit; + + LHackFormStyle := FHackFormStyle; + FHackFormStyle := AValue; + + if FHackFormStyle = fsSplash then + BorderStyle := bsNone + else + if LHackFormStyle = fsSplash then + BorderStyle := bsSizeable; +end; + +procedure TFakeForm.SetCaption(const AValue: string); +begin + inherited Caption := AValue; +end; + +procedure TFakeForm.SetPopupMode(const AValue: TPopupMode); +begin + if FPopupMode <> AValue then + begin + FPopupMode := AValue; + if FPopupMode = pmAuto then + PopupParent := nil; + end; +end; + +procedure TFakeForm.SetPopupParent(const AValue: TCustomForm); +begin + if FPopupParent <> AValue then + begin + if FPopupParent <> nil then + FPopupParent.RemoveFreeNotification(Self); + FPopupParent := AValue; + if FPopupParent <> nil then + begin + FPopupParent.FreeNotification(Self); + FPopupMode := pmExplicit; + end; + end; +end; + + +function TFakeForm.GetBorderStyle: TFormBorderStyle; +begin + Result := FHackBorderStyle; +end; + +function TFakeForm.GetBorderIcons: TBorderIcons; +begin + Result := FHackBorderIcons; +end; + +function TFakeForm.GetFormStyle: TFormStyle; +begin + Result := FHackFormStyle; +end; + +function TFakeForm.GetCaption: string; +begin + Result := inherited Caption; +end; + +procedure TFakeForm.SetVertScrollBar(AValue: TControlScrollBar); +begin + FVertScrollBar.Assign(AValue); +end; + +constructor TFakeForm.CreateNew(AOwner: TComponent; Num: Integer); +begin + inherited CreateNew(AOwner, Num); + + FHorzScrollBar := TControlScrollBar.Create(Self, sbHorizontal); + FVertScrollBar := TControlScrollBar.Create(Self, sbVertical); + + BorderIcons := inherited BorderIcons; + BorderStyle := inherited BorderStyle; + FormStyle := inherited FormStyle; + + PopupMode := inherited PopupMode; + + FControlForHackedConstraints := TControl.Create(nil); + FHackConstraints := TSizeConstraints.Create(FControlForHackedConstraints); +end; + +destructor TFakeForm.Destroy; +begin + FHorzScrollBar.Free; + FVertScrollBar.Free; + + FHackConstraints.Free; + FControlForHackedConstraints.Free; + + inherited Destroy; +end; + +end. + diff --git a/components/sparta/dockedformeditor/source/sparta_fakeframe.pas b/components/sparta/dockedformeditor/source/sparta_fakeframe.pas new file mode 100644 index 0000000000..66a32094dc --- /dev/null +++ b/components/sparta/dockedformeditor/source/sparta_fakeframe.pas @@ -0,0 +1,29 @@ +{ + ***************************************************************************** + See the file COPYING.modifiedLGPL.txt, included in this distribution, + for details about the license. + ***************************************************************************** + + Author: Maciej Izak + + DaThoX 2004-2015 + FreeSparta.com +} + +unit sparta_FakeFrame; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, sparta_FakeCustom; + +type + TFakeFrame = class(TFakeCustomFrame) + end; + +implementation + +end. + diff --git a/components/sparta/dockedformeditor/source/sparta_fakenoncontrol.pas b/components/sparta/dockedformeditor/source/sparta_fakenoncontrol.pas new file mode 100644 index 0000000000..ee48e86329 --- /dev/null +++ b/components/sparta/dockedformeditor/source/sparta_fakenoncontrol.pas @@ -0,0 +1,29 @@ +{ + ***************************************************************************** + See the file COPYING.modifiedLGPL.txt, included in this distribution, + for details about the license. + ***************************************************************************** + + Author: Maciej Izak + + DaThoX 2004-2015 + FreeSparta.com +} + +unit sparta_FakeNonControl; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, sparta_FakeCustom; + +type + TFakeNonControl = class(TFakeCustomNonControl) + end; + +implementation + +end. + diff --git a/components/sparta/dockedformeditor/source/sparta_hashutils.pas b/components/sparta/dockedformeditor/source/sparta_hashutils.pas new file mode 100644 index 0000000000..d6d8f228ed --- /dev/null +++ b/components/sparta/dockedformeditor/source/sparta_hashutils.pas @@ -0,0 +1,30 @@ +unit sparta_HashUtils; + +{$mode delphi}{$H+} + +interface + +uses + Classes, SysUtils; + +{$IFNDEF USE_GENERICS_COLLECTIONS} +type + THash_TObject = record + class function Hash(A: TObject; B: SizeUInt): SizeUInt; static; + end; +{$ENDIF} + +implementation + +{$IFNDEF USE_GENERICS_COLLECTIONS} +class function THash_TObject.Hash(A: TObject; B: SizeUInt): SizeUInt; +begin + if A = nil then + Exit($2A and (b - 1)); + + Result := A.GetHashCode() and (b - 1); +end; +{$ENDIF} + +end. + diff --git a/components/sparta/dockedformeditor/source/sparta_mainide.pas b/components/sparta/dockedformeditor/source/sparta_mainide.pas new file mode 100644 index 0000000000..516dc44673 --- /dev/null +++ b/components/sparta/dockedformeditor/source/sparta_mainide.pas @@ -0,0 +1,1713 @@ +{ + ***************************************************************************** + See the file COPYING.modifiedLGPL.txt, included in this distribution, + for details about the license. + ***************************************************************************** + + Author: Maciej Izak + + DaThoX 2004-2015 + FreeSparta.com +} + +unit sparta_MainIDE; + +{$mode delphi}{$H+} +{$IFDEF USE_POPUP_PARENT_DESIGNER} +{$IFNDEF WINDOWS} +{$MESSAGE Error 'USE_POPUP_PARENT_DESIGNER mode can be used only on Windows'} +{$ENDIF} +{$ELSE} +{.$DEFINE POPUP_WINDOWS} +{$ENDIF} + +interface + +uses + Classes, SysUtils, SrcEditorIntf, LazIDEIntf, ComCtrls, Controls, Forms, {$IFDEF USE_POPUP_PARENT_DESIGNER}Windows,{$ENDIF} IDEImagesIntf, + Buttons, ExtCtrls, Graphics, IDEWindowIntf, + sparta_DesignedForm, sparta_resizer, PropEdits, PropEditUtils, FormEditingIntf, ComponentEditors, EditBtn, +{$IFDEF USE_GENERICS_COLLECTIONS} + Generics.Collections, Generics.Defaults, +{$ELSE} + ghashmap, sparta_HashUtils, gvector, +{$ENDIF} + TypInfo, LCLIntf, LCLType, LMessages, sparta_FakeForm, sparta_FakeFrame, SpartaAPI; + +const + WM_SETNOFRAME = WM_USER; + WM_BoundToDesignTabSheet = WM_USER + 1; + +type + { TDesignFormData } + +{$IFDEF USE_GENERICS_COLLECTIONS} + TDesignFormData = class(TSingletonImplementation, IDesignedForm) +{$ELSE} + TDesignFormData = class(TComponent, IDesignedForm) +{$ENDIF} + private + FWndMethod: TWndMethod; + +{$IFDEF USE_POPUP_PARENT_DESIGNER} + FWinD: Integer; +{$ENDIF} + + FForm: IDesignedForm; + FLastScreenshot: TBitmap; + FPopupParent: TSourceEditorWindowInterface; + FHiding: boolean; +{$IFDEF USE_GENERICS_COLLECTIONS} + FFormImages: TList; +{$ELSE} + FFormImages: TList; +{$ENDIF} + protected + procedure WndMethod(var TheMessage: TLMessage); + + procedure SetPopupParent(AVal: TSourceEditorWindowInterface); + procedure DoAddForm; + public +{$IFDEF USE_GENERICS_COLLECTIONS} + class var AddFormEvents: TList; +{$ELSE} + class var AddFormEvents: TVector; +{$ENDIF} + + class constructor Init; + class destructor Finit; + + procedure AddFormImage(AImage: TImage); + procedure RemoveFormImage(AImage: TImage); + procedure RepaintFormImages; + + property Form: IDesignedForm read FForm implements IDesignedForm; + property LastScreenshot: TBitmap read FLastScreenshot; + property PopupParent: TSourceEditorWindowInterface read FPopupParent write SetPopupParent; + + constructor Create(AForm: TCustomForm); + destructor Destroy; override; + end; + + { TModulePageControl } + + TModulePageControl = class(TPageControl) + private + FResizer: TResizer; + FDesignFormData: TDesignFormData; + protected + procedure SetDesignFormData(const AValue: TDesignFormData); virtual; + public + destructor Destroy; override; + + procedure ShowDesignPage; + procedure HideDesignPage; + + property Resizer: TResizer read FResizer; + + property DesignFormData: TDesignFormData read FDesignFormData write SetDesignFormData; + + procedure BoundToDesignTabSheet; + end; + + { TSourceEditorWindowData } + + TSourceEditorWindowData = class + private + FActiveDesignFormData: TDesignFormData; + private + FWndMethod: TWndMethod; + FForm: TSourceEditorWindowInterface; +{$IFDEF USE_GENERICS_COLLECTIONS} + FPageCtrlList: TDictionary; +{$ELSE} + FPageCtrlList: THashmap; +{$ENDIF} + FLastTopParent: TControl; + + procedure SetActiveDesignFormData(const AValue: TDesignFormData); + protected + procedure WndMethod(var TheMessage: TLMessage); + constructor Create(AForm: TSourceEditorWindowInterface); + destructor Destroy; override; + procedure OnChangeBounds(Sender: TObject); + procedure AddPageCtrl(ASrcEditor: TSourceEditorInterface; APage: TModulePageControl); + procedure RemovePageCtrl(ASrcEditor: TSourceEditorInterface); + public + property ActiveDesignFormData: TDesignFormData read FActiveDesignFormData write SetActiveDesignFormData; + end; + + { TDTXTabMaster } + + TDTXTabMaster = class(TIDETabMaster) + protected + function GetTabDisplayState: TTabDisplayState; override; + function GetTabDisplayStateEditor(Index: TSourceEditorInterface): TTabDisplayState; override; + public + procedure ToggleFormUnit; override; + procedure JumpToCompilerMessage(ASourceEditor: TSourceEditorInterface); override; + + procedure ShowCode(ASourceEditor: TSourceEditorInterface); override; + procedure ShowDesigner(ASourceEditor: TSourceEditorInterface; AIndex: Integer = 0); override; + procedure ShowForm(AForm: TCustomForm); override; + end; + + { TDTXComponentsMaster } + + TDTXComponentsMaster = class(TIDEComponentsMaster) + function DrawNonVisualComponents(ALookupRoot: TComponent): Boolean; override; + end; + + TFormHack = class(TCustomForm); + + { TSpartaMainIDE } + + TSpartaMainIDE = class(TObject) + public + class procedure TryFreeFormData(Form: TCustomForm); + + class procedure Screen_FormAdded(Sender: TObject; Form: TCustomForm); + class procedure Screen_FormDel(Sender: TObject; Form: TCustomForm); + + class procedure WindowCreate(Sender: TObject); + class procedure WindowDestroy(Sender: TObject); + class procedure WindowShow(Sender: TObject); + class procedure WindowHide(Sender: TObject); + + class procedure EditorActivated(Sender: TObject); + class procedure EditorDestroyed(Sender: TObject); + class procedure EditorCreate(Sender: TObject); + + class procedure TabChange(Sender: TObject); + + class procedure GlobalOnChangeBounds(Sender: TObject); + class procedure GlobalSNOnChangeBounds(Sender: TObject); +{$IFDEF USE_POPUP_PARENT_DESIGNER} + class procedure OnBeforeClose(Sender: TObject); +{$ENDIF} + class procedure OnShowDesignerForm(Sender: TObject; AEditor: TSourceEditorInterface; + AComponentPaletteClassSelected: Boolean); + class procedure OnShowSrcEditor(Sender: TObject); + + class procedure OnShowMethod(const Name: String); + class procedure OnDesignRefreshPropertyValues; + end; + +var + Forms: Classes.TList; // normal forms + dsgForms: Classes.TList; // design forms +{$IFDEF USE_GENERICS_COLLECTIONS} + SourceEditorWindows: TObjectDictionary; +{$ELSE} + SourceEditorWindows: THashmap; +{$ENDIF} + + LastActiveSourceEditorWindow: TSourceEditorWindowInterface = nil; + LastActiveSourceEditor: TSourceEditorInterface = nil; + + BoundInitialized: Boolean; +{$IFDEF USE_POPUP_PARENT_DESIGNER} + isIdeDestroyed: boolean = False; +{$ENDIF} + +function FindModulePageControl(AForm: TSourceEditorWindowInterface): TModulePageControl; overload; +function FindSourceEditorForDesigner(ADesigner: TIDesigner): TSourceEditorInterface; + +implementation + +// FUTURE USE +// +//function FindDesignForm(ADesigner: TIDesigner): TCustomForm; +//var +// f: TDesignFormData; +//begin +// for Pointer(f) in dsgForms do +// with f as IDesignedForm do +// if Form.Designer = ADesigner then +// Exit(Form); +// +// Result := nil; +//end; +// +//function FindDesignFormData(AForm: TSourceEditorWindowInterface): TDesignFormData; overload; +//begin +// Result := FindDesignFormData( +// FindModulePageControl(AForm) +// ); +//end; +// +//procedure HideAllForms; +//var +// f: TDesignFormData; +//begin +// for Pointer(f) in dsgForms do +// ShowWindow(f.Form.Form.Handle, SW_HIDE); +//end; + +function FindModulePageControl(ASourceEditor: TSourceEditorInterface): TModulePageControl; overload; +var + LParent: TWinControl; +begin + if ASourceEditor = nil then + Exit(nil); + + LParent := ASourceEditor.EditorControl.Parent; + while LParent <> nil do + begin + if LParent is TModulePageControl then + Exit(TModulePageControl(LParent)); + LParent := LParent.Parent; + end; + + Result := nil; +end; + +function FindModulePageControl(AForm: TSourceEditorWindowInterface): TModulePageControl; overload; +begin + Result := FindModulePageControl(AForm.ActiveEditor); +end; + +function AbsoluteFindModulePageControl(ASrcEditor: TSourceEditorInterface): TModulePageControl; +var + LSEWD: TSourceEditorWindowData; +{$IFNDEF USE_GENERICS_COLLECTIONS} + LIterator: THashmap.TIterator; +{$ENDIF} +begin + Result := nil; +{$IFDEF USE_GENERICS_COLLECTIONS} + for LSEWD in SourceEditorWindows.Values do + if LSEWD.FPageCtrlList.ContainsKey(ASrcEditor) then + Exit(LSEWD.FPageCtrlList[ASrcEditor]); +{$ELSE} + LIterator := SourceEditorWindows.Iterator; + if LIterator <> nil then + try + repeat + LSEWD := LIterator.Value; + if LSEWD.FPageCtrlList.contains(ASrcEditor) then + Exit(LSEWD.FPageCtrlList[ASrcEditor]); + until not LIterator.next; + finally + LIterator.Free; + end; +{$ENDIF} + +end; + +function FindSourceEditorForDesigner(ADesigner: TIDesigner): TSourceEditorInterface; +var + i: Integer; +begin + for i := 0 to SourceEditorManagerIntf.SourceEditorCount - 1 do + if SourceEditorManagerIntf.SourceEditors[i].GetDesigner(False) = ADesigner then + Exit(SourceEditorManagerIntf.SourceEditors[i]); + Result := nil; +end; + +function FindDesignFormData(ADesigner: TIDesigner): TDesignFormData; overload; +var + p: Pointer; + f: TDesignFormData absolute p; + fi: IDesignedForm = nil; +begin + Result := nil; + + if ADesigner = nil then + Exit; + + for p in dsgForms do + begin + fi := f.FForm; + with fi do + begin + if (Form.Designer = ADesigner) then + begin + Exit(f); + end; + end; + end; +end; + +procedure RefreshAllSourceWindowsModulePageControl; +var + LWindow: TSourceEditorWindowInterface; + LPageCtrl: TModulePageControl; +{$IFNDEF USE_GENERICS_COLLECTIONS} + LIterator: THashmap.TIterator; +{$ENDIF} +begin +{$IFDEF USE_GENERICS_COLLECTIONS} + for LWindow in SourceEditorWindows.Keys do + begin + LPageCtrl := FindModulePageControl(LWindow); + + // for example LPageCtrl is nil when we clone module to new window + if (LPageCtrl = nil) or (csDestroying in LWindow.ComponentState) then + Continue; + + if LWindow.ActiveEditor = nil then + LPageCtrl.HideDesignPage + else + if LWindow.ActiveEditor.GetDesigner(True) <> nil then + // TODO some check function: is displayed right form? + LPageCtrl.ShowDesignPage + else + LPageCtrl.HideDesignPage; + end; +{$ELSE} + LIterator := SourceEditorWindows.Iterator; + if LIterator <> nil then + try + repeat + LWindow := LIterator.Key; + + LPageCtrl := FindModulePageControl(LWindow); + + // for example LPageCtrl is nil when we clone module to new window + if (LPageCtrl = nil) or (csDestroying in LWindow.ComponentState) then + Continue; + + if LWindow.ActiveEditor = nil then + LPageCtrl.HideDesignPage + else + if LWindow.ActiveEditor.GetDesigner(True) <> nil then + // TODO some check function: is displayed right form? + LPageCtrl.ShowDesignPage + else + LPageCtrl.HideDesignPage; + until not LIterator.next; + finally + LIterator.Free; + end; +{$ENDIF} +end; + +// sometimes at some level of initialization form can not contain TIDesigner +// (during ide run and when is oppened default project with some TForm1) +function FindDesignFormData(AForm: TCustomForm): TDesignFormData; overload; +var + f: TDesignFormData; +begin + Result := nil; + + if AForm = nil then + Exit; + + for Pointer(f) in dsgForms do + with f as IDesignedForm do + if (Form = AForm) then + Exit(f); +end; + +function FindDesignFormData(AModulePageCtrl: TModulePageControl): TDesignFormData; overload; +var + LSourceWindow: TSourceEditorWindowInterface; + LSourceEditor: TSourceEditorInterface; +{$IFNDEF USE_GENERICS_COLLECTIONS} + LIterator: THashmap.TIterator; +{$ENDIF} +begin + Result := nil; + + if AModulePageCtrl = nil then + Exit; + +{$IFDEF USE_GENERICS_COLLECTIONS} + for LSourceWindow in SourceEditorWindows.Keys do + begin + if AModulePageCtrl.Owner = LSourceWindow then + begin + LSourceEditor := LSourceWindow.ActiveEditor; + if LSourceEditor = nil then + Exit; + + Result := FindDesignFormData(LSourceEditor.GetDesigner(True)); + + Exit; + end; + end; +{$ELSE} + LIterator := SourceEditorWindows.Iterator; + if LIterator <> nil then + try + repeat + LSourceWindow := LIterator.Key; + + if AModulePageCtrl.Owner = LSourceWindow then + begin + LSourceEditor := LSourceWindow.ActiveEditor; + if LSourceEditor = nil then + Exit; + + Result := FindDesignFormData(LSourceEditor.GetDesigner(True)); + + Exit; + end; + until not LIterator.next; + finally + LIterator.Free; + end; +{$ENDIF} +end; + +{ TDesignFormData } + +procedure TDesignFormData.WndMethod(var TheMessage: TLMessage); + + // Without this button F12 don't work. (after creating new for editor is inactive) :< + procedure FixF12_ActiveEditor; + var + i: Integer; + begin + SourceEditorManagerIntf.ActiveEditor := nil; + for i := 0 to SourceEditorManagerIntf.UniqueSourceEditorCount - 1 do + if Form.Form.Designer = SourceEditorManagerIntf.UniqueSourceEditors[i].GetDesigner(True) then + begin + SourceEditorManagerIntf.ActiveEditor := SourceEditorManagerIntf.UniqueSourceEditors[i]; + Break; + end; + end; + +begin +{$IFDEF USE_POPUP_PARENT_DESIGNER} + if isIdeDestroyed then + FWinD:=-1; + + if FWinD <> -1 then + if (TheMessage.msg = WM_ERASEBKGND) + and (not IsWindowVisible(TCustomForm(LazarusIDE.GetMainBar).Handle)) then + begin + if Form.LastActiveSourceWindow <> nil then + begin + if Form.LastActiveSourceWindow.ActiveEditor.GetDesigner(True) = Form.Form.Designer then + begin + LPageCtrl := FindModulePageControl(Form.LastActiveSourceWindow.ActiveEditor); + if LPageCtrl.PageIndex = 1 then + begin + LPageCtrl.PageIndex := 0; + end; + end; + end; + end; +{$ENDIF} + + if TheMessage.msg = WM_SETNOFRAME then + begin + ShowWindow(Form.Form.Handle, SW_HIDE); + FHiding := False; + + FixF12_ActiveEditor; + + if Form.Form is TFakeForm then + RepaintFormImages; + end; + + // 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); + + // we need to correct ActiveEditor to right form + // this code works correctly on Windows platform + // (is necessery for selecting controls after form resizing). + // in Linux platforms below code brings problems with QT (inactive form) + {$IFDEF WINDOWS} + case TheMessage.msg of + LM_LBUTTONDOWN, LM_RBUTTONDOWN, LM_MBUTTONDOWN, LM_XBUTTONDOWN: + if Form.LastActiveSourceWindow <> nil then + begin + SourceEditorManagerIntf.ActiveSourceWindow := Form.LastActiveSourceWindow; + SourceEditorManagerIntf.ActiveEditor := Form.LastActiveSourceWindow.ActiveEditor; + end; + end; + {$ENDIF} + + FWndMethod(TheMessage); +end; + +procedure TDesignFormData.SetPopupParent(AVal: TSourceEditorWindowInterface); +begin + FPopupParent := AVal; + Form.RealPopupParent := FPopupParent; +end; + +class constructor TDesignFormData.Init; +begin +{$IFDEF USE_GENERICS_COLLECTIONS} + AddFormEvents := TList.Create; +{$ELSE} + AddFormEvents := TVector.Create; +{$ENDIF} +end; + +class destructor TDesignFormData.Finit; +begin + AddFormEvents.Free; +end; + +procedure TDesignFormData.AddFormImage(AImage: TImage); +begin + if FFormImages <> nil then + FFormImages.Add(AImage); +end; + +procedure TDesignFormData.RemoveFormImage(AImage: TImage); +begin + if FFormImages <> nil then + FFormImages.Remove(AImage); +end; + +procedure TDesignFormData.RepaintFormImages; +var + LImage: TImage; +begin + if FFormImages <> nil then + begin + for LImage in FFormImages do + LImage.OnResize(LImage); + end; +end; + +procedure TDesignFormData.DoAddForm; +var +{$IFDEF USE_GENERICS_COLLECTIONS} + ne: TNotifyEvent; +{$ELSE} + i: Integer; +{$ENDIF} +begin +{$IFDEF USE_GENERICS_COLLECTIONS} + for ne in AddFormEvents do + ne(Self); +{$ELSE} + if AddFormEvents.Size > 0 then // Arithmetic overflow without a test. Size = unsigned. + for i := 0 to AddFormEvents.Size-1 do + AddFormEvents[i](Self); +{$ENDIF} + +end; + +constructor TDesignFormData.Create(AForm: TCustomForm); +begin + FForm := AForm as IDesignedForm; + + FLastScreenshot := TBitmap.Create; + FWndMethod := FForm.Form.WindowProc; + FForm.Form.WindowProc := WndMethod; + + if FForm.Form is TFakeForm then + begin +{$IFDEF USE_GENERICS_COLLECTIONS} + FFormImages := TList.Create; +{$ELSE} + FFormImages := TList.Create; +{$ENDIF} + DoAddForm; + end; +end; + +destructor TDesignFormData.Destroy; +var + LImage: TImage; +begin + FForm.Form.WindowProc := FWndMethod; // ! important risky point :P + + if FFormImages <> nil then + begin + for LImage in FFormImages do + LImage.Free; + + FreeAndNil(FFormImages); + end; + FLastScreenshot.Free; + + inherited Destroy; +end; + +{ TModulePageControl } + +procedure TModulePageControl.SetDesignFormData(const AValue: TDesignFormData); +begin + if (AValue = FDesignFormData) then + // for show lfm code, if we want after editing lfm go back to form without any error + // (when we restart IDE some error can be raised ) + if Assigned(FResizer) then + begin + if FResizer.DesignedForm = AValue as IDesignedForm then + Exit; + end + else + Exit; + + FDesignFormData := AValue; + if AValue = nil then + begin + //find + if Assigned(FResizer) then + FResizer.DesignedForm := nil; + end + else + begin + AValue.Form.LastActiveSourceWindow := Owner as TSourceEditorWindowInterface; + if Assigned(FResizer) then + FResizer.DesignedForm := AValue; + BoundToDesignTabSheet; + end; +end; + +destructor TModulePageControl.Destroy; +begin + DesignFormData := nil; + inherited Destroy; +end; + +procedure TModulePageControl.ShowDesignPage; +begin + Pages[1].TabVisible := True; +end; + +procedure TModulePageControl.HideDesignPage; +begin + Pages[1].TabVisible:=False; +end; + +procedure TModulePageControl.BoundToDesignTabSheet; +begin + if (ActivePageIndex <> 1) then + Exit; + + if Assigned(FResizer) then + FResizer.TryBoundSizerToDesignedForm(nil); +end; + +{ TSourceEditorWindowData } + +procedure TSourceEditorWindowData.SetActiveDesignFormData( + const AValue: TDesignFormData); +var + LPageCtrl: TModulePageControl; +begin + if FActiveDesignFormData = AValue then + Exit; + + if FActiveDesignFormData <> nil then + // don't hide now if soon form will be hidden (for example on the IDE start) + if not FActiveDesignFormData.FHiding then + begin + FActiveDesignFormData.FForm.HideWindow; + end; + FActiveDesignFormData := AValue; + + LPageCtrl := FindModulePageControl(FForm); + if (AValue <> nil) then + begin + with AValue as IDesignedForm do + if not AValue.FHiding and (RealBorderStyle <> bsNone) then + begin + BeginUpdate; + //RealBorderIcons := []; + //RealBorderStyle := bsNone; + Form.Show; + EndUpdate; + end; + // important when we want back to tab where was oppened form :< + LazarusIDE.DoShowDesignerFormOfSrc(FForm.ActiveEditor); + end; + + // when is fired DestroyEditor - from this place we can't navigate to pagecontrol by FForm (we need to handle lastactiveeditor) + if LPageCtrl = nil then + Exit; + + LPageCtrl.DesignFormData := AValue; + // for USE_POPUP_PARENT_DESIGNER to eliminate form over code + LPageCtrl.OnChange(LPageCtrl); +end; + +procedure TSourceEditorWindowData.WndMethod(var TheMessage: TLMessage); +begin + FWndMethod(TheMessage); +end; + +constructor TSourceEditorWindowData.Create(AForm: TSourceEditorWindowInterface); +begin + FWndMethod := AForm.WindowProc; + AForm.WindowProc := WndMethod; + FForm := AForm; +{$IFDEF USE_GENERICS_COLLECTIONS} + FPageCtrlList := TDictionary.Create; +{$ELSE} + FPageCtrlList := THashmap.Create; +{$ENDIF} +end; + +destructor TSourceEditorWindowData.Destroy; +begin + FForm.WindowProc := FWndMethod; + FPageCtrlList.Free; + inherited Destroy; +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); +begin +{$IFDEF USE_GENERICS_COLLECTIONS} + FPageCtrlList.Add(ASrcEditor, APage); +{$ELSE} + FPageCtrlList.insert(ASrcEditor, APage); +{$ENDIF} + APage.Pages[1].OnChangeBounds:=OnChangeBounds; +end; + +procedure TSourceEditorWindowData.RemovePageCtrl(ASrcEditor: TSourceEditorInterface); +begin +{$IFDEF USE_GENERICS_COLLECTIONS} + FPageCtrlList.Remove(ASrcEditor); +{$ELSE} + FPageCtrlList.Delete(ASrcEditor); +{$ENDIF} +end; + +{ TDTXTabMaster } + +function TDTXTabMaster.GetTabDisplayState: TTabDisplayState; +begin + Result := GetTabDisplayStateEditor(SourceEditorManagerIntf.ActiveEditor); +end; + +function TDTXTabMaster.GetTabDisplayStateEditor(Index: TSourceEditorInterface + ): TTabDisplayState; +var + LPageCtrl: TModulePageControl; +begin + if Index = nil then + Exit(tdsNone); + + LPageCtrl := FindModulePageControl(Index); + if LPageCtrl = nil then + Exit(tdsNone); + + case LPageCtrl.PageIndex of + 0: Exit(tdsCode); + 1: Exit(tdsDesign); + else + Exit(tdsOther); + end; +end; + +procedure TDTXTabMaster.ToggleFormUnit; +begin + case TabDisplayState of + tdsCode: + ShowDesigner(SourceEditorManagerIntf.ActiveEditor); + tdsDesign: + ShowCode(SourceEditorManagerIntf.ActiveEditor); + end; +end; + +procedure TDTXTabMaster.JumpToCompilerMessage( + ASourceEditor: TSourceEditorInterface); +begin + SourceEditorManagerIntf.ActiveEditor := ASourceEditor; + + ShowCode(ASourceEditor); +end; + +procedure TDTXTabMaster.ShowCode(ASourceEditor: TSourceEditorInterface); +begin + if ASourceEditor = nil then + Exit; + + FindModulePageControl(ASourceEditor).PageIndex := 0; +end; + +procedure TDTXTabMaster.ShowDesigner(ASourceEditor: TSourceEditorInterface; AIndex: Integer); +var + LPageCtrl: TModulePageControl; +begin + if ASourceEditor = nil then + Exit; + + LPageCtrl := FindModulePageControl(ASourceEditor); + + if not LPageCtrl.Pages[1].TabVisible then + Exit; + + LPageCtrl.PageIndex := 1; +end; + +procedure TDTXTabMaster.ShowForm(AForm: TCustomForm); +var + LEditor: TSourceEditorInterface; +begin + LEditor := FindSourceEditorForDesigner(AForm.Designer); + + SourceEditorManagerIntf.ActiveEditor := LEditor; + + ShowDesigner(LEditor); +end; + +{ TDTXComponentsMaster } + +function TDTXComponentsMaster.DrawNonVisualComponents(ALookupRoot: TComponent + ): Boolean; +var + LFormData: TDesignFormData; + LPageCtrl: TModulePageControl; +begin + Result := True; + + LFormData := FindDesignFormData(FormEditingHook.GetDesignerForm(ALookupRoot){ALookupRoot as TCustomForm}); + if LFormData = nil then + Exit; + + LPageCtrl := FindModulePageControl(LFormData.Form.LastActiveSourceWindow); + if (LPageCtrl = nil) or (LPageCtrl.Resizer = nil) or (LPageCtrl.Resizer.FMainDTU = nil) then + Exit; + + Result := LPageCtrl.Resizer.FMainDTU.ShowNonVisualComponents; +end; + +{ TSpartaMainIDE } + +class procedure TSpartaMainIDE.Screen_FormAdded(Sender: TObject; Form: TCustomForm); +var + LSourceEditor: TSourceEditorInterface; + LFormData: TDesignFormData; + i: Integer; + LPageCtrl: TModulePageControl; +begin + if IsFormDesign(Form) then + begin + // Form like TForm1 etc... + if (csDesignInstance in Form.ComponentState) or (Form is TNonFormProxyDesignerForm) then + begin + LFormData := TDesignFormData.Create(Form); + LFormData.FHiding:=True; + dsgForms.Add(LFormData); + + LSourceEditor := FindSourceEditorForDesigner(Form.Designer); + + if LSourceEditor <> nil then + begin + LPageCtrl := FindModulePageControl(LSourceEditor); + if LPageCtrl <> nil then + begin + LPageCtrl.ShowDesignPage; + LPageCtrl.DesignFormData := LFormData; + end; + end; + + PostMessage(Form.Handle, WM_SETNOFRAME, 0, 0); + end; + end + else + begin + if not BoundInitialized then + begin + for i := 0 to Screen.FormCount - 1 do + if Screen.Forms[i] = Form then + Continue + else + begin + Screen.Forms[i].AddHandlerOnChangeBounds(GlobalOnChangeBounds); + + // if POPUP_WINDOWS is defined then show all forms on main form + if (LazarusIDE.GetMainBar = Screen.Forms[i]) then + Continue; + +{$IFDEF POPUP_WINDOWS} + Screen.Forms[i].PopupMode := pmExplicit; + Screen.Forms[i].PopupParent := LazarusIDE.GetMainBar as TCustomForm; +{$ENDIF} + end; + BoundInitialized := True; + end; + + if Form is TSourceEditorWindowInterface then + begin + Form.AddHandlerOnChangeBounds(GlobalSNOnChangeBounds); + Form.PopupMode := pmExplicit; + end + else + begin + Form.AddHandlerOnChangeBounds(GlobalOnChangeBounds); +{$IFDEF POPUP_WINDOWS} + Form.PopupMode := pmExplicit; +{$ENDIF} + end; + +{$IFDEF POPUP_WINDOWS} + Form.PopupParent := LazarusIDE.GetMainBar as TCustomForm; +{$ENDIF} + + Forms.Add(Form); + end; +end; + +class procedure TSpartaMainIDE.TryFreeFormData(Form: TCustomForm); +var + LSEWD: TSourceEditorWindowData; + mpc: TModulePageControl; + LFormData: TDesignFormData; +{$IFNDEF USE_GENERICS_COLLECTIONS} + LIterator: THashmap.TIterator; + LIterator2: THashmap.TIterator; +{$ENDIF} +begin +{$IFNDEF USE_POPUP_PARENT_DESIGNER} + Form.ParentWindow := 0; + Application.ProcessMessages; // For TFrame - System Error. Code: 1400. Invalid window handle. +{$ENDIF} + + LFormData := FindDesignFormData(Form); + dsgForms.Remove(LFormData); + +{$IFDEF USE_GENERICS_COLLECTIONS} + for LSEWD in SourceEditorWindows.Values do + begin + if LSEWD.ActiveDesignFormData <> nil then + if LSEWD.ActiveDesignFormData.Form.Form = Form then + LSEWD.FActiveDesignFormData := nil; // important - we can't call OnChange tab, because tab don't exist anymore + + for mpc in LSEWD.FPageCtrlList.Values do + if mpc.DesignFormData <> nil then + if mpc.DesignFormData.Form.Form = Form then + mpc.DesignFormData := nil; + end; +{$ELSE} + LIterator := SourceEditorWindows.Iterator; + if LIterator <> nil then + try + repeat + LSEWD := LIterator.Value; + if LSEWD.ActiveDesignFormData <> nil then + if LSEWD.ActiveDesignFormData.Form.Form = Form then + LSEWD.FActiveDesignFormData := nil; // important - we can't call OnChange tab, because tab don't exist anymore + + LIterator2 := LSEWD.FPageCtrlList.Iterator; + if LIterator2 <> nil then + try + repeat + mpc := LIterator2.Value; + if mpc.DesignFormData <> nil then + if mpc.DesignFormData.Form.Form = Form then + mpc.DesignFormData := nil; + until not LIterator2.next; + finally + LIterator2.Free; + end; + until not LIterator.next; + finally + LIterator.Free; + end; +{$ENDIF} + + LFormData.Free; +end; + +class procedure TSpartaMainIDE.Screen_FormDel(Sender: TObject; Form: TCustomForm); +begin + if not IsFormDesign(Form) then + begin + if Form is TSourceEditorWindowInterface then + Form.RemoveHandlerOnChangeBounds(GlobalSNOnChangeBounds) + else + Form.RemoveHandlerOnChangeBounds(GlobalOnChangeBounds) + end + else + TryFreeFormData(Form); +end; + +class procedure TSpartaMainIDE.WindowCreate(Sender: TObject); +var + LSourceEditorWindow: TSourceEditorWindowInterface; +begin + if Sender.ClassNameIs('TSourceNotebook') then + begin + LSourceEditorWindow := Sender as TSourceEditorWindowInterface; +{$IFDEF USE_GENERICS_COLLECTIONS} + SourceEditorWindows.Add(LSourceEditorWindow, TSourceEditorWindowData.Create(LSourceEditorWindow)); +{$ELSE} + SourceEditorWindows.insert(LSourceEditorWindow, TSourceEditorWindowData.Create(LSourceEditorWindow)); +{$ENDIF} + end; +end; + +class procedure TSpartaMainIDE.WindowDestroy(Sender: TObject); +var + p: Pointer; + f: TDesignFormData absolute p; +begin + for p in dsgForms do + if f.FForm.LastActiveSourceWindow = Sender then + f.FForm.LastActiveSourceWindow := nil; +{$IFDEF USE_GENERICS_COLLECTIONS} + SourceEditorWindows.Remove(Sender as TSourceEditorWindowInterface); +{$ELSE} + SourceEditorWindows[Sender as TSourceEditorWindowInterface].Free; + SourceEditorWindows.Delete(Sender as TSourceEditorWindowInterface); +{$ENDIF} + if LastActiveSourceEditorWindow = Sender then + LastActiveSourceEditorWindow := nil; +end; + +class procedure TSpartaMainIDE.WindowShow(Sender: TObject); +var + LWindow: TSourceEditorWindowInterface; + LWindowData: TSourceEditorWindowData; + LDesignedForm: IDesignedForm; +begin + LWindow := Sender as TSourceEditorWindowInterface; + +{$IFDEF USE_GENERICS_COLLECTIONS} + if not SourceEditorWindows.TryGetValue(LWindow, LWindowData) or + (LWindowData.ActiveDesignFormData = nil) + then + Exit; +{$ELSE} + if not SourceEditorWindows.contains(LWindow) then + Exit; + if SourceEditorWindows.GetData(LWindow).ActiveDesignFormData = nil then + Exit; +{$ENDIF} + + LDesignedForm := LWindowData.ActiveDesignFormData as IDesignedForm; + LDesignedForm.ShowWindow; +end; + +class procedure TSpartaMainIDE.WindowHide(Sender: TObject); +var + LWindow: TSourceEditorWindowInterface; + LWindowData: TSourceEditorWindowData; + LDesignedForm: IDesignedForm; +begin + LWindow := Sender as TSourceEditorWindowInterface; + +{$IFDEF USE_GENERICS_COLLECTIONS} + if not SourceEditorWindows.TryGetValue(LWindow, LWindowData) or + (LWindowData.ActiveDesignFormData = nil) + then + Exit; +{$ELSE} + if not SourceEditorWindows.contains(LWindow) then + Exit; + LWindowData := SourceEditorWindows[LWindow]; + if LWindowData.ActiveDesignFormData = nil then + Exit; +{$ENDIF} + + LDesignedForm := LWindowData.ActiveDesignFormData as IDesignedForm; + LDesignedForm.HideWindow; +end; + +class procedure TSpartaMainIDE.EditorActivated(Sender: TObject); +var + LDesigner: TIDesigner; + LSourceEditor: TSourceEditorInterface; +{$IFNDEF USE_GENERICS_COLLECTIONS} + LIterator: THashmap.TIterator; +{$ENDIF} + + function LastSourceEditorNotFound: boolean; + var + i: Integer; + se: TSourceEditorInterface; + begin + if (LastActiveSourceEditorWindow = nil) or (LastActiveSourceEditor = nil) then + Exit(False); + +{$IFDEF USE_GENERICS_COLLECTIONS} + for se in SourceEditorWindows[LastActiveSourceEditorWindow].FPageCtrlList.Keys do + begin + Result := True; + for i := 0 to LastActiveSourceEditorWindow.Count - 1 do + if se = LastActiveSourceEditorWindow.Items[i] then + begin + Result := False; + Break; + end; + + if Result then + begin + LastActiveSourceEditor := se; // after moving code editor into other window, sometimes IDE switch to other tab :\ damn... this line prevent this. + Exit; + end; + end; +{$ELSE} + LIterator := SourceEditorWindows[LastActiveSourceEditorWindow].FPageCtrlList.Iterator; + if LIterator <> nil then + try + repeat + se := LIterator.Key; + Result := True; + for i := 0 to LastActiveSourceEditorWindow.Count - 1 do + if se = LastActiveSourceEditorWindow.Items[i] then + begin + Result := False; + Break; + end; + if Result then + begin + LastActiveSourceEditor := se; // after moving code editor into other window, sometimes IDE switch to other tab :\ damn... this line prevent this. + Exit; + end; + until not LIterator.next; + finally + LIterator.Free; + end; +{$ENDIF} + + Result := False; + end; + +var + LPageCtrl: TModulePageControl; + LSourceEditorWindow: TSourceEditorWindowInterface; + LDesignFormData: TDesignFormData; +begin + if Sender is TSourceEditorInterface then + begin + LSourceEditor := TSourceEditorInterface(Sender); + // if we create directly new project then Activate is called without EditorCreate... + if not (LSourceEditor.EditorControl.Parent.Parent is TModulePageControl) then + begin + // possible is situation when we moved tab into other window + // then was not called event EditorDestroy - that generates problems with switching tabs + // or when we moving tab to first window ( then is raising : duplicates not allowed in dictionary). + if LastSourceEditorNotFound then + EditorDestroyed(nil); + EditorCreate(Sender); + end; + + LDesigner := LSourceEditor.GetDesigner(True); + + // should be performed during EditorCreate (parent of parent is module page ctrl) + LPageCtrl := TModulePageControl(LSourceEditor.EditorControl.Parent.Parent); + if LPageCtrl = nil then + Exit; + + if LDesigner = nil then + LPageCtrl.HideDesignPage + else + begin + if LPageCtrl.Resizer = nil then + LPageCtrl.FResizer := TResizer.Create(LPageCtrl.Pages[1]); + + LPageCtrl.ShowDesignPage; + end; + + LSourceEditorWindow := TSourceEditorWindowInterface(LPageCtrl.Owner); + + LastActiveSourceEditorWindow := LSourceEditorWindow; + LastActiveSourceEditor := LSourceEditor; + + LDesignFormData := FindDesignFormData(LPageCtrl); + + // when we switch tab, design form should be hidden + if (LDesigner = nil) or (LDesignFormData = nil) then + SourceEditorWindows[LSourceEditorWindow].ActiveDesignFormData := nil + else + begin + // during form loading for example from package, ActiveDesignFormData assignment, + // blocks the message queue responsible for hiding form + // We can't check it because there are some forms where designing is not handled yet. + // (for that kind of forms is returned empty designformdata) + // maybe we can fix this in future + if not LDesignFormData.FHiding then + // Prevent unexpected events (when is deactivated some control outside designed form) + if (LDesignFormData.Form.LastActiveSourceWindow = LSourceEditorWindow) + // important!!! for many error - switching between editors... + and (LPageCtrl.PageIndex = 1) then + SourceEditorWindows[LSourceEditorWindow].ActiveDesignFormData := LDesignFormData + else + SourceEditorWindows[LSourceEditorWindow].ActiveDesignFormData := nil; + end; + + case LPageCtrl.PageIndex of + 0: if LDesignFormData <> nil then {$IFNDEF USE_POPUP_PARENT_DESIGNER}LDesignFormData.Form.HideWindow{$ENDIF}; + 1: + begin + LazarusIDE.DoShowDesignerFormOfSrc(LSourceEditorWindow.ActiveEditor); + + // for lfm edition... + with LDesignFormData as IDesignedForm do + if not LDesignFormData.FHiding and (RealBorderStyle <> bsNone) then + begin + BeginUpdate; + //RealBorderIcons := []; + //RealBorderStyle := bsNone; + Form.Show; + EndUpdate; + LPageCtrl.BoundToDesignTabSheet; + + PostMessage(Form.Handle, WM_BoundToDesignTabSheet, 0, 0); + end; + end; + end; + end + else + begin + RefreshAllSourceWindowsModulePageControl; + end; +end; + +class procedure TSpartaMainIDE.EditorDestroyed(Sender: TObject); +var + LSourceEditor: TSourceEditorInterface; + LPageCtrl: TModulePageControl; + LSourceEditorWindow: TSourceEditorWindowInterface; + LFormData: TDesignFormData; +begin + // sender is here as special parameter, because is possible situation where is moved editor + // to another window and was not triggered EditorDestroy - for more info goto editoractivate + if Sender = nil then + LSourceEditor := LastActiveSourceEditor + else + LSourceEditor := TSourceEditorInterface(Sender); + + // parent don't exist anymore and we must search in each window... + if Sender = nil then // but not for Sender = nil :P + LPageCtrl := SourceEditorWindows[LastActiveSourceEditorWindow].FPageCtrlList[LastActiveSourceEditor] + else + LPageCtrl := AbsoluteFindModulePageControl(LSourceEditor); + + if LPageCtrl = nil then + Exit; + + LFormData := FindDesignFormData(LSourceEditor.GetDesigner(False)); + + // goto first comment (forced destroy) + if Sender = nil then + LSourceEditorWindow := LastActiveSourceEditorWindow + else + LSourceEditorWindow := TSourceEditorWindowInterface(LPageCtrl.Owner); + + if LFormData <> nil then + begin + SourceEditorWindows[LSourceEditorWindow].ActiveDesignFormData := nil; + LFormData.Form.LastActiveSourceWindow := nil; + end; + + SourceEditorWindows[LSourceEditorWindow].RemovePageCtrl(LSourceEditor); + LPageCtrl.Free; + + if LastActiveSourceEditor = LSourceEditor then + LastActiveSourceEditor := nil; +end; + +class procedure TSpartaMainIDE.EditorCreate(Sender: TObject); + +var + LSourceEditor: TSourceEditorInterface; + + function CreateModulePageControl: TModulePageControl; + var + LNewTabSheet: TTabSheet; + LSourceEditorWindow: TSourceEditorWindowInterface; + LParent: TWinControl; + begin + Result := TModulePageControl.Create(LSourceEditor.EditorControl.Owner); + + Result.TabPosition := tpBottom; + Result.Align:=alClient; + LParent := LSourceEditor.EditorControl.Parent; + + LNewTabSheet := TTabSheet.Create(Result); + LNewTabSheet.PageControl := Result; + LNewTabSheet.Caption := 'Code'; + LSourceEditor.EditorControl.Parent := LNewTabSheet; // ! SynEdit :) + + LNewTabSheet := TTabSheet.Create(Result); + LNewTabSheet.PageControl := Result; + LNewTabSheet.Caption := 'Designer'; + + Result.OnChange := TabChange; + + Result.Parent := LParent; + + LSourceEditorWindow := TSourceEditorWindowInterface(Result.Owner); + SourceEditorWindows[LSourceEditorWindow].AddPageCtrl(LSourceEditor, Result) + end; + +begin + LSourceEditor := Sender as TSourceEditorInterface; + if not (LSourceEditor.EditorControl.Parent.Parent is TModulePageControl) then + CreateModulePageControl; +end; + +class procedure TSpartaMainIDE.TabChange(Sender: TObject); +var + LActiveSourceWindow: TSourceEditorWindowInterface; + w: TSourceEditorWindowInterface; +{$IFDEF USE_GENERICS_COLLECTIONS} + p: TPair; +{$ELSE} + p: THashmap.TPair; + LIterator: THashmap.TIterator; + LIterator2: THashmap.TIterator; +{$ENDIF} + LDesigner: TIDesigner; + LFormData: TDesignFormData; + LPageCtrl: TModulePageControl; + LSourceWndData: TSourceEditorWindowData; +begin + // activate proper source editor window when user is clicking on page. + // (at clicking time can be active other source window) + LActiveSourceWindow := TComponent(Sender).Owner as TSourceEditorWindowInterface; + if LActiveSourceWindow <> SourceEditorManagerIntf.ActiveSourceWindow then + SourceEditorManagerIntf.ActiveSourceWindow := LActiveSourceWindow; + + LPageCtrl := TModulePageControl(Sender); + // in case there is no module and is visible page other than code page. + if (LActiveSourceWindow.ActiveEditor <> nil) and (LPageCtrl <> nil) then + begin + LDesigner := LActiveSourceWindow.ActiveEditor.GetDesigner(True); + LFormData := FindDesignFormData(LDesigner); + +{$IFDEF USE_GENERICS_COLLECTIONS} + if (LFormData <> nil) and SourceEditorWindows.TryGetValue(LActiveSourceWindow, LSourceWndData) then + begin + case LPageCtrl.ActivePageIndex of + 0: + begin + LSourceWndData.ActiveDesignFormData := nil; + end; + 1: + begin + // deactivate design tab in other page control :) + for w in SourceEditorWindows.Keys do + if w = LActiveSourceWindow then + Continue + else + for p in SourceEditorWindows[w].FPageCtrlList do + if (p.Value.DesignFormData = LFormData) and (p.Value <> Sender) then + begin + IDETabMaster.ShowCode(p.Key); + end; + + LSourceWndData.ActiveDesignFormData := LFormData; + // to handle windows with different size + LPageCtrl.BoundToDesignTabSheet; + end; + end; + end; +{$ELSE} + if (LFormData <> nil) and SourceEditorWindows.contains(LActiveSourceWindow) then + begin + LSourceWndData := SourceEditorWindows[LActiveSourceWindow]; + case LPageCtrl.ActivePageIndex of + 0: + begin + LSourceWndData.ActiveDesignFormData := nil; + end; + 1: + begin + // deactivate design tab in other page control :) + LIterator := SourceEditorWindows.Iterator; + if LIterator <> nil then + try + repeat + w := LIterator.Key; + if w = LActiveSourceWindow then + Continue + else + begin + LIterator2 := SourceEditorWindows[w].FPageCtrlList.Iterator; + if LIterator2 <> nil then + try + repeat + p := LIterator2.Data; + if (p.Value.DesignFormData = LFormData) and (p.Value <> Sender) then + IDETabMaster.ShowCode(p.Key); + until not LIterator2.next; + finally + LIterator2.Free; + end; + end; + until not LIterator.next; + finally + LIterator.Free; + end; + + LSourceWndData.ActiveDesignFormData := LFormData; + // to handle windows with different size + LPageCtrl.BoundToDesignTabSheet; + end; + end; + end; +{$ENDIF} + end; +end; + +class procedure TSpartaMainIDE.GlobalOnChangeBounds(Sender: TObject); +var + sewd: TSourceEditorWindowData; +{$IFNDEF USE_GENERICS_COLLECTIONS} + LIterator: THashmap.TIterator; +{$ENDIF} +begin +{$IFDEF USE_GENERICS_COLLECTIONS} + for sewd in SourceEditorWindows.Values do + begin + sewd.OnChangeBounds(Sender); + end; +{$ELSE} + LIterator := SourceEditorWindows.Iterator; + if LIterator <> nil then + try + repeat + sewd := LIterator.Value; + sewd.OnChangeBounds(Sender) + until not LIterator.next; + finally + LIterator.Free; + end; +{$ENDIF} +end; + +class procedure TSpartaMainIDE.GlobalSNOnChangeBounds(Sender: TObject); +var + LWindow: TSourceEditorWindowInterface; + LWindowData: TSourceEditorWindowData; + LDesignForm: TDesignFormData; +begin + // Check parent. Maybe is different? If yes then window changed state (docked/undocked) and we need to perform few actions + LWindow := Sender as TSourceEditorWindowInterface; + + // dock/undock event :) +{$IFDEF USE_GENERICS_COLLECTIONS} + if not SourceEditorWindows.TryGetValue(LWindow, LWindowData) then + Exit; +{$ELSE} + if not SourceEditorWindows.contains(LWindow) then + Exit; + LWindowData := SourceEditorWindows[LWindow]; +{$ENDIF} + if LWindowData.FLastTopParent <> LWindow.GetTopParent then + begin + LWindowData.FLastTopParent := LWindow.GetTopParent; + // refresh for popupparent + LDesignForm := LWindowData.ActiveDesignFormData; + LWindowData.ActiveDesignFormData := nil; + LWindowData.ActiveDesignFormData := LDesignForm; + // ... + //PostMessage(LWindow.Handle, WM_BoundToDesignTabSheet, 0, 0); + if LDesignForm <> nil then + begin +{$IFNDEF USE_POPUP_PARENT_DESIGNER} + LDesignForm.Form.Form.ParentWindow := FindModulePageControl(LWindow).Resizer.FResizerFrame.pClient.Handle; +{$ENDIF} + PostMessage(LDesignForm.Form.Form.Handle, WM_BoundToDesignTabSheet, 0, 0); + end; + end; + + LWindowData.OnChangeBounds(Sender); +end; + +{$IFDEF USE_POPUP_PARENT_DESIGNER} +class procedure TDesignerIDEBoss.OnBeforeClose(Sender: TObject); +begin + isIdeDestroyed := True; +end; +{$ENDIF} + +class procedure TSpartaMainIDE.OnShowDesignerForm(Sender: TObject; AEditor: TSourceEditorInterface; + AComponentPaletteClassSelected: Boolean); +var + LForm: TDesignFormData; + LPageCtrl, p: TModulePageControl; + w: TSourceEditorWindowInterface; + e: TSourceEditorInterface; +{$IFNDEF USE_GENERICS_COLLECTIONS} + LIterator: THashmap.TIterator; +{$ENDIF} +begin + LForm := FindDesignFormData(TCustomForm(Sender).Designer); + if LForm = nil then + Exit; + + if LForm.FHiding then + Exit; + + LPageCtrl := FindModulePageControl(SourceEditorManagerIntf.ActiveEditor); + + if LPageCtrl = nil then + Exit; // it should not happen but who knows :P Lazarus IDE is sometimes mischievous + + if AComponentPaletteClassSelected then + begin + // if form is already opened do nothing, if not then show form for active module. +{$IFDEF USE_GENERICS_COLLECTIONS} + for w in SourceEditorWindows.Keys do + begin + e := w.ActiveEditor; + if (e = nil) or (e.GetDesigner(True) <> LForm.Form.Form.Designer) then + Continue; + + p := FindModulePageControl(e); + if p.PageIndex = 1 then + Exit; + end; +{$ELSE} + LIterator := SourceEditorWindows.Iterator; + if LIterator <> nil then + try + repeat + w := LIterator.Key; + e := w.ActiveEditor; + if (e = nil) or (e.GetDesigner(True) <> LForm.Form.Form.Designer) then + Continue; + + p := FindModulePageControl(e); + if p.PageIndex = 1 then + Exit; + until not LIterator.next; + finally + LIterator.Free; + end; +{$ENDIF} + end; + + IDETabMaster.ShowDesigner(SourceEditorManagerIntf.ActiveEditor); +end; + +class procedure TSpartaMainIDE.OnShowSrcEditor(Sender: TObject); +begin + IDETabMaster.ShowCode(Sender as TSourceEditorInterface); +end; + +class procedure TSpartaMainIDE.OnShowMethod(const Name: String); +var + LForm: TDesignFormData; + LSecondEditor: TSourceEditorInterface = nil; + i: Integer; + LSourceWindow: TSourceEditorWindowInterface; +begin + LForm := FindDesignFormData(FormEditingHook.GetCurrentDesigner); + if LForm = nil then + Exit; + + for i := 0 to SourceEditorManagerIntf.SourceWindowCount - 1 do + begin + LSourceWindow := SourceEditorManagerIntf.SourceWindows[i]; + if LForm.Form.LastActiveSourceWindow = LSourceWindow then + Continue; + + if LSourceWindow.ActiveEditor <> nil then + if LSourceWindow.ActiveEditor.GetDesigner(True) = LForm.Form.Form.Designer then + begin + LSecondEditor := LSourceWindow.ActiveEditor; + Break; + end; + end; + + if LSecondEditor = nil then + begin + if LForm.Form.LastActiveSourceWindow <> nil then + begin + IDETabMaster.ShowCode(LForm.Form.LastActiveSourceWindow.ActiveEditor); + end; + end + else + begin + IDETabMaster.ShowCode(LSecondEditor); + end; + + if LSecondEditor <> nil then + begin + LazarusIDE.DoShowMethod(LSecondEditor, Name); + end; +end; + +class procedure TSpartaMainIDE.OnDesignRefreshPropertyValues; +var + LForm: TCustomForm; + LSourceWindow: TSourceEditorWindowInterface; + LFormData: TDesignFormData; + LPageCtrl: TModulePageControl; + + function RootIsSelected: Boolean; + var + LSelection: TPersistentSelectionList; + i: integer; + begin + Result := False; + LSelection := TPersistentSelectionList.Create; + GlobalDesignHook.GetSelection(LSelection); + for i := 0 to LSelection.Count - 1 do + if LSelection.Items[i] = GlobalDesignHook.LookupRoot then + begin + Result := True; + Break; + end; + LSelection.Free; + end; + +begin + if (GlobalDesignHook.LookupRoot is TCustomFrame) then + begin + if not RootIsSelected then + Exit; + + LForm := FormEditingHook.GetDesignerForm(GlobalDesignHook.LookupRoot); + LFormData := FindDesignFormData(LForm); + LSourceWindow := (LFormData as IDesignedForm).LastActiveSourceWindow; + LPageCtrl := FindModulePageControl(LSourceWindow); + TFakeFrame(LForm).SetBounds(LForm.Left-1,LForm.Top-1,TFakeFrame(LForm).Width,TFakeFrame(LForm).Height); + //LPageCtrl.BoundToDesignTabSheet; + end + else + if (GlobalDesignHook.LookupRoot is TCustomForm) then + begin + if not RootIsSelected then + Exit; + + LForm := TCustomForm(GlobalDesignHook.LookupRoot); + LFormData := FindDesignFormData(LForm); + LFormData.RepaintFormImages; + end; +end; + +{$IFNDEF USE_GENERICS_COLLECTIONS} +class procedure FreeSourceEditorWindowsValues; +var + LIterator: THashmap.TIterator; +begin + LIterator := SourceEditorWindows.Iterator; + if LIterator <> nil then + try + repeat + LIterator.Value.Free; + until not LIterator.next; + finally + LIterator.Free; + end; +end; +{$ENDIF} + +initialization + dsgForms := Classes.TList.Create; +{$IFDEF USE_GENERICS_COLLECTIONS} + SourceEditorWindows := TObjectDictionary.Create([doOwnsValues]); +{$ELSE} + SourceEditorWindows := THashmap.Create(); +{$ENDIF} + Forms := Classes.TList.Create; +finalization + Forms.Free; +{$IFNDEF USE_GENERICS_COLLECTIONS} + FreeSourceEditorWindowsValues; +{$ENDIF} + SourceEditorWindows.Free; + FreeAndNil(dsgForms); +end. + diff --git a/components/sparta/dockedformeditor/source/sparta_reg_dockedformeditor.pas b/components/sparta/dockedformeditor/source/sparta_reg_dockedformeditor.pas new file mode 100644 index 0000000000..230f5e3404 --- /dev/null +++ b/components/sparta/dockedformeditor/source/sparta_reg_dockedformeditor.pas @@ -0,0 +1,65 @@ +{ + ***************************************************************************** + See the file COPYING.modifiedLGPL.txt, included in this distribution, + for details about the license. + ***************************************************************************** + + Author: Maciej Izak + + DaThoX 2004-2015 + FreeSparta.com +} + +unit sparta_reg_DockedFormEditor; + +{$mode delphi}{$H+} + +interface + +uses + Classes, SysUtils, SrcEditorIntf, LazIDEIntf, ComCtrls, Controls, Forms, IDEImagesIntf, + Buttons, ExtCtrls, Graphics, IDEWindowIntf, sparta_MainIDE, + PropEdits, PropEditUtils, FormEditingIntf, ComponentEditors, EditBtn, TypInfo, + LCLIntf, LCLType, sparta_FakeForm, sparta_FakeNonControl, sparta_FakeFrame; + +procedure Register; + +implementation + +procedure Register; +begin + FormEditingHook.StandardDesignerBaseClasses[DesignerBaseClassId_TForm] := TFakeForm; + FormEditingHook.NonFormProxyDesignerForm[NonControlProxyDesignerFormId] := TFakeNonControl; + FormEditingHook.NonFormProxyDesignerForm[FrameProxyDesignerFormId] := TFakeFrame; + + Screen.AddHandlerFormAdded(TSpartaMainIDE.Screen_FormAdded); + Screen.AddHandlerRemoveForm(TSpartaMainIDE.Screen_FormDel); +{$IFDEF USE_POPUP_PARENT_DESIGNER} + TCustomForm(LazarusIDE.GetMainBar).AddHandlerOnBeforeDestruction(spartaIDE.OnBeforeClose); +{$ENDIF} + SourceEditorManagerIntf.RegisterChangeEvent(semWindowCreate, TSpartaMainIDE.WindowCreate); + SourceEditorManagerIntf.RegisterChangeEvent(semWindowDestroy, TSpartaMainIDE.WindowDestroy); + SourceEditorManagerIntf.RegisterChangeEvent(semWindowShow, TSpartaMainIDE.WindowShow); + SourceEditorManagerIntf.RegisterChangeEvent(semWindowHide, TSpartaMainIDE.WindowHide); + SourceEditorManagerIntf.RegisterChangeEvent(semEditorActivate, TSpartaMainIDE.EditorActivated); + SourceEditorManagerIntf.RegisterChangeEvent(semEditorDestroy, TSpartaMainIDE.EditorDestroyed); + SourceEditorManagerIntf.RegisterChangeEvent(semEditorCreate, TSpartaMainIDE.EditorCreate); + + LazarusIDE.AddHandlerOnShowDesignerFormOfSource(TSpartaMainIDE.OnShowDesignerForm); + LazarusIDE.AddHandlerOnShowSourceOfActiveDesignerForm(TSpartaMainIDE.OnShowSrcEditor); + + GlobalDesignHook.AddHandlerShowMethod(TSpartaMainIDE.OnShowMethod); + GlobalDesignHook.AddHandlerRefreshPropertyValues(TSpartaMainIDE.OnDesignRefreshPropertyValues); + + IDETabMaster := TDTXTabMaster.Create; + IDEComponentsMaster := TDTXComponentsMaster.Create; +end; + +finalization + Screen.RemoveHandlerFormAdded(TSpartaMainIDE.Screen_FormAdded); + Screen.RemoveHandlerRemoveForm(TSpartaMainIDE.Screen_FormDel); + + IDETabMaster.Free; + IDEComponentsMaster.Free; +end. + diff --git a/components/sparta/dockedformeditor/source/sparta_resizer.pas b/components/sparta/dockedformeditor/source/sparta_resizer.pas new file mode 100644 index 0000000000..141b6fc829 --- /dev/null +++ b/components/sparta/dockedformeditor/source/sparta_resizer.pas @@ -0,0 +1,452 @@ +{ + ***************************************************************************** + See the file COPYING.modifiedLGPL.txt, included in this distribution, + for details about the license. + ***************************************************************************** + + Author: Maciej Izak + + DaThoX 2004-2015 + FreeSparta.com +} + +unit sparta_Resizer; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, Controls, ExtCtrls, sparta_ResizerFrame, sparta_DesignedForm, Forms, Math, StdCtrls, + LCLType, LazIDEIntf, Buttons, SpartaAPI, Dialogs, +{$IFDEF USE_GENERICS_COLLECTIONS} + Generics.Defaults, +{$ENDIF} + FormEditingIntf; + +type + + { TResizer } + + TResizer = class(TComponent, IResizer) + private + FDesignedForm: IDesignedForm; + + procedure SetDesignedForm(const AValue: IDesignedForm); + procedure SetDesignScroll(AIndex: Integer; AValue: Boolean); + procedure sbScroll(Sender: TObject; ScrollCode: TScrollCode; + var ScrollPos: Integer); + + procedure FunnyButtonClick(Sender: TObject); + protected + // To perform proper behaviour for scroolbar with "PageSize" we need to remember real + // maximal values (is possible to scroll outside of range 0..(Max - PageSize), + // after mouse click in button responsible for changing value of scrollbar, + // our value is equal to Max :\). Workaround: we need to remember real max value in our own place + FRealMaxH: Integer; + FRealMaxV: Integer; + FSpecialMargin: array[0..3] of Integer; + FDesignScroll: array[0..1] of Boolean; + FParent: TWinControl; + + class var + FStarter, FProfessional: TNotifyEvent; + public + pMainDTU: TPanel; + pMain: TPanel; + pAddons: TPanel; + pComponents: TPanel; + lInfo: TLabel; + sbShowComponents : TSpeedButton; + sbShowFormEditor: TSpeedButton; + sbShowAnchorEditor: TSpeedButton; + sbShowNonVisualEditor: TSpeedButton; + pDesignTimeUtils: TPanel; + sbV: TScrollBar; + sbH: TScrollBar; + bR: TButton; + FResizerFrame: TResizerFrame; + + FMainDTU: ISTAMainDesignTimeUtil; + + FEDTU: TList; + + constructor Create(AParent: TWinControl); + destructor Destroy; override; + + property DesignedForm: IDesignedForm read FDesignedForm write SetDesignedForm; + + procedure TryBoundSizerToDesignedForm(Sender: TObject); + + procedure NodePositioning(Sender: TObject; PositioningKind: TPositioningKind; PositioningCode: TPositioningCode); + + property DesignScrollRight: Boolean index SB_Vert read FDesignScroll[SB_Vert] write SetDesignScroll; + property DesignScrollBottom: Boolean index SB_Horz read FDesignScroll[SB_Horz] write SetDesignScroll; + end; + +implementation + +{ TResizer } + +procedure TResizer.SetDesignedForm(const AValue: IDesignedForm); + + function FindFirstFormParent: TCustomForm; + begin + Result := TCustomForm(FResizerFrame.Parent); + while not (Result is TCustomForm) do + Result := TCustomForm(Result.Parent); + end; + +var + LLookupRoot: TComponent; +begin + if FDesignedForm <> nil then + begin + FDesignedForm.OnChangeHackedBounds := nil; + end; + + FDesignedForm := AValue; + + if FDesignedForm <> nil then + begin + FDesignedForm.BeginUpdate; + +{$IFDEF USE_POPUP_PARENT_DESIGNER} + FDesignedForm.RealPopupMode := pmExplicit; + // for dock/undock + FDesignedForm.RealPopupParent := nil; + FDesignedForm.RealPopupParent := FindFirstFormParent; +{$ELSE} + FDesignedForm.Form.ParentWindow := FResizerFrame.pClient.Handle; +{$ENDIF} + // for big forms (bigger than screen resolution) we need to refresh Real* values + DesignedForm.RealWidth := DesignedForm.Width; + DesignedForm.RealHeight := DesignedForm.Height; + + FDesignedForm.EndUpdate; + FDesignedForm.OnChangeHackedBounds := @TryBoundSizerToDesignedForm; + // in this place DesignedForm should be initialized by current editor (+ "sizer") + // TODO some interfaces for utils (Design Time Utils - DTU) ? + LLookupRoot := LookupRoot(DesignedForm.Form); + + if FMainDTU <> nil then + FMainDTU.Root := LLookupRoot; + end + else + begin + if FMainDTU <> nil then + FMainDTU.Root := nil; + end; + + FResizerFrame.DesignedForm := AValue; +end; + +procedure TResizer.SetDesignScroll(AIndex: Integer; AValue: Boolean); + + procedure PerformScroll(AScroll: TScrollBar); + begin + AScroll.Visible := AValue; + AScroll.Position:=0; + end; + +begin + if FDesignScroll[AIndex] = AValue then + Exit; + + FDesignScroll[AIndex] := AValue; + + case AIndex of + SB_Horz: PerformScroll(sbH); + SB_Vert: PerformScroll(sbV); + else + raise EArgumentOutOfRangeException.CreateRes(@SArgumentOutOfRange); + end; +end; + +procedure TResizer.sbScroll(Sender: TObject; ScrollCode: TScrollCode; + var ScrollPos: Integer); +var + LScrollPos: Integer; +begin + if FDesignedForm = nil then + Exit; + + if ScrollCode <> scEndScroll then + FResizerFrame.HideSizeRects + else + FResizerFrame.ShowSizeRects; + + + FDesignedForm.BeginUpdate; + if Sender = sbV then + begin + // Warning - don't overflow the range! (go to description for FRealMaxV) + ScrollPos := Min(ScrollPos, FRealMaxV); + FResizerFrame.VerticalScrollPos := ScrollPos; + // scroll for form + with FResizerFrame do // -8 when we scaling the form and we don't need to scroll -> there is Max + LScrollPos := Max(ifthen(pBG.Top + BgTopMargin <= 0, ScrollPos - SIZER_RECT_SIZE - BgTopMargin, 0), 0); + FDesignedForm.VertScrollPosition := LScrollPos; + end; + if Sender = sbH then + begin + ScrollPos := Min(ScrollPos, FRealMaxH); + FResizerFrame.HorizontalScrollPos := ScrollPos; + // scroll for form + with FResizerFrame do + LScrollPos := Max(ifthen(pBG.Left + BgLeftMargin <= 0, ScrollPos - SIZER_RECT_SIZE - BgLeftMargin, 0), 0); + FDesignedForm.HorzScrollPosition := LScrollPos; + end; + FDesignedForm.EndUpdate; + + FResizerFrame.PositionNodes(FResizerFrame); + + FDesignedForm.Form.Invalidate; +end; + +constructor TResizer.Create(AParent: TWinControl); +begin + inherited Create(AParent); + FParent := AParent; + // create layout + FEDTU := TList.Create; + + if Assigned(FStarter) then + FStarter(Self); + + pMainDTU := TPanel.Create(AParent); + with pMainDTU do + begin + Parent := AParent; + Align := alTop; + BevelOuter := bvNone; + Height := 0; + end; + + pAddons := TPanel.Create(AParent); + pAddons.Parent := AParent; + pAddons.Align := alRight; + pAddons.BevelOuter := bvNone; + pAddons.Width:=0; + + if DTUManager <> nil then + begin + FMainDTU := DTUManager.CreateMainDTU(pMainDTU, pAddons); + end; + + // Funny button + bR := TButton.Create(AParent); + with bR do + begin + Parent := AParent; + Height := 17; + Width := 17; + AnchorSideRight.Control := pAddons; + AnchorSideBottom.Control := AParent; + AnchorSideBottom.Side := asrBottom; + Anchors := [akRight, akBottom]; + Caption := 'R'; + Visible := True; + OnClick := @FunnyButtonClick; + end; + + sbV := TScrollBar.Create(AParent); + with sbV do + begin + Kind := sbVertical; + Parent := AParent; + AnchorSideTop.Control := pMainDTU; + AnchorSideTop.Side := asrBottom; + AnchorSideRight.Control := pAddons; + AnchorSideBottom.Control := bR; + Width := 17; + Anchors := [akTop, akRight, akBottom]; + Visible := False; + OnScroll := @sbScroll; + end; + + sbH := TScrollBar.Create(AParent); + with sbH do + begin + Parent := AParent; + AnchorSideLeft.Control := AParent; + AnchorSideRight.Control := bR; + AnchorSideBottom.Control := AParent; + AnchorSideBottom.Side := asrBottom; + Anchors := [akLeft, akRight, akBottom]; + Visible := False; + OnScroll := @sbScroll; + end; + + pMain := TPanel.Create(AParent); + with pMain do + begin + Parent := AParent; + AnchorSideLeft.Control := AParent; + AnchorSideTop.Control := pMainDTU; + AnchorSideTop.Side := asrBottom; + AnchorSideRight.Control := sbV; + AnchorSideBottom.Control := sbH; + Anchors := [akTop, akLeft, akRight, akBottom]; + BevelOuter := bvNone; + end; + + FResizerFrame := TResizerFrame.Create(AParent); + FResizerFrame.Parent := pMain; + FResizerFrame.Left := 0; + FResizerFrame.Top := 0; + FResizerFrame.OnNodePositioning := @NodePositioning; + + pMain.OnChangeBounds:=@TryBoundSizerToDesignedForm; +end; + +destructor TResizer.Destroy; +begin + FMainDTU := nil; + FEDTU.Free; + inherited Destroy; +end; + +procedure TResizer.TryBoundSizerToDesignedForm(Sender: TObject); +var + LWidth, LHeight: Integer; + LScrollPos: Integer; +begin + if DesignedForm = nil then + Exit; + + FResizerFrame.Constraints.MaxWidth := pMain.Width; + FResizerFrame.Constraints.MaxHeight := pMain.Height; + + LWidth := DesignedForm.Width + FResizerFrame.BgLeftMargin + FResizerFrame.BgRightMargin + 2*FResizerFrame.SIZER_RECT_SIZE; + LHeight := DesignedForm.Height + FResizerFrame.BgTopMargin + FResizerFrame.BgBottomMargin + 2*FResizerFrame.SIZER_RECT_SIZE; + if not FResizerFrame.NodePositioning then + begin + FResizerFrame.Width := LWidth; + FResizerFrame.Height := LHeight; + // after enlargement and after reducing constrait not work for frame (LCL bug) + if FResizerFrame.Width > FResizerFrame.Constraints.MaxWidth then + FResizerFrame.Width := FResizerFrame.Constraints.MaxWidth; + if FResizerFrame.Height > FResizerFrame.Constraints.MaxHeight then + FResizerFrame.Height := FResizerFrame.Constraints.MaxHeight; + end; + + FResizerFrame.PositionNodes(FResizerFrame); + + DesignScrollBottom := FResizerFrame.Width < LWidth; + sbH.Max := LWidth; + FRealMaxH := LWidth - FResizerFrame.Width; + sbH.PageSize := FResizerFrame.Width; + if FResizerFrame.HorizontalScrollPos > FRealMaxH then + begin + FResizerFrame.HorizontalScrollPos := FRealMaxH; + LScrollPos := FResizerFrame.HorizontalScrollPos; + sbScroll(sbH, scEndScroll, LScrollPos); + end; + + DesignScrollRight := FResizerFrame.Height < LHeight; + sbV.Max := LHeight; + FRealMaxV := LHeight - FResizerFrame.Height; + sbV.PageSize := FResizerFrame.Height; + if FResizerFrame.VerticalScrollPos > FRealMaxV then + begin + FResizerFrame.VerticalScrollPos := FRealMaxV; + LScrollPos := FResizerFrame.VerticalScrollPos; + sbScroll(sbV, scEndScroll, LScrollPos); + end; + + {!} + FResizerFrame.ClientChangeBounds(nil); + + // each editor can have scrolls in different positions. + // this is our place where we can call event to set scroll positions. + LScrollPos := FResizerFrame.VerticalScrollPos; + sbScroll(sbV, scEndScroll, LScrollPos); + LScrollPos := FResizerFrame.HorizontalScrollPos; + sbScroll(sbH, scEndScroll, LScrollPos); + + if Supports(FDesignedForm, IDesignedFormBackground) then + (FDesignedForm as IDesignedFormBackground).RefreshValues; +end; + +procedure TResizer.NodePositioning(Sender: TObject; PositioningKind: TPositioningKind; PositioningCode: TPositioningCode); + + procedure Positioning; + var + LHiddenHeight, LNewHeight: Integer; + LHiddenWidth, LNewWidth: Integer; + begin + DesignedForm.BeginUpdate; + + if pkRight in PositioningKind then + begin + LHiddenWidth := sbH.Position; + if LHiddenWidth > FResizerFrame.DesignedWidthToScroll then + LHiddenWidth := FResizerFrame.DesignedWidthToScroll; + + // TODO - better handling of min width - same in TDesignedFormImpl.SetPublishedBounds (sparta_FakeCustom.pas) + + LNewWidth := FResizerFrame.pClient.Width + LHiddenWidth; + DesignedForm.RealWidth := LNewWidth; + DesignedForm.Width := LNewWidth; + + // perform minimal width (TODO) + {if LNewWidth < DesignedForm.Width then + begin + FResizerFrame.pClient.Width := DesignedForm.Width; + Application.HandleMessage; + Application.ProcessMessages; + end;} + end; + + if pkBottom in PositioningKind then + begin + LHiddenHeight := sbV.Position; + if LHiddenHeight > FResizerFrame.DesignedHeightToScroll then + LHiddenHeight := FResizerFrame.DesignedHeightToScroll; + + LNewHeight := FResizerFrame.pClient.Height + LHiddenHeight; + DesignedForm.RealHeight := LNewHeight; + DesignedForm.Height := LNewHeight; + + // perform minimal height (TODO) + {if LNewHeight < DesignedForm.RealHeight then + begin + if FResizerFrame.pClient.Height < DesignedForm.RealHeight then + FResizerFrame.pClient.Height := DesignedForm.RealHeight; + Application.ProcessMessages; + end;} + end; + + DesignedForm.EndUpdate; + end; + + procedure PositioningEnd; + begin + TryBoundSizerToDesignedForm(nil); + end; + +begin + if DesignedForm = nil then + Exit; + + case PositioningCode of + pcPositioningEnd: PositioningEnd; + pcPositioning: Positioning; + end; +end; + +procedure TResizer.FunnyButtonClick(Sender: TObject); +begin + ShowMessage('Funny button with no functionality!' + + sLineBreak + + sLineBreak + + 'Regards' + + sLineBreak + + 'Maciej Izak' + + sLineBreak + + sLineBreak + 'DaThoX team FreeSparta.com project'); +end; + +end. + diff --git a/components/sparta/dockedformeditor/source/sparta_resizerframe.lfm b/components/sparta/dockedformeditor/source/sparta_resizerframe.lfm new file mode 100644 index 0000000000..c644fa45a8 --- /dev/null +++ b/components/sparta/dockedformeditor/source/sparta_resizerframe.lfm @@ -0,0 +1,188 @@ +object ResizerFrame: TResizerFrame + Left = 0 + Height = 460 + Top = 0 + Width = 320 + ClientHeight = 460 + ClientWidth = 320 + Color = clDefault + ParentColor = False + TabOrder = 0 + object pR: TPanel + AnchorSideTop.Control = Owner + Cursor = crSizeWE + Left = 295 + Height = 443 + Top = 0 + Width = 8 + Anchors = [] + BevelOuter = bvNone + ClientHeight = 443 + ClientWidth = 8 + Color = clNone + ParentColor = False + TabOrder = 0 + object pMarginR: TPanel + AnchorSideLeft.Control = pR + AnchorSideTop.Control = pR + AnchorSideBottom.Control = pR + AnchorSideBottom.Side = asrBottom + Left = 0 + Height = 429 + Top = 7 + Width = 1 + Anchors = [akTop, akLeft, akBottom] + BorderSpacing.Top = 7 + BorderSpacing.Bottom = 7 + BevelOuter = bvNone + Color = clWhite + ParentColor = False + TabOrder = 0 + end + end + object pB: TPanel + AnchorSideLeft.Control = Owner + Cursor = crSizeNS + Left = 0 + Height = 8 + Top = 435 + Width = 303 + Anchors = [akLeft, akRight] + BevelOuter = bvNone + ClientHeight = 8 + ClientWidth = 303 + Color = clNone + ParentColor = False + TabOrder = 1 + object pMarginB: TPanel + AnchorSideLeft.Control = pB + AnchorSideTop.Control = pB + AnchorSideRight.Control = pB + AnchorSideRight.Side = asrBottom + Left = 7 + Height = 1 + Top = 0 + Width = 289 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Left = 7 + BorderSpacing.Right = 7 + TabOrder = 0 + end + end + object pL: TPanel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + Left = 0 + Height = 443 + Top = 0 + Width = 8 + Anchors = [] + BevelOuter = bvNone + ClientHeight = 443 + ClientWidth = 8 + Color = clNone + ParentColor = False + TabOrder = 2 + object pMarginL: TPanel + AnchorSideTop.Control = pL + AnchorSideRight.Control = pL + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = pL + AnchorSideBottom.Side = asrBottom + Left = 7 + Height = 429 + Top = 7 + Width = 1 + Anchors = [akTop, akRight, akBottom] + BorderSpacing.Top = 7 + BorderSpacing.Bottom = 7 + BevelOuter = bvNone + Color = clWhite + ParentColor = False + TabOrder = 0 + end + end + object pT: TPanel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + Left = 0 + Height = 8 + Top = 0 + Width = 303 + Anchors = [akLeft, akRight] + BevelOuter = bvNone + ClientHeight = 8 + ClientWidth = 303 + Color = clNone + ParentColor = False + TabOrder = 3 + object pMarginT: TPanel + AnchorSideLeft.Control = pT + AnchorSideRight.Control = pT + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = pT + AnchorSideBottom.Side = asrBottom + Left = 7 + Height = 1 + Top = 7 + Width = 289 + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Left = 7 + BorderSpacing.Right = 7 + BevelOuter = bvNone + Color = clWhite + ParentColor = False + TabOrder = 0 + end + end + object iResizerLineImg: TImage + Left = 216 + Height = 6 + Top = 32 + Width = 6 + AutoSize = True + Picture.Data = { + 1754506F727461626C654E6574776F726B477261706869639100000089504E47 + 0D0A1A0A0000000D4948445200000006000000060806000000E0CCEF48000000 + 06624B474400FF00FF00FFA0BDA793000000097048597300000EC400000EC401 + 952B0E1B0000000774494D4507DD0A07131110E51DAB140000001E4944415408 + D76358B060C17F06060606749A019BE082050BFE33D04107001B6C33AF54FD1B + 500000000049454E44AE426082 + } + Visible = False + end + object pBG: TPanel + AnchorSideLeft.Control = pL + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = pT + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = pR + AnchorSideBottom.Control = pB + Left = 8 + Height = 427 + Top = 8 + Width = 287 + Anchors = [akTop, akLeft, akRight, akBottom] + BevelOuter = bvNone + Color = clNone + ParentColor = False + TabOrder = 4 + end + object pClient: TPanel + AnchorSideLeft.Control = pL + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = pT + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = pR + AnchorSideBottom.Control = pB + Left = 0 + Height = 152 + Top = 0 + Width = 152 + Anchors = [] + BevelOuter = bvNone + Color = clNone + ParentColor = False + TabOrder = 5 + end +end diff --git a/components/sparta/dockedformeditor/source/sparta_resizerframe.pas b/components/sparta/dockedformeditor/source/sparta_resizerframe.pas new file mode 100644 index 0000000000..1a93a60e69 --- /dev/null +++ b/components/sparta/dockedformeditor/source/sparta_resizerframe.pas @@ -0,0 +1,832 @@ +{ + ***************************************************************************** + See the file COPYING.modifiedLGPL.txt, included in this distribution, + for details about the license. + ***************************************************************************** + + Author: Maciej Izak + + DaThoX 2004-2015 + FreeSparta.com +} + +unit sparta_ResizerFrame; + +{$mode delphi}{$H+} + +interface + +uses + Classes, contnrs, SysUtils, FileUtil, Forms, Controls, ExtCtrls, StdCtrls, Graphics, LCLType, + lclintf, sparta_DesignedForm, Math, FormEditingIntf, PropEdits; + +type + + { TResizerFrame } + TPositioningCode = (pcPositioning, pcPositioningEnd); + TPositioningKind = set of (pkBottom, pkRight); + TPositioningEvent = procedure(Sender: TObject; PositioningKind: TPositioningKind; PositioningCode: TPositioningCode) of object; + + TResizerFrame = class(TFrame) + iResizerLineImg: TImage; + pBG: TPanel; + pB: TPanel; + pClient: TPanel; + pL: TPanel; + pMarginB: TPanel; + pMarginL: TPanel; + pMarginR: TPanel; + pMarginT: TPanel; + pR: TPanel; + pT: TPanel; + procedure sbVerticalScroll(Sender: TObject; ScrollCode: TScrollCode; + var ScrollPos: Integer); + procedure sbHorizontalScroll(Sender: TObject; ScrollCode: TScrollCode; + var ScrollPos: Integer); + public const + SIZER_RECT_SIZE = 8; + SIZER_LINE_WIDTH = 8; + private + FVerticalScrollPos: Integer; + FHorizontalScrollPos: Integer; + FDesignedForm: IDesignedForm; + FBackground: IDesignedFormBackground; + + procedure SetDesignedForm(const AValue: IDesignedForm); + private + { private declarations } + FOnNodePositioning: TPositioningEvent; + FOnHorizontalScroll, FOnVerticalScroll: TScrollEvent; + FLastRightMarign: Integer; + FLastBottomMarign: Integer; + FNodes: TObjectList; + FNodePositioning: Boolean; + FOldPos, FDelta: TPoint; + FPositioningKind: TPositioningKind; + FMaxWidth, FMaxHeight: Integer; + FActivePropertyGridItemIndex: Integer; + FLastClientWidth, FLastClientHeight: Integer; + + procedure PanelPaint(Sender: TObject); + procedure BGChangeBounds(Sender: TObject); + + procedure CreateNodes; + procedure NodeMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); + procedure NodeMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); + procedure NodeMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); + + function GetRightMargin: Integer; + function GetBottomMargin: Integer; + + // dependent on scroll position + // for Vertical + function BottomSizerRectHeight: Integer; + function BottomSizerLineWidth: Integer; + function TopSizerRectTop: Integer; + function TopSizerLineWidth: Integer; + function VerticalSizerLineLength: Integer; + // for Horizontal + function RightSizerRectWidth: Integer; + function RightSizerLineWidth: Integer; + function LeftSizerRectLeft: Integer; + function LeftSizerLineWidth: Integer; + function HorizontalSizerLineLength: Integer; + + function GetBackgroundMargin(const AIndex: Integer): Integer; + + procedure TryBoundDesignedForm; + public + constructor Create(TheOwner: TComponent); override; + destructor Destroy; override; + + property DesignedForm: IDesignedForm read FDesignedForm write SetDesignedForm; + + procedure PositionNodes(AroundControl: TWinControl); + property NodePositioning: Boolean read FNodePositioning; + procedure ClientChangeBounds(Sender: TObject); + + property RightMargin: Integer read GetRightMargin; + property BottomMargin: Integer read GetBottomMargin; + property OnNodePositioning: TPositioningEvent read FOnNodePositioning write FOnNodePositioning; + + property BgLeftMargin: Integer index 0 read GetBackgroundMargin; + property BgTopMargin: Integer index 1 read GetBackgroundMargin; + property BgRightMargin: Integer index 2 read GetBackgroundMargin; + property BgBottomMargin: Integer index 3 read GetBackgroundMargin; + + function DesignedWidthToScroll: Integer; + function DesignedHeightToScroll: Integer; + + procedure HideSizeRects; + procedure HideSizeControls; + procedure ShowSizeRects; + procedure ShowSizeControls; + + property VerticalScrollPos: Integer read FVerticalScrollPos write FVerticalScrollPos; + property HorizontalScrollPos: Integer read FHorizontalScrollPos write FHorizontalScrollPos; + end; + +resourcestring + SArgumentOutOfRange = 'Argument out of range'; + +implementation + +{$R *.lfm} + +{ TResizerFrame } + +// Tiles the source image over the given target canvas +procedure TileImage(const ASource: TImage; ATarget: TCanvas; AX, AY, + AWidth, AHeight: Integer); +var + LX, LY, LDeltaX, LDeltaY: Integer; +begin + LDeltaX := ASource.Width; + LDeltaY := ASource.Height; + LY := 0; + while LY < AHeight do + begin + LX := 0; + while LX < AWidth do + begin + ATarget.Draw(AX + LX, AY + LY, ASource.Picture.graphic); + Inc(LX, LDeltaX); + end; + Inc(LY, LDeltaY); + end; +end; + +procedure TResizerFrame.sbVerticalScroll(Sender: TObject; + ScrollCode: TScrollCode; var ScrollPos: Integer); +begin + if ScrollCode <> scEndScroll then + HideSizeRects + else + ShowSizeRects; + + FVerticalScrollPos := ScrollPos; + + PositionNodes(Self); + + if Assigned(FOnVerticalScroll) + // for refresh from this class, pass sender as nil. + // In other case program will go into infinity loop + and (Sender <> nil) then + FOnVerticalScroll(Sender, ScrollCode, ScrollPos); +end; + +procedure TResizerFrame.sbHorizontalScroll(Sender: TObject; + ScrollCode: TScrollCode; var ScrollPos: Integer); +begin + if ScrollCode <> scEndScroll then + HideSizeRects + else + ShowSizeRects; + + FHorizontalScrollPos := ScrollPos; + + PositionNodes(Self); + + if Assigned(FOnHorizontalScroll) + // for refresh from this class, pass sender as nil. + // In other case program will go into infinity loop + and (Sender <> nil) then + FOnHorizontalScroll(Sender, ScrollCode, ScrollPos); +end; + +procedure TResizerFrame.SetDesignedForm(const AValue: IDesignedForm); +begin + FDesignedForm := AValue; + if FDesignedForm = nil then + FBackground := nil + else + if Supports(FDesignedForm, IDesignedFormBackground, FBackground) then + begin + FBackground.Parent := pBG; + end; + // special for QT (at start "design form" has wrong position) + TryBoundDesignedForm; +end; + +procedure TResizerFrame.PanelPaint(Sender: TObject); +begin + if FNodePositioning then + Exit; + if Sender = pR then + TileImage(iResizerLineImg, pR.Canvas, 0, 0, SIZER_LINE_WIDTH, Height) + else if Sender = pB then + TileImage(iResizerLineImg, pB.Canvas, 0, 0, Width, SIZER_LINE_WIDTH) + else if Sender = pL then + TileImage(iResizerLineImg, pL.Canvas, 0, 0, SIZER_LINE_WIDTH, Height) + else if Sender = pT then + TileImage(iResizerLineImg, pT.Canvas, 0, 0, Width, SIZER_LINE_WIDTH); +end; + +procedure TResizerFrame.ClientChangeBounds(Sender: TObject); +{$IFDEF USE_POPUP_PARENT_DESIGNER} +var + p: TPoint; +{$ENDIF} +begin + if (DesignedForm = nil) or FNodePositioning then + Exit; + + FLastClientWidth := pClient.Width; + FLastClientHeight := pClient.Height; + +(* + DesignedForm.BeginUpdate; + +{$IFDEF USE_POPUP_PARENT_DESIGNER} + p := Point(0, 0); + p := pClient.ClientToScreen(p); + DesignedForm.RealLeft := p.x; + DesignedForm.RealTop := p.y; +{$ELSE} + DesignedForm.RealLeft := 0; + DesignedForm.RealTop := 0; +{$ENDIF} + DesignedForm.RealWidth := pClient.Width; + DesignedForm.RealHeight := pClient.Height; + DesignedForm.EndUpdate; +*) +end; + +procedure TResizerFrame.BGChangeBounds(Sender: TObject); +begin + PositionNodes(Self); +end; + +procedure TResizerFrame.HideSizeRects; +var + p: TObject; + wc: TWinControl absolute p; +begin + for p in FNodes do + if not (wc is TPanel) then + wc.Visible := False; +end; + +procedure TResizerFrame.HideSizeControls; +begin + pL.Repaint; + pT.Repaint; + pR.Repaint; + pB.Repaint; + + HideSizeRects; + pBG.Visible := False; +end; + +procedure TResizerFrame.ShowSizeRects; +var + p: TObject; + wc: TWinControl absolute p; +begin + for p in FNodes do + wc.Visible := True; +end; + +procedure TResizerFrame.ShowSizeControls; +begin + pL.Repaint; + pT.Repaint; + pR.Repaint; + pB.Repaint; + + ShowSizeRects; + pBG.Visible := True; +end; + +procedure TResizerFrame.CreateNodes; +var + Node: Integer; + Panel: TPanel; +begin + for Node := 0 to 7 do + begin + Panel := TPanel.Create(self); + with Panel do + begin + BevelOuter := bvNone; + Color := clBlack; + + Name := 'Node' + IntToStr(Node); + Caption:=''; + Width := SIZER_RECT_SIZE; + Height := SIZER_RECT_SIZE; + Parent := Self; + Visible := True; + FNodes.Add(Panel); + + with TShape.Create(Panel) do + begin + Parent := Panel; + Align:= alClient; + + if Node in [3,4,5] then + Brush.Color:=clBtnFace + else + Brush.Color:=clGray; + + case Node of + {0,}4: Cursor := crSizeNWSE; + {1,}5: Cursor := crSizeNS; + //{2,}6: Cursor := crSizeNESW; + 3{,7}: Cursor := crSizeWE; + end; + if Node in [3,4,5] then + begin + OnMouseDown := NodeMouseDown; + OnMouseMove := NodeMouseMove; + OnMouseUp := NodeMouseUp; + end; + + end; + end; + end; + // extra resizers + pB.OnMouseDown := NodeMouseDown; + pB.OnMouseMove := NodeMouseMove; + pB.OnMouseUp := NodeMouseUp; + + pR.OnMouseDown := NodeMouseDown; + pR.OnMouseMove := NodeMouseMove; + pR.OnMouseUp := NodeMouseUp; + + FNodes.Add(pL); + FNodes.Add(pT); + FNodes.Add(pR); + FNodes.Add(pB); +end; + +procedure TResizerFrame.NodeMouseDown(Sender: TObject; Button: TMouseButton; + Shift: TShiftState; X, Y: Integer); +var + LCtrlPoint: TPoint; +begin + if Sender is TGraphicControl then + Sender := TGraphicControl(Sender).Parent; + + if (Enabled) AND (Sender is TWinControl) then + begin + FNodePositioning:=True; + + // when we start resizing the rules do not apply to us :) + FMaxWidth := Constraints.MaxWidth; + FMaxHeight := Constraints.MaxHeight; + Constraints.MaxWidth := 0; + Constraints.MaxHeight := 0; + with pClient do + begin + Align := alClient; + if pBG.Left + BgLeftMargin <= 0 then + BorderSpacing.Left := Max(-pBG.Left - (FHorizontalScrollPos - SIZER_RECT_SIZE), 0) + else + BorderSpacing.Left := Max(pBG.Left + BgLeftMargin, 0); + + if pBG.Top + BgTopMargin <= 0 then + BorderSpacing.Top := Max(-pBG.Top - (FVerticalScrollPos - SIZER_RECT_SIZE), 0) + else + BorderSpacing.Top := Max(pBG.Top + BgTopMargin, 0); + + BorderSpacing.Right := Max(Self.Width - (pR.Left - BgRightMargin), 0); + BorderSpacing.Bottom := Max(Self.Height - (pB.Top - BgBottomMargin), 0); + end; + + // when was active ActivePropertyGrid.ItemIndex for height or width during scaling + // there was problem with values :< + if ((Sender = pR) or (Sender = pB) or (FNodes.IndexOf(Sender) in [3,4,5])) and (FormEditingHook.GetCurrentObjectInspector <> nil) then + begin + FActivePropertyGridItemIndex := FormEditingHook.GetCurrentObjectInspector.GetActivePropertyGrid.ItemIndex; + FormEditingHook.GetCurrentObjectInspector.GetActivePropertyGrid.ItemIndex := -1; + end + else + FActivePropertyGridItemIndex := -1; + + {$IF Defined(LCLWin32) or Defined(LCLWin64)} + SetCapture(TWinControl(Sender).Handle); + {$ENDIF} + GetCursorPos(FOldPos); + // perform first "click delta" to reduce leap + // + calculate delta created by scrollbars and theirs position... + FillChar(FDelta, SizeOf(FDelta), #0); + LCtrlPoint := (Sender as TWinControl).ScreenToClient(Mouse.CursorPos); + if Sender = pR then + begin + FDelta.X := -(LCtrlPoint.x - RightSizerLineWidth) + RightMargin; + FPositioningKind := [pkRight]; + end + else if Sender = pB then + begin + FDelta.Y := -(LCtrlPoint.y - BottomSizerLineWidth) + BottomMargin; + FPositioningKind := [pkBottom]; + end + else + case FNodes.IndexOf(Sender) of + 3: // middle right + begin + FDelta.X := -(LCtrlPoint.x - RightSizerRectWidth) + RightMargin; + FPositioningKind := [pkRight]; + end; + 4: // right bottom + begin + FDelta.X := -(LCtrlPoint.x - RightSizerRectWidth) + RightMargin; + FDelta.Y := -(LCtrlPoint.y - BottomSizerRectHeight) + BottomMargin; + FPositioningKind := [pkRight, pkBottom]; + end; + 5: // middle bottom + begin + FDelta.Y := -(LCtrlPoint.y - BottomSizerRectHeight) + BottomMargin; + FPositioningKind := [pkBottom]; + end; + end; + end; +end; + +procedure TResizerFrame.NodeMouseMove(Sender: TObject; Shift: TShiftState; X, + Y: Integer); +var + newPos: TPoint; + frmPoint : TPoint; + OldRect: TRect; + AdjL,AdjR,AdjT,AdjB: Boolean; +begin + // handle TPanel for resizing rectangles + if Sender is TGraphicControl then + Sender := TGraphicControl(Sender).Parent; + + if FNodePositioning then + begin + begin + with TWinControl(Sender) do + begin + GetCursorPos(newPos); + + if (newPos.x = FOldPos.x) and (newPos.y = FOldPos.y) then + Exit; + + HideSizeControls; + + with Self do + begin //resize + frmPoint := Self.ScreenToClient(Mouse.CursorPos); + frmPoint.x:= frmPoint.x + FDelta.x; + frmPoint.y:= frmPoint.y + FDelta.y; + + OldRect := Self.BoundsRect; + AdjL := False; + AdjR := False; + AdjT := False; + AdjB := False; + case FNodes.IndexOf(TWinControl(Sender)) of + 0: begin + //AdjL := True; + //AdjT := True; + end; + 1: begin + //AdjT := True; + end; + 2: begin + //AdjR := True; + //AdjT := True; + end; + 3, 10: begin + AdjR := True; + end; + 4: begin + AdjR := True; + AdjB := True; + end; + 5, 11: begin + AdjB := True; + end; + 6: begin + //AdjL := True; + //AdjB := True; + end; + 7: begin + //AdjL := True; + end; + end; + + if AdjL then + OldRect.Left := frmPoint.X; + if AdjR then + OldRect.Right := frmPoint.X; + if AdjT then + OldRect.Top := frmPoint.Y; + if AdjB then + OldRect.Bottom := frmPoint.Y; + + SetBounds(OldRect.Left,OldRect.Top,OldRect.Right - OldRect.Left,OldRect.Bottom - OldRect.Top); + end; + //move node + Left := Left - FOldPos.X + newPos.X; + Top := Top - FOldPos.Y + newPos.Y; + FOldPos := newPos; + end; + end; + PositionNodes(Self); + if Assigned(OnNodePositioning) then + OnNodePositioning(Self, FPositioningKind, pcPositioning); + + // the same operation as belowe exist in ClientChangeBounds but it is + // disabled for FNodePositioning = true + // we need to refresh this values after OnNodePositioning + FLastClientWidth := pClient.Width; + FLastClientHeight:= pClient.Height; + end; +end; + +procedure TResizerFrame.NodeMouseUp(Sender: TObject; Button: TMouseButton; + Shift: TShiftState; X, Y: Integer); +begin + if Sender is TGraphicControl then + Sender := TGraphicControl(Sender).Parent; + + if FNodePositioning then + begin + Screen.Cursor := crDefault; + {$IF Defined(LCLWin32) or Defined(LCLWin64)} + ReleaseCapture; + {$ENDIF} + + // restore last selected item in OI. + if FActivePropertyGridItemIndex <> -1 then + begin + if FormEditingHook.GetCurrentObjectInspector <> nil then + FormEditingHook.GetCurrentObjectInspector.GetActivePropertyGrid.ItemIndex := FActivePropertyGridItemIndex; + FActivePropertyGridItemIndex := -1; + end; + + Constraints.MaxWidth := FMaxWidth; + Constraints.MaxHeight := FMaxHeight; + FNodePositioning := False; + ShowSizeControls; + if Assigned(OnNodePositioning) then + OnNodePositioning(Sender, FPositioningKind, pcPositioningEnd); + FPositioningKind := []; + + pClient.Align := alNone; + BorderSpacing.Left := 0; + BorderSpacing.Top := 0; + BorderSpacing.Right := 0; + BorderSpacing.Bottom := 0; + PositionNodes(Self); + + GlobalDesignHook.RefreshPropertyValues; + + // after resizing, TFrame is frozen in Windows OS + // this is trick to workaraund IDE bug. Also for proper size for normal form + TryBoundDesignedForm; + end; +end; + +function TResizerFrame.GetRightMargin: Integer; +begin + if not FNodePositioning then + FLastRightMarign := Width - (pR.Left + pR.Width); + Result := FLastRightMarign; +end; + +function TResizerFrame.GetBottomMargin: Integer; +begin + if not FNodePositioning then + FLastBottomMarign := Height - (pB.Top + pB.Height); + Result := FLastBottomMarign; +end; + +{----------------------------------------------------------------------------------------------------------------------- + for Vertical scroll +{----------------------------------------------------------------------------------------------------------------------} + +function TResizerFrame.BottomSizerRectHeight: Integer; +begin + Result := SIZER_RECT_SIZE; +end; + +function TResizerFrame.BottomSizerLineWidth: Integer; +begin + Result := SIZER_LINE_WIDTH; +end; + +function TResizerFrame.TopSizerRectTop: Integer; +begin + Result := -FVerticalScrollPos; +end; + +function TResizerFrame.TopSizerLineWidth: Integer; +begin + Result := SIZER_LINE_WIDTH; +end; + +function TResizerFrame.VerticalSizerLineLength: Integer; +begin + Result := Height - BottomMargin; +end; + +{----------------------------------------------------------------------------------------------------------------------- + for Horizontal scroll +{----------------------------------------------------------------------------------------------------------------------} + +function TResizerFrame.RightSizerRectWidth: Integer; +begin + Result := SIZER_RECT_SIZE; +end; + +function TResizerFrame.RightSizerLineWidth: Integer; +begin + Result := SIZER_LINE_WIDTH; +end; + +function TResizerFrame.LeftSizerRectLeft: Integer; +begin + Result := -FHorizontalScrollPos; +end; + +function TResizerFrame.LeftSizerLineWidth: Integer; +begin + Result := SIZER_LINE_WIDTH; +end; + +function TResizerFrame.HorizontalSizerLineLength: Integer; +begin + Result := Width - RightMargin; +end; + +function TResizerFrame.GetBackgroundMargin(const AIndex: Integer): Integer; +begin + if FBackground = nil then + Result := 0 + else + Result := FBackground.GetMargin(AIndex); +end; + +procedure TResizerFrame.TryBoundDesignedForm; +begin + if DesignedForm = nil then + Exit; + + DesignedForm.BeginUpdate; + DesignedForm.RealWidth := DesignedForm.RealWidth + 1; + DesignedForm.RealWidth := DesignedForm.RealWidth - 1; + DesignedForm.EndUpdate; + + HideSizeControls; + ShowSizeControls; + + // for GTK2 resizing form (pClient is hidden under pBG) + {$IF DEFINED(LCLGtk2) OR DEFINED(LCLQt)} + pClient.SendToBack; // <--- this is a must. + {$ENDIF} + pClient.BringToFront; +end; + +function TResizerFrame.DesignedWidthToScroll: Integer; +begin + if DesignedForm = nil then + Exit(0); + + Result := DesignedForm.Width - FLastClientWidth; + //Result := DesignedForm.Width - DesignedForm.RealWidth; +end; + +function TResizerFrame.DesignedHeightToScroll: Integer; +begin + if DesignedForm = nil then + Exit(0); + + Result := DesignedForm.Height - FLastClientHeight; + //Result := DesignedForm.Height - DesignedForm.RealHeight; +end; + +{} + +constructor TResizerFrame.Create(TheOwner: TComponent); +begin + inherited Create(TheOwner); + + FNodes := TObjectList.Create(False); + CreateNodes; + + pL.OnPaint := PanelPaint; + pT.OnPaint := PanelPaint; + pR.OnPaint := PanelPaint; + pB.OnPaint := PanelPaint; + + pClient.OnChangeBounds := ClientChangeBounds; + pBG.OnChangeBounds := BGChangeBounds; + PositionNodes(Self); +end; + +destructor TResizerFrame.Destroy; +begin + FNodes.Free; + inherited Destroy; +end; + +procedure TResizerFrame.PositionNodes(AroundControl: TWinControl); +var + Node,T,L,CT,CL,FR,FB,FT,FL: Integer; + TopLeft: TPoint; +begin + if FDesignedForm = nil then + Exit; + + // positions of bars + if not FNodePositioning then + begin + pL.Left := -FHorizontalScrollPos; + pR.Left := FDesignedForm.Width - FHorizontalScrollPos + pL.Width + BgRightMargin + BgLeftMargin; + pT.Top := -FVerticalScrollPos; + pB.Top := FDesignedForm.Height - FVerticalScrollPos + pT.Height + BgBottomMargin + BgTopMargin; + + // width and height + pL.Top:=0; + pL.Height := FDesignedForm.Height + 2*SIZER_RECT_SIZE + BgTopMargin + BgBottomMargin; + pR.Top:=0; + pR.Height := FDesignedForm.Height + 2*SIZER_RECT_SIZE + BgTopMargin + BgBottomMargin; + pT.Left:=0; + pT.Width := FDesignedForm.Width + 2*SIZER_RECT_SIZE + BgLeftMargin + BgRightMargin; + pB.Left:=0; + pB.Width := FDesignedForm.Width + 2*SIZER_RECT_SIZE + BgLeftMargin + BgRightMargin; + + // client + if pBG.Left + BgLeftMargin <= 0 then + pClient.Left := -(pBG.Left) - (FHorizontalScrollPos - SIZER_RECT_SIZE) + else + pClient.Left := pBG.Left + BgLeftMargin; + if pBG.Top + BgTopMargin <= 0 then + pClient.Top := -(pBG.Top) - (FVerticalScrollPos - SIZER_RECT_SIZE) + else + pClient.Top := pBG.Top + BgTopMargin; + + pClient.Height := Height - pClient.Top - Max(Height - (pB.Top - BgBottomMargin), 0); + pClient.Width := Width - pClient.Left - Max(Width - (pR.Left - BgRightMargin), 0); + end; + + for Node := 0 to 7 do + begin + with AroundControl do + begin + FR := Width - RightSizerRectWidth - RightMargin; + FB := Height - BottomSizerRectHeight - BottomMargin; + + FT := TopSizerRectTop; + FL := LeftSizerRectLeft; + + CL := (FR - FL) div 2 + FL; + CT := (FB - FT) div 2 + FT; + + case Node of + 0: begin + T := FT; + L := FL; + end; + 1: begin + T := FT; + L := CL; + end; + 2: begin + T := FT; + L := FR; + end; + 3: begin + T := CT; + L := FR; + end; + 4: begin + T := FB; + L := FR; + end; + 5: begin + T := FB; + L := CL; + end; + 6: begin + T := FB; + L := FL; + end; + 7: begin + T := CT; + L := FL; + end; + else + T := 0; + L := 0; + end; + + TopLeft := (Classes.Point(L,T)); + end; + with TPanel(FNodes[Node]) do + begin + Top := TopLeft.Y; + Left := TopLeft.X; + Repaint; + end; + end; +end; + +end. + diff --git a/components/sparta/dockedformeditor/source/spartaapi.pas b/components/sparta/dockedformeditor/source/spartaapi.pas new file mode 100644 index 0000000000..2cdb9f2390 --- /dev/null +++ b/components/sparta/dockedformeditor/source/spartaapi.pas @@ -0,0 +1,123 @@ +{ + ***************************************************************************** + See the file COPYING.modifiedLGPL.txt, included in this distribution, + for details about the license. + ***************************************************************************** + + Author: Maciej Izak + + DaThoX 2004-2015 + FreeSparta.com +} + +unit SpartaAPI; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, Forms, Controls; + +type + IResizer = interface + ['{C3D1A2C0-8AED-493B-9809-1F5C3A54A8A8}'] + procedure TryBoundSizerToDesignedForm(Sender: TObject); + end; + + + ISTADesignTimeUtil = interface + ['{E135BF89-AFA9-402A-9663-4F1536C7717A}'] + function GetRoot: TPersistent; + procedure SetRoot(ARoot: TPersistent); + + property Root: TPersistent read GetRoot write SetRoot; + end; + + // Sparta Tools API + ISTAMainDesignTimeUtil = interface(ISTADesignTimeUtil) + ['{53491607-D285-4050-9064-C764EB8E59B9}'] + function GetShowNonVisualComponents: Boolean; + property ShowNonVisualComponents: Boolean read GetShowNonVisualComponents; + end; + + ISTANonVisualComponentsUtil = interface(ISTADesignTimeUtil) + ['{A181688F-572E-4724-AAF1-575B979A1EC2}'] + function GetShowNonVisualComponents: Boolean; + property ShowNonVisualComponents: Boolean read GetShowNonVisualComponents; + end; + + ISTAExtendedDesignTimeUtil = interface(ISTADesignTimeUtil) + ['{1F484121-2295-4847-BFD9-A77C643EA3A7}'] + // TODO OnShow + // TODO OnHide + // TODO UpdateRoot + // TODO FreeOnStrongHide...? free mem for some utils + procedure RefreshValues; + + procedure SetParent(AWinCtrl: TWinControl); + function GetParent: TWinControl; + procedure SetVisible(AValue: Boolean); + function GetVisible: Boolean; + + property Visible: Boolean read GetVisible write SetVisible; + property Parent: TWinControl read GetParent write SetParent; + end; + + TSTADesignTimeUtil = class + + end; + + TSTADesignTimeUtilClass = class of TSTADesignTimeUtil; + + TEDTU = class + public + class function AvailableForRoot(ARoot: TPersistent): Boolean; virtual; abstract; + class function CreateEDTUForRoot(TheOwner: TComponent; ARoot: TPersistent): ISTAExtendedDesignTimeUtil; virtual; abstract; + class function GlyphName: string; virtual; abstract; + end; + + TEDTUClass = class of TEDTU; + + { TSTADesignTimeUtilsManager } + + TSTADesignTimeUtilsManager = class + protected + function GetEDTUCount: Integer; virtual; + function GetEDTU(Index: Integer): TEDTUClass; virtual; abstract; + public + function CreateMainDTU(AParent, AAddons: TWinControl): ISTAMainDesignTimeUtil; virtual; + procedure RegisterEDTU(AEDTUClass: TEDTUClass); virtual; + procedure UnregisterEDTU(AEDTUClass: TEDTUClass); virtual; + property EDTUCount: Integer read GetEDTUCount; + property EDTU[Index: Integer]: TEDTUClass read GetEDTU; + end; + +var + DTUManager: TSTADesignTimeUtilsManager = nil; + +implementation + +{ TSTADesignTimeUtilsManager } + +function TSTADesignTimeUtilsManager.GetEDTUCount: Integer; +begin + Result := 0; +end; + +function TSTADesignTimeUtilsManager.CreateMainDTU(AParent, AAddons: TWinControl + ): ISTAMainDesignTimeUtil; +begin + Result := nil; +end; + +procedure TSTADesignTimeUtilsManager.RegisterEDTU(AEDTUClass: TEDTUClass); +begin +end; + +procedure TSTADesignTimeUtilsManager.UnregisterEDTU(AEDTUClass: TEDTUClass); +begin +end; + +end. + diff --git a/components/sparta/dockedformeditor/sparta_dockedformeditor.lpk b/components/sparta/dockedformeditor/sparta_dockedformeditor.lpk new file mode 100644 index 0000000000..26588a7441 --- /dev/null +++ b/components/sparta/dockedformeditor/sparta_dockedformeditor.lpk @@ -0,0 +1,84 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/components/sparta/dockedformeditor/sparta_dockedformeditor.pas b/components/sparta/dockedformeditor/sparta_dockedformeditor.pas new file mode 100644 index 0000000000..25bc6316e6 --- /dev/null +++ b/components/sparta/dockedformeditor/sparta_dockedformeditor.pas @@ -0,0 +1,25 @@ +{ This file was automatically created by Lazarus. Do not edit! + This source is only used to compile and install the package. + } + +unit sparta_DockedFormEditor; + +interface + +uses + sparta_reg_DockedFormEditor, sparta_DesignedForm, sparta_Resizer, + sparta_ResizerFrame, SpartaAPI, sparta_FakeCustom, sparta_FakeForm, + sparta_FakeFrame, sparta_FakeNonControl, sparta_MainIDE, sparta_HashUtils, + LazarusPackageIntf; + +implementation + +procedure Register; +begin + RegisterUnit('sparta_reg_DockedFormEditor', + @sparta_reg_DockedFormEditor.Register); +end; + +initialization + RegisterPackage('sparta_DockedFormEditor', @Register); +end.