mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-12-07 07:57:13 +01:00
Move Sparta DockedFormEditor package from freesparta branch to trunk.
git-svn-id: trunk@50411 -
This commit is contained in:
juha
parent
5154a0d95b
commit
951fac1216
14
.gitattributes
vendored
14
.gitattributes
vendored
@ -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
|
||||
|
||||
@ -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.
|
||||
|
||||
1045
components/sparta/dockedformeditor/source/sparta_fakecustom.pas
Normal file
1045
components/sparta/dockedformeditor/source/sparta_fakecustom.pas
Normal file
File diff suppressed because it is too large
Load Diff
215
components/sparta/dockedformeditor/source/sparta_fakeform.pas
Normal file
215
components/sparta/dockedformeditor/source/sparta_fakeform.pas
Normal file
@ -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.
|
||||
|
||||
@ -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.
|
||||
|
||||
@ -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.
|
||||
|
||||
@ -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.
|
||||
|
||||
1713
components/sparta/dockedformeditor/source/sparta_mainide.pas
Normal file
1713
components/sparta/dockedformeditor/source/sparta_mainide.pas
Normal file
File diff suppressed because it is too large
Load Diff
@ -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.
|
||||
|
||||
452
components/sparta/dockedformeditor/source/sparta_resizer.pas
Normal file
452
components/sparta/dockedformeditor/source/sparta_resizer.pas
Normal file
@ -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.
|
||||
|
||||
@ -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
|
||||
@ -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.
|
||||
|
||||
123
components/sparta/dockedformeditor/source/spartaapi.pas
Normal file
123
components/sparta/dockedformeditor/source/spartaapi.pas
Normal file
@ -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.
|
||||
|
||||
@ -0,0 +1,84 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<CONFIG>
|
||||
<Package Version="4">
|
||||
<PathDelim Value="\"/>
|
||||
<Name Value="sparta_DockedFormEditor"/>
|
||||
<Type Value="RunAndDesignTime"/>
|
||||
<CompilerOptions>
|
||||
<Version Value="11"/>
|
||||
<PathDelim Value="\"/>
|
||||
<SearchPaths>
|
||||
<IncludeFiles Value="source"/>
|
||||
<OtherUnitFiles Value="source"/>
|
||||
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)\$(LCLWidgetType)"/>
|
||||
</SearchPaths>
|
||||
<Linking>
|
||||
<Debugging>
|
||||
<UseValgrind Value="True"/>
|
||||
<UseExternalDbgSyms Value="True"/>
|
||||
</Debugging>
|
||||
</Linking>
|
||||
<Other>
|
||||
<CustomOptions Value="$(IDEBuildOptions)"/>
|
||||
</Other>
|
||||
</CompilerOptions>
|
||||
<Files Count="11">
|
||||
<Item1>
|
||||
<Filename Value="source\sparta_reg_dockedformeditor.pas"/>
|
||||
<HasRegisterProc Value="True"/>
|
||||
<UnitName Value="sparta_reg_DockedFormEditor"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<Filename Value="source\sparta_designedform.pas"/>
|
||||
<UnitName Value="sparta_DesignedForm"/>
|
||||
</Item2>
|
||||
<Item3>
|
||||
<Filename Value="source\sparta_resizer.pas"/>
|
||||
<UnitName Value="sparta_Resizer"/>
|
||||
</Item3>
|
||||
<Item4>
|
||||
<Filename Value="source\sparta_resizerframe.pas"/>
|
||||
<UnitName Value="sparta_ResizerFrame"/>
|
||||
</Item4>
|
||||
<Item5>
|
||||
<Filename Value="source\spartaapi.pas"/>
|
||||
<UnitName Value="SpartaAPI"/>
|
||||
</Item5>
|
||||
<Item6>
|
||||
<Filename Value="source\sparta_fakecustom.pas"/>
|
||||
<UnitName Value="sparta_FakeCustom"/>
|
||||
</Item6>
|
||||
<Item7>
|
||||
<Filename Value="source\sparta_fakeform.pas"/>
|
||||
<UnitName Value="sparta_FakeForm"/>
|
||||
</Item7>
|
||||
<Item8>
|
||||
<Filename Value="source\sparta_fakeframe.pas"/>
|
||||
<UnitName Value="sparta_FakeFrame"/>
|
||||
</Item8>
|
||||
<Item9>
|
||||
<Filename Value="source\sparta_fakenoncontrol.pas"/>
|
||||
<UnitName Value="sparta_FakeNonControl"/>
|
||||
</Item9>
|
||||
<Item10>
|
||||
<Filename Value="source\sparta_mainide.pas"/>
|
||||
<UnitName Value="sparta_MainIDE"/>
|
||||
</Item10>
|
||||
<Item11>
|
||||
<Filename Value="source\sparta_hashutils.pas"/>
|
||||
<UnitName Value="sparta_HashUtils"/>
|
||||
</Item11>
|
||||
</Files>
|
||||
<RequiredPkgs Count="1">
|
||||
<Item1>
|
||||
<PackageName Value="IDEIntf"/>
|
||||
</Item1>
|
||||
</RequiredPkgs>
|
||||
<UsageOptions>
|
||||
<UnitPath Value="$(PkgOutDir)"/>
|
||||
</UsageOptions>
|
||||
<PublishOptions>
|
||||
<Version Value="2"/>
|
||||
</PublishOptions>
|
||||
</Package>
|
||||
</CONFIG>
|
||||
@ -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.
|
||||
Loading…
Reference in New Issue
Block a user