Class TFormEditor2 (unit Fedit2) |
Inherits from
TFormDesigner
Constructor Create;
Procedure AddSelection(Component : TComponent);
Procedure ClearSelection;
Procedure CommitChanges;
Procedure Copy;
Procedure Cut;
This used to be complicted
Procedure Delete;
designer.
Destructor Destroy;
Procedure DrawAllHandles(Visible : Boolean);
Procedure DrawHandles(Component : TComponent; Visible : Boolean);
for partially edited properties
Procedure DrawTags(Component : TComponent; Visible : Boolean; Single : Boolean);
Procedure EmergencyQuit;
Procedure FixTags(Component : TComponent; Visible : Boolean);
Convert tags on only component to mark tags
Procedure GetDesignerFocus;
otherwise commit is auto
Function GetEditableComponent(Component : TComponent) : TComponent;
Return a valid name suitable for assign to the component
Function InSelection(Component : TComponent) : Boolean;
Procedure LooseDesignerFocus(Commit : Boolean);
Now if we are object inspected do a Modified } { Maybe do anyway incase it affected lots of things
Procedure MenuAlign(Sender : TObject);
Procedure MenuBringToFront(Sender : TObject);
Note we rounded width and height not bottom and right, but its all the same.
Procedure MenuGridSpacing(Sender : TObject);
Procedure MenuSendToBack(Sender : TObject);
Bring in opposite selection Order so we preserve Z Order from selection order } {SAMFIX parents only or all selected components.
Procedure NewSelection(Component : TComponent);
Add half the grid spacing, then subtract mod the spacing
Procedure Paste;
Cannot do this! Not till we are loaded! } { Cos fixups aren't done yet } { FreakAutoParents(Component,PasteControl);
Procedure PrepareInsert(ComponentClass : TComponentClass);
Procedure RefreshAllHandles;
We now need to draw in DrawRect in DrawControl
Procedure RemoveSelection(Component : TComponent);
Procedure ShowHandles(Visible : Boolean);
Procedure SizeMessage;
Procedure StartEdit(Stream : TStream; EditName : TFilename; FileHandle : Integer);
Procedure StopEdit;
file can be null Remove control everything that is owned by tempowner, and delete it!
Procedure ToggleSelection(Component : TComponent);
Procedure AddMenuItem(Caption : String; Tag : Longint; Callback : TNotifyEvent);
Procedure AlignPointToGrid(var Point : TPoint);
Procedure CalculateParents;
Function CanBeFreaked(Component : TComponent) : Boolean;
Procedure CheckFreakers;
we have actual component, and visual representation } { Candidate is a candidate for parent
Procedure ClipCursor;
Form.
function CreateMethod(const Name: string; TypeData: PTypeData): TMethod;
Not done seriously we have to do something here.
Procedure DoDefaultEdit;
NOTE: These last changes may have broken earlier conditions, but so what } { we did our best.
Procedure DoFocusrect(Component : TComponent);
So as to move only by integer grids } { This is in line with the Delphi form designer, when moving, don't move TO } { grid points, but BY grid points
Procedure DoMoveComponent(Component : TComponent);
Procedure DoMovedComponent(Component : TComponent);
Procedure DoMoving;
Procedure DoPopupMenu;
Procedure DoSizeComponent(Component : TComponent);
Procedure DoSizedComponent(Component : TComponent);
Procedure DoSizeRect;
Procedure DoSizing(Component : TComponent);
Procedure DrawRectangle(Rectangle : TRect);
Result is now the control we can move
Procedure EditComponents;
a component - well well
Procedure EditLButtonDblClk(var Msg: TMessage; var Handled: Boolean);
Procedure EditLButtonDown(var Msg: TMessage; var Handled: Boolean);
Procedure EditLButtonUp(var Msg: TMessage; var Handled: Boolean);
Popup the menu
Procedure EditMouseMove(var Msg: TMessage; var Handled: Boolean);
Plot point
Procedure EditRButtonDown(var Msg: TMessage; var Handled: Boolean);
somehow some messages are slipping though, and why would we not have handled them all?
Procedure EditRButtonUp(var Msg: TMessage; var Handled: Boolean);
Procedure EndInsert;
Procedure FillGridRecordDefaults(var Grid : TGridrecord);
that 1 is me; not quite dead yet
Function FindHolder(AComponent : TComponent) : TControl;
Never designing or our hint line won't work } { we hand wndproc to parent form by hand
Procedure FixPosition(Control : TControl);
Bring in opposite selection Order so we preserve Z Order from selection order } {SAMFIX parents only or all selected components.
Procedure FixZOrder;
Make sure handles and holders are always on top
procedure ForceValidName(Reader: TReader; Component: TComponent; var Name: string);
Procedure formSizePosChanged;
Procedure ForParentSelection(Proc : TComponentProc);
Procedure ForSelection(Proc : TComponentProc);
Procedure FreakAutoParents(Component : TComponent; Candidate : TWinControl; Map : Boolean);
FreakAuto parents is called when a component is newly inserted } { but after fixups are fixed } { we try and freak to the freak property first, if that is nil } { THEN we freak to the candidate
Procedure FreaknewFreakers(PasteControl : TWiNControl);
If freak property is not equal to parent then change parent to freak property } { ubless property is nill, then set parent to form
Procedure FreeComponentEditor;
This is usually done by Inspector
Function GetFreakInfo(Component : TComponent) : string;
SAMFIX not exactly MODIFIED but something to cause people to know the filename has changed
Function GetHandleRect(HandleType : THandleType; Component : TComponent) : TRect;
Function GetMainComponent : TComponent;
Function GetMainControl : TControl;
function GetMethodName(const Method: TMethod): string;
procedure GetMethods(TypeData: PTypeData; Proc: TGetStrProc);
Function GetPrivateDirectory : String;
Function GetValidName(Component : TComponent; OldName : String) : String;
New ones
Procedure GoingPlural;
Convert tags on remaining component to drag tags
Procedure GoingSingle;
Now Clip with ClientRect of form.
Procedure InsertTempControls(MakeHolders : Boolean);
set Left and Top to match designinfo
Function IsDesignMsg(Control: TControl; var Message: TMessage): Boolean;
A list of components bing pasted to be AutoFreaked together after fixups } { Inherited ones This is where we intercept messages BY COOPERATION of the DELPHI VCL
Procedure MakeDesigning(Component : TComponent);
This one is an event handler Writeln('ShowMethod ',name);
Function MakeHolder(AComponent : TComponent) : TComponentHolder;
Procedure MakeNotDesigning(Component : TComponent);
function MethodExists(const Name: string): Boolean;
Procedure Modified;
Procedure ModifiedForm;
only renew if we are current } { Make handles match new positions
Procedure MoveInsert;
Procedure MoveSelecting;
Procedure Notification(AComponent: TComponent; Operation: TOperation);
Procedure PaintFormGrid(Form : TForm; Grid : TGridRecord);
Procedure PaintGrid;
well we can't deal with it here, post a similar message to the main form
Procedure PerformVerb(Sender : TObject);
Now we can add our menu Options
Procedure prepareFreakers;
Procedure PrepareHolders;
scan all components and test for freaking } { any non-visual will have their holders by now
Procedure PrepareMoving;
Procedure ReadComponentsFromStream(Stream : TMemoryStream; Owner, Parent : TComponent);
can do >64K
procedure ReadedForPaste(Component: TComponent);
Function RealizeControl(Control : TControl) : TControl;
Procedure IdentifyControls(TempWinControl : TWinControl; Pos : TPoint); LockWindowUpdate(0);
Function RealizePasteControl(Control : TControl) : TWinControl;
Procedure RemoveTempControls;
Must be a component, crdate a holder for it
procedure RenameMethod(const CurName, NewName: string);
Procedure SetEditState(Value : TEditState);
They don't
Procedure SetEditStateIdle;
Procedure SetFilename(Value : TFilename);
Make the inspector point to us
Procedure SetShowHandles(Value : Boolean);
Function ShowingHandles : Boolean;
procedure ShowMethod(const Name: string);
Function SizeRect(Rectangle : TRect; Offset : TPoint) : TRect;
Procedure StartInsert(var Msg: TMessage; var Handled: Boolean);
Default edit on component editor
Procedure StartMoving;
So we get the full delta effect now!
Procedure StartSelecting;
Procedure StartSizing(Component : TComponent);
Procedure StopMoving;
Procedure StopSelecting;
Procedure StopSizing(Component : TComponent);
Procedure StreamFromClipboard(Stream : TMemoryStream);
Procedure StreamToClipboard(Stream : TMemoryStream);
This does >64K
Function tryFreak(Component : TComponent; Visual : TControl; Candidate : TWinControl;
TryInternal : Boolean; MapCoords : Boolean) : Boolean;
Procedure UnClipCursor;
Procedure UpdateAll(WinControl : TWinControl);
Procedure DelayPaintHandles(PaintControl : TControl); otherwise we have no interest! This test is important as we } { will get called for SubComponents of TArrays etc and mayhap notebooks!
Procedure UpdateMoveOffsets;
Now iterate over controls and offset each one by point
Function ValidatePasteControl(Control : TWinControl) : TWinControl;
Now pop up levels until we find csAcceptControls } { This will always happen at FORm level
Procedure ValidateRename(AComponent: TComponent; const CurName, NewName: string);
There may be other fields which require zero'ing as below
Procedure WaitForMove;
property ComponentList : TList
property Destroying : Boolean
property Filehandle : Integer
property FileName : TFileName
property FormModified : Boolean
property MainComponent : TComponent
property MainControl : TControl
property MessageControl : TControl
property OptShowHandles : Boolean
property PointInForm : TPoint
property PointInScreen : TPoint
property SizingHandle : THandleType
property EditState : TEditState
Sticks FSelectedComponents in FSelectedParents except those who have parents selected
property VisibleHandles : Boolean
FAreaRectangle : TRect;
FAutoHolder : Boolean;
A file handle assoicated with the form
FComponentClass : TComponentClass;
FComponentEditor : TComponentEditor;
To OWN handles and such
FDestroying : Boolean;
FEditState : TEditState;
grid settings
FFileHandle : Integer;
FFileName : TFileName;
FFormloaded : Boolean;
FFormModified : Boolean;
false until we have finished loading
FFreakClassRules : TStringList;
relates to non-form parents of Components
FFreakers : TList;
Just been read by ReadComponents
FFreakRules : TIniFile;
FGrid : TGridRecord;
as above
FLastHolder : TComponentHolder;
FSelectedComponents excluding those whose parents are selected
FMessageControl : TControl;
A TControl owned by TForm and child of UseWinControl
FMoveDelta : TPoint;
Where move started from (for Coords)
FMoveOffset : TPoint;
Increment for last mouse mouse move
FMoveStart : TPoint;
Screen based coordinates
FNewFreakers : TList;
list of components whose autoparents need checking every designer.
FOldCursorrect : TRect;
Difference on previous go
FOldMoveOffset : TPoint;
Difference between current mouse and start move
FPasteControl : TWinControl;
To store and restore cursor slip rect } { FApplicationOnMessage : TMessageEvent;
FPastedComponent : TComponent;
Last holder make automatically by notification
FPointInForm : TPoint;
Region being selected by mouse
FPointInScreen : TPoint;
Form based co-ords of mouse message
FPopUpMenu : TPopupMenu;
FSelectedComponents : TList;
FSelectedParents : TList;
All components selected
FShowHandles : Boolean;
when true non controls inserted cause a holder to be created auto
FSizeHandles : Array[0..7] of TXControlHandle;
FSizingHandle : THandleType;
FTempOwner : TComponent;
FUseControl : TControl;
Control to paste into
FVisibleHandles : Boolean;
to insert a new component
Constructor Create;
Procedure AddSelection(Component : TComponent);
Procedure ClearSelection;
Procedure CommitChanges;
Procedure Copy;
Procedure Cut;
This used to be complicted
Procedure Delete;
designer.modified
Destructor Destroy;
Procedure DrawAllHandles(Visible : Boolean);
Procedure DrawHandles(Component : TComponent; Visible : Boolean);
for partially edited properties
Procedure DrawTags(Component : TComponent; Visible : Boolean; Single : Boolean);
Procedure EmergencyQuit;
Procedure FixTags(Component : TComponent; Visible : Boolean);
Convert tags on only component to mark tags
Procedure GetDesignerFocus;
otherwise commit is auto
Function GetEditableComponent(Component : TComponent) : TComponent;
Return a valid name suitable for assign to the component
Function InSelection(Component : TComponent) : Boolean;
Procedure LooseDesignerFocus(Commit : Boolean);
Now if we are object inspected do a Modified } { Maybe do anyway incase it affected lots of things
Procedure MenuAlign(Sender : TObject);
Procedure MenuBringToFront(Sender : TObject);
Note we rounded width and height not bottom and right, but its all the same...
Procedure MenuGridSpacing(Sender : TObject);
Procedure MenuSendToBack(Sender : TObject);
Bring in opposite selection Order so we preserve Z Order from selection order } {SAMFIX parents only or all selected components.... hmmm....
Procedure NewSelection(Component : TComponent);
Add half the grid spacing, then subtract mod the spacing
Procedure Paste;
Cannot do this! Not till we are loaded! } { Cos fixups aren't done yet } { FreakAutoParents(Component,PasteControl);
Procedure PrepareInsert(ComponentClass : TComponentClass);
Procedure RefreshAllHandles;
We now need to draw in DrawRect in DrawControl
Procedure RemoveSelection(Component : TComponent);
Procedure ShowHandles(Visible : Boolean);
Procedure SizeMessage;
Procedure StartEdit(Stream : TStream; EditName : TFilename; FileHandle : Integer);
Procedure StopEdit;
file can be null
Remove control everything that is owned by tempowner, and delete it!
Procedure ToggleSelection(Component : TComponent);
Procedure AddMenuItem(Caption : String; Tag : Longint; Callback : TNotifyEvent);
Procedure AlignPointToGrid(var Point : TPoint);
Procedure CalculateParents;
Function CanBeFreaked(Component : TComponent) : Boolean;
Procedure CheckFreakers;
we have actual component, and visual representation } { Candidate is a candidate for parent
Procedure ClipCursor;
Form.Canvas.DrawFocusRect(Rect);
function CreateMethod(const Name: string; TypeData: PTypeData): TMethod;
Not done seriously
we have to do something here.... not sure what delphi does....
Procedure DoDefaultEdit;
NOTE: These last changes may have broken earlier conditions, but so what } { we did our best.... sort of
Procedure DoFocusrect(Component : TComponent);
So as to move only by integer grids } { This is in line with the Delphi form designer, when moving, don't move TO } { grid points, but BY grid points
Procedure DoMoveComponent(Component : TComponent);
Procedure DoMovedComponent(Component : TComponent);
Procedure DoMoving;
Procedure DoPopupMenu;
Procedure DoSizeComponent(Component : TComponent);
Procedure DoSizedComponent(Component : TComponent);
Procedure DoSizeRect;
Procedure DoSizing(Component : TComponent);
Procedure DrawRectangle(Rectangle : TRect);
Result is now the control we can move
Procedure EditComponents;
a component - well well
Procedure EditLButtonDblClk(var Msg: TMessage; var Handled: Boolean);
Procedure EditLButtonDown(var Msg: TMessage; var Handled: Boolean);
Procedure EditLButtonUp(var Msg: TMessage; var Handled: Boolean);
Popup the menu
Procedure EditMouseMove(var Msg: TMessage; var Handled: Boolean);
Plot point
Procedure EditRButtonDown(var Msg: TMessage; var Handled: Boolean);
somehow some messages are slipping though, and why would we not have handled them all?
Procedure EditRButtonUp(var Msg: TMessage; var Handled: Boolean);
Procedure EndInsert;
Procedure FillGridRecordDefaults(var Grid : TGridrecord);
that 1 is me; not quite dead yet
Function FindHolder(AComponent : TComponent) : TControl;
Never designing or our hint line won't work } { we hand wndproc to parent form by hand
Procedure FixPosition(Control : TControl);
Bring in opposite selection Order so we preserve Z Order from selection order } {SAMFIX parents only or all selected components.... hmmm....
Procedure FixZOrder;
Make sure handles and holders are always on top
procedure ForceValidName(Reader: TReader; Component: TComponent; var Name: string);
Procedure formSizePosChanged;
Procedure ForParentSelection(Proc : TComponentProc);
Procedure ForSelection(Proc : TComponentProc);
Procedure FreakAutoParents(Component : TComponent; Candidate : TWinControl; Map : Boolean);
FreakAuto parents is called when a component is newly inserted } { but after fixups are fixed } { we try and freak to the freak property first, if that is nil } { THEN we freak to the candidate
Procedure FreaknewFreakers(PasteControl : TWiNControl);
If freak property is not equal to parent then change parent to freak property } { ubless property is nill, then set parent to form
Procedure FreeComponentEditor;
This is usually done by Inspector
Function GetFreakInfo(Component : TComponent) : string;
SAMFIX not exactly MODIFIED but something to cause people to know the filename has changed
Function GetHandleRect(HandleType : THandleType; Component : TComponent) : TRect;
Function GetMainComponent : TComponent;
Function GetMainControl : TControl;
function GetMethodName(const Method: TMethod): string;
procedure GetMethods(TypeData: PTypeData; Proc: TGetStrProc);
Function GetPrivateDirectory : String;
Function GetValidName(Component : TComponent; OldName : String) : String;
New ones
Procedure GoingPlural;
Convert tags on remaining component to drag tags
Procedure GoingSingle;
Now Clip with ClientRect of form... } { otherwise we get autoscroll creep
Procedure InsertTempControls(MakeHolders : Boolean);
set Left and Top to match designinfo
Function IsDesignMsg(Control: TControl; var Message: TMessage): Boolean;
A list of components bing pasted to be AutoFreaked together after fixups } { Inherited ones
This is where we intercept messages BY COOPERATION of the DELPHI VCL
Procedure MakeDesigning(Component : TComponent);
This one is an event handler
Writeln('ShowMethod ',name);
Function MakeHolder(AComponent : TComponent) : TComponentHolder;
Procedure MakeNotDesigning(Component : TComponent);
function MethodExists(const Name: string): Boolean;
Procedure Modified;
Procedure ModifiedForm;
only renew if we are current } { Make handles match new positions
Procedure MoveInsert;
Procedure MoveSelecting;
Procedure Notification(AComponent: TComponent; Operation: TOperation);
Procedure PaintFormGrid(Form : TForm; Grid : TGridRecord);
Procedure PaintGrid;
well we can't deal with it here, post a similar message to the main form
Procedure PerformVerb(Sender : TObject);
Now we can add our menu Options
Procedure prepareFreakers;
Procedure PrepareHolders;
scan all components and test for freaking } { any non-visual will have their holders by now
Procedure PrepareMoving;
Procedure ReadComponentsFromStream(Stream : TMemoryStream; Owner, Parent : TComponent);
can do >64K
procedure ReadedForPaste(Component: TComponent);
Function RealizeControl(Control : TControl) : TControl;
Procedure IdentifyControls(TempWinControl : TWinControl; Pos : TPoint);
LockWindowUpdate(0);
Function RealizePasteControl(Control : TControl) : TWinControl;
Procedure RemoveTempControls;
Must be a component, crdate a holder for it
procedure RenameMethod(const CurName, NewName: string);
Procedure SetEditState(Value : TEditState);
They don't
Procedure SetEditStateIdle;
Procedure SetFilename(Value : TFilename);
Make the inspector point to us
Procedure SetShowHandles(Value : Boolean);
Function ShowingHandles : Boolean;
procedure ShowMethod(const Name: string);
Function SizeRect(Rectangle : TRect; Offset : TPoint) : TRect;
Procedure StartInsert(var Msg: TMessage; var Handled: Boolean);
Default edit on component editor
Procedure StartMoving;
So we get the full delta effect now!
Procedure StartSelecting;
Procedure StartSizing(Component : TComponent);
Procedure StopMoving;
Procedure StopSelecting;
Procedure StopSizing(Component : TComponent);
Procedure StreamFromClipboard(Stream : TMemoryStream);
Procedure StreamToClipboard(Stream : TMemoryStream);
This does >64K
Function tryFreak(Component : TComponent; Visual : TControl; Candidate : TWinControl;
TryInternal : Boolean; MapCoords : Boolean) : Boolean;
Procedure UnClipCursor;
Procedure UpdateAll(WinControl : TWinControl);
Procedure DelayPaintHandles(PaintControl : TControl);
otherwise we have no interest! This test is important as we } { will get called for SubComponents of TArrays etc and mayhap notebooks!
Procedure UpdateMoveOffsets;
Now iterate over controls and offset each one by point
Function ValidatePasteControl(Control : TWinControl) : TWinControl;
Now pop up levels until we find csAcceptControls } { This will always happen at FORm level
Procedure ValidateRename(AComponent: TComponent; const CurName, NewName: string);
There may be other fields which require zero'ing as below
Procedure WaitForMove;
property ComponentList : TList
property Destroying : Boolean
property Filehandle : Integer
property FileName : TFileName
property FormModified : Boolean
property MainComponent : TComponent
property MainControl : TControl
property MessageControl : TControl
property OptShowHandles : Boolean
property PointInForm : TPoint
property PointInScreen : TPoint
property SizingHandle : THandleType
property EditState : TEditState
Sticks FSelectedComponents in FSelectedParents except those who have parents selected
property VisibleHandles : Boolean
FAreaRectangle : TRect;
FAutoHolder : Boolean;
A file handle assoicated with the form
FComponentClass : TComponentClass;
FComponentEditor : TComponentEditor;
To OWN handles and such
FDestroying : Boolean;
FEditState : TEditState;
grid settings
FFileHandle : Integer;
FFileName : TFileName;
FFormloaded : Boolean;
FFormModified : Boolean;
false until we have finished loading
FFreakClassRules : TStringList;
relates to non-form parents of Components
FFreakers : TList;
Just been read by ReadComponents
FFreakRules : TIniFile;
FGrid : TGridRecord;
as above
FLastHolder : TComponentHolder;
FSelectedComponents excluding those whose parents are selected
FMessageControl : TControl;
A TControl owned by TForm and child of UseWinControl
FMoveDelta : TPoint;
Where move started from (for Coords)
FMoveOffset : TPoint;
Increment for last mouse mouse move
FMoveStart : TPoint;
Screen based coordinates
FNewFreakers : TList;
list of components whose autoparents need checking every designer.modified
FOldCursorrect : TRect;
Difference on previous go
FOldMoveOffset : TPoint;
Difference between current mouse and start move
FPasteControl : TWinControl;
To store and restore cursor slip rect } { FApplicationOnMessage : TMessageEvent;
FPastedComponent : TComponent;
Last holder make automatically by notification
FPointInForm : TPoint;
Region being selected by mouse
FPointInScreen : TPoint;
Form based co-ords of mouse message
FPopUpMenu : TPopupMenu;
FSelectedComponents : TList;
FSelectedParents : TList;
All components selected
FShowHandles : Boolean;
when true non controls inserted cause a holder to be created auto
FSizeHandles : Array[0..7] of TXControlHandle;
FSizingHandle : THandleType;
FTempOwner : TComponent;
FUseControl : TControl;
Control to paste into
FVisibleHandles : Boolean;
to insert a new component