mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-06 00:18:08 +02:00
4420 lines
144 KiB
ObjectPascal
4420 lines
144 KiB
ObjectPascal
{ /***************************************************************************
|
|
designer.pp - Lazarus IDE unit
|
|
--------------------------------
|
|
|
|
Initial Revision : Sat May 10 23:15:32 CST 1999
|
|
|
|
|
|
***************************************************************************/
|
|
|
|
***************************************************************************
|
|
* *
|
|
* This source is free software; you can redistribute it and/or modify *
|
|
* it under the terms of the GNU General Public License as published by *
|
|
* the Free Software Foundation; either version 2 of the License, or *
|
|
* (at your option) any later version. *
|
|
* *
|
|
* This code is distributed in the hope that it will be useful, but *
|
|
* WITHOUT ANY WARRANTY; without even the implied warranty of *
|
|
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
|
|
* General Public License for more details. *
|
|
* *
|
|
* A copy of the GNU General Public License is available on the World *
|
|
* Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
|
|
* obtain it by writing to the Free Software Foundation, *
|
|
* Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA. *
|
|
* *
|
|
***************************************************************************
|
|
}
|
|
unit Designer;
|
|
|
|
{$mode objfpc}{$H+}
|
|
|
|
interface
|
|
|
|
{off $DEFINE VerboseDesigner}
|
|
{off $DEFINE VerboseDesignerDraw}
|
|
{off $DEFINE VerboseDesignerSelect}
|
|
|
|
uses
|
|
// RTL + FCL
|
|
Types, Classes, Math, SysUtils, Variants, TypInfo,
|
|
// LCL
|
|
LCLType, LResources, LCLIntf, LMessages, InterfaceBase,
|
|
Forms, Controls, Graphics, Dialogs, ExtCtrls, Menus, ClipBrd,
|
|
// LazUtils
|
|
GraphType, GraphMath, LazFileUtils, LazFileCache, LazLoggerBase, LazUtilities,
|
|
// BuildIntf
|
|
ProjectIntf, ComponentReg,
|
|
// IDEIntf
|
|
IDEDialogs, PropEdits, PropEditUtils, ComponentEditors, MenuIntf,
|
|
IDEImagesIntf, FormEditingIntf, IDECommands, LazIDEIntf,
|
|
ObjectInspector, IdeIntfStrConsts,
|
|
// IDE
|
|
LazarusIDEStrConsts, EnvGuiOptions, EditorOptions, SourceEditor,
|
|
// Designer
|
|
AlignCompsDlg, SizeCompsDlg, ScaleCompsDlg, DesignerProcs, CustomFormEditor,
|
|
AskCompNameDlg, ControlSelection, ChangeClassDialog, ImgList;
|
|
|
|
type
|
|
TDesigner = class;
|
|
|
|
TOnGetSelectedComponentClass = procedure(Sender: TObject;
|
|
var RegisteredComponent: TRegisteredComponent) of object;
|
|
TOnSetDesigning = procedure(Sender: TObject; Component: TComponent;
|
|
Value: boolean) of object;
|
|
TOnPasteComponents = procedure(Sender: TObject; LookupRoot: TComponent;
|
|
TxtCompStream: TStream; Parent: TWinControl;
|
|
NewComponents: TFPList) of object;
|
|
TOnPastedComponents = procedure(Sender: TObject; LookupRoot: TComponent) of object;
|
|
TOnPersistentDeleted = procedure(Sender: TObject; APersistent: TPersistent)
|
|
of object;
|
|
TOnGetNonVisualCompIcon = procedure(Sender: TObject;
|
|
AComponent: TComponent; var ImageList: TCustomImageList; var ImageIndex: TImageIndex) of object;
|
|
TOnRenameComponent = procedure(Designer: TDesigner; AComponent: TComponent;
|
|
const NewName: string) of object;
|
|
TOnProcessCommand = procedure(Sender: TObject; Command: word;
|
|
var Handled: boolean) of object;
|
|
TOnComponentAdded = procedure(Sender: TObject; AComponent: TComponent;
|
|
ARegisteredComponent: TRegisteredComponent) of object;
|
|
TOnHasParentCandidates = function: Boolean of object;
|
|
|
|
TDesignerFlag = (
|
|
dfHasSized,
|
|
dfNeedPainting,
|
|
dfDuringPaintControl,
|
|
dfDestroyingForm,
|
|
dfShowEditorHints,
|
|
dfShowComponentCaptions,
|
|
dfShowNonVisualComponents
|
|
);
|
|
TDesignerFlags = set of TDesignerFlag;
|
|
|
|
TUndoItem = record
|
|
obj: string;
|
|
fieldName: string;
|
|
propInfo: PPropInfo;
|
|
oldVal, newVal: Variant;
|
|
compName, parentName: TComponentName;
|
|
opType: TUndoOpType;
|
|
isValid: Boolean;
|
|
GroupId: int64;
|
|
end;
|
|
|
|
{ TDesigner }
|
|
|
|
TDesigner = class(TComponentEditorDesigner)
|
|
private
|
|
FDesignerPopupMenu: TPopupMenu;
|
|
FDefaultFormBounds: TRect;
|
|
FLastFormBounds: TRect;
|
|
FFlags: TDesignerFlags;
|
|
FGridColor: TColor;
|
|
FMediator: TDesignerMediator;
|
|
FOnChangeParent: TNotifyEvent;
|
|
FOnPastedComponents: TOnPastedComponents;
|
|
FProcessingDesignerEvent: Integer;
|
|
FOnActivated: TNotifyEvent;
|
|
FOnCloseQuery: TNotifyEvent;
|
|
FOnShowObjectInspector: TNotifyEvent;
|
|
FOnShowAnchorEditor: TNotifyEvent;
|
|
FOnShowTabOrderEditor: TNotifyEvent;
|
|
FOnPersistentDeleted: TOnPersistentDeleted;
|
|
FOnGetNonVisualCompIcon: TOnGetNonVisualCompIcon;
|
|
FOnGetSelectedComponentClass: TOnGetSelectedComponentClass;
|
|
FOnModified: TNotifyEvent;
|
|
FOnPasteComponent: TOnPasteComponents;
|
|
FOnProcessCommand: TOnProcessCommand;
|
|
FOnPropertiesChanged: TNotifyEvent;
|
|
FOnRenameComponent: TOnRenameComponent;
|
|
FOnSaveAsXML: TNotifyEvent;
|
|
FOnSetDesigning: TOnSetDesigning;
|
|
FOnShowOptions: TNotifyEvent;
|
|
FOnComponentAdded: TOnComponentAdded;
|
|
FOnViewLFM: TNotifyEvent;
|
|
FOnForwardKeyToOI: TOnForwardKeyToOI;
|
|
FShiftState: TShiftState;
|
|
FTheFormEditor: TCustomFormEditor;
|
|
FPopupMenuComponentEditor: TBaseComponentEditor;
|
|
FUndoList: array of TUndoItem;
|
|
FUndoCurr: integer;
|
|
FUndoLock: integer;
|
|
FUndoGroupId: int64;
|
|
|
|
//hint stuff
|
|
FHintTimer: TTimer;
|
|
FHintWIndow: THintWindow;
|
|
|
|
// component drawing
|
|
FDDC: TDesignerDeviceContext;
|
|
FSurface: TBitmap;
|
|
|
|
procedure DrawNonVisualComponent(AComponent: TComponent);
|
|
function GetGridColor: TColor;
|
|
function GetGridSizeX: integer;
|
|
function GetGridSizeY: integer;
|
|
function GetIsControl: Boolean;
|
|
function GetShowBorderSpacing: boolean;
|
|
function GetShowComponentCaptions: boolean;
|
|
function GetShowEditorHints: boolean;
|
|
function GetShowGrid: boolean;
|
|
function GetSnapToGrid: boolean;
|
|
procedure HintTimer(Sender : TObject);
|
|
//procedure InvalidateWithParent(AComponent: TComponent);
|
|
procedure SetDefaultFormBounds(const AValue: TRect);
|
|
procedure SetGridColor(const AValue: TColor);
|
|
procedure SetGridSizeX(const AValue: integer);
|
|
procedure SetGridSizeY(const AValue: integer);
|
|
procedure SetMediator(const AValue: TDesignerMediator);
|
|
procedure SetPopupMenuComponentEditor(const AValue: TBaseComponentEditor);
|
|
procedure SetShowBorderSpacing(const AValue: boolean);
|
|
procedure SetShowComponentCaptions(const AValue: boolean);
|
|
procedure SetShowEditorHints(const AValue: boolean);
|
|
procedure SetShowGrid(const AValue: boolean);
|
|
procedure SetSnapToGrid(const AValue: boolean);
|
|
procedure DoOnForwardKeyToObjectInspector(Sender: TObject; Key: TUTF8Char);
|
|
protected
|
|
MouseDownComponent: TComponent;
|
|
MouseDownSender: TComponent;
|
|
MouseDownPos: TPoint;
|
|
MouseDownShift: TShiftState;
|
|
MouseUpPos: TPoint;
|
|
LastMouseMovePos: TPoint;
|
|
LastFormCursor: TCursor;
|
|
DeletingPersistent: TList;
|
|
LastPaintSender: TControl;
|
|
|
|
// event handlers for designed components
|
|
function PaintControl(Sender: TControl; TheMessage: TLMPaint): Boolean;
|
|
function SizeControl(Sender: TControl; TheMessage: TLMSize): Boolean;
|
|
function MoveControl(Sender: TControl; TheMessage: TLMMove): Boolean;
|
|
procedure MouseDownOnControl(Sender: TControl; var TheMessage: TLMMouse);
|
|
procedure MouseMoveOnControl(Sender: TControl; var TheMessage: TLMMouse);
|
|
procedure MouseUpOnControl(Sender: TControl; var TheMessage: TLMMouse);
|
|
procedure KeyDown(Sender: TControl; var TheMessage: TLMKEY);
|
|
procedure KeyUp(Sender: TControl; var TheMessage: TLMKEY);
|
|
function HandleSetCursor(var TheMessage: TLMessage): boolean;
|
|
procedure HandlePopupMenu(Sender: TControl; var Message: TLMContextMenu);
|
|
procedure GetMouseMsgShift(TheMessage: TLMMouse; out Shift: TShiftState;
|
|
out Button: TMouseButton);
|
|
function GetShowNonVisualComponents: boolean; override;
|
|
procedure SetShowNonVisualComponents(AValue: boolean); override;
|
|
|
|
// procedures for working with components and persistents
|
|
function GetDesignControl(AControl: TControl): TControl;
|
|
function DoDeleteSelectedPersistents: boolean;
|
|
procedure DoDeleteSelectedPersistentsAsync({%H-}Data: PtrInt);
|
|
procedure CutSelectionAsync({%H-}Data: PtrInt);
|
|
procedure DoSelectAll;
|
|
procedure DoDeletePersistent(APersistent: TPersistent; FreeIt: boolean);
|
|
function GetSelectedComponentClass: TRegisteredComponent;
|
|
procedure NudgePosition(DiffX, DiffY: Integer);
|
|
procedure NudgeSize(DiffX, DiffY: Integer);
|
|
procedure NudgeSelection(DiffX, DiffY: Integer); overload;
|
|
procedure NudgeSelection(SelectNext: Boolean); overload;
|
|
procedure SelectParentOfSelection;
|
|
function DoCopySelectionToClipboard: boolean;
|
|
function GetPasteParent: TWinControl;
|
|
procedure DoModified;
|
|
function DoPasteSelectionFromClipboard(PasteFlags: TComponentPasteSelectionFlags
|
|
): boolean;
|
|
function DoInsertFromStream(s: TStream; PasteParent: TWinControl;
|
|
PasteFlags: TComponentPasteSelectionFlags): Boolean;
|
|
|
|
function DoUndo: Boolean;
|
|
function DoRedo: Boolean;
|
|
procedure ExecuteUndoItem(IsActUndo: boolean);
|
|
procedure SetNextUndoGroupId; inline;
|
|
|
|
procedure DoShowAnchorEditor;
|
|
procedure DoShowTabOrderEditor;
|
|
procedure DoShowObjectInspector;
|
|
type
|
|
TChangeOrderAction = (
|
|
coaMoveToFront,
|
|
coaMoveToBack,
|
|
coaForwardOne,
|
|
coaBackOne
|
|
);
|
|
procedure DoChangeZOrder(TheAction: TChangeOrderAction);
|
|
|
|
procedure NotifyComponentAdded(AComponent: TComponent);
|
|
function ComponentClassAtPos(const AClass: TComponentClass;
|
|
const APos: TPoint; const UseRootAsDefault,
|
|
IgnoreHidden: boolean): TComponent;
|
|
procedure SetTempCursor(ARoot: TWinControl; ACursor: TCursor);
|
|
|
|
// popup menu
|
|
procedure BuildPopupMenu;
|
|
procedure DesignerPopupMenuPopup(Sender: TObject);
|
|
procedure ComponentEditorVerbMenuItemClick(Sender: TObject);
|
|
procedure AlignPopupMenuClick(Sender: TObject);
|
|
procedure MirrorHorizontalPopupMenuClick(Sender: TObject);
|
|
procedure MirrorVerticalPopupMenuClick(Sender: TObject);
|
|
procedure ScalePopupMenuClick(Sender: TObject);
|
|
procedure SizePopupMenuClick(Sender: TObject);
|
|
procedure ResetPopupMenuClick(Sender: TObject);
|
|
procedure AnchorEditorMenuClick(Sender: TObject);
|
|
procedure TabOrderMenuClick(Sender: TObject);
|
|
procedure OrderMoveToFrontMenuClick(Sender: TObject);
|
|
procedure OrderMoveToBackMenuClick(Sender: TObject);
|
|
procedure OrderForwardOneMenuClick(Sender: TObject);
|
|
procedure OrderBackOneMenuClick(Sender: TObject);
|
|
procedure CopyMenuClick(Sender: TObject);
|
|
procedure CutMenuClick(Sender: TObject);
|
|
procedure PasteMenuClick(Sender: TObject);
|
|
procedure DeleteSelectionMenuClick(Sender: TObject);
|
|
procedure SelectAllMenuClick(Sender: TObject);
|
|
procedure ChangeClassMenuClick(Sender: TObject);
|
|
procedure ChangeParentMenuClick(Sender: TObject);
|
|
procedure ShowNonVisualComponentsMenuClick(Sender: TObject);
|
|
procedure SnapToGridOptionMenuClick(Sender: TObject);
|
|
procedure ShowOptionsMenuItemClick(Sender: TObject);
|
|
procedure SnapToGuideLinesOptionMenuClick(Sender: TObject);
|
|
procedure ViewLFMMenuClick(Sender: TObject);
|
|
procedure SaveAsXMLMenuClick(Sender: TObject);
|
|
procedure CenterFormMenuClick(Sender: TObject);
|
|
|
|
// hook
|
|
function GetPropertyEditorHook: TPropertyEditorHook; override;
|
|
function DoFormActivated(Active: boolean): boolean;
|
|
function DoFormCloseQuery: boolean;
|
|
|
|
property PopupMenuComponentEditor: TBaseComponentEditor read FPopupMenuComponentEditor write SetPopupMenuComponentEditor;
|
|
public
|
|
Selection: TControlSelection;
|
|
DDC: TDesignerDeviceContext;
|
|
|
|
constructor Create(TheDesignerForm: TCustomForm; AControlSelection: TControlSelection);
|
|
procedure PrepareFreeDesigner(AFreeComponent: boolean); override;
|
|
procedure DisconnectComponent; override;
|
|
destructor Destroy; override;
|
|
|
|
procedure Modified; override;
|
|
procedure SelectOnlyThisComponent(AComponent: TComponent); override;
|
|
function CopySelection: boolean; override;
|
|
function CutSelection: boolean; override;
|
|
function CanCopy: Boolean; override;
|
|
function CanPaste: Boolean; override;
|
|
function PasteSelection(PasteFlags: TComponentPasteSelectionFlags): boolean; override;
|
|
function ClearSelection: boolean; override;
|
|
function DeleteSelection: boolean; override;
|
|
function CopySelectionToStream(AllComponentsStream: TStream): boolean; override;
|
|
function InsertFromStream(s: TStream; Parent: TWinControl;
|
|
PasteFlags: TComponentPasteSelectionFlags): Boolean; override;
|
|
function InvokeComponentEditor(AComponent: TComponent): boolean; override;
|
|
function ChangeClass: boolean; override;
|
|
|
|
procedure DoProcessCommand(Sender: TObject; var Command: word;
|
|
var Handled: boolean);
|
|
|
|
function CanUndo: Boolean; override;
|
|
function CanRedo: Boolean; override;
|
|
function Undo: Boolean; override;
|
|
function Redo: Boolean; override;
|
|
function AddUndoAction(const aPersistent: TPersistent; aOpType: TUndoOpType;
|
|
StartNewGroup: boolean; aFieldName: string; const aOldVal, aNewVal: Variant): boolean; override;
|
|
function IsUndoLocked: boolean; override;
|
|
procedure ClearUndoItem(AIndex: Integer);
|
|
procedure AddComponent(const NewRegisteredComponent: TRegisteredComponent;
|
|
const NewComponentClass: TComponentClass; const NewParent: TComponent;
|
|
const NewLeft, NewTop, NewWidth, NewHeight: Integer); override;
|
|
procedure AddComponentCheckParent(var NewParent: TComponent;
|
|
const OriginComponent: TComponent; const OriginWinControl: TWinControl;
|
|
const NewComponentClass: TComponentClass); override;
|
|
|
|
function NonVisualComponentLeftTop(AComponent: TComponent): TPoint;
|
|
function NonVisualComponentAtPos(X, Y: integer): TComponent;
|
|
procedure MoveNonVisualComponentIntoForm(AComponent: TComponent);
|
|
procedure MoveNonVisualComponentsIntoForm;
|
|
function WinControlAtPos(x,y: integer; UseRootAsDefault,
|
|
IgnoreHidden: boolean): TWinControl;
|
|
function ControlAtPos(x,y: integer; UseRootAsDefault,
|
|
IgnoreHidden: boolean): TControl;
|
|
function ComponentAtPos(x,y: integer; UseRootAsDefault,
|
|
IgnoreHidden: boolean): TComponent;
|
|
function GetDesignedComponent(AComponent: TComponent): TComponent;
|
|
function GetComponentEditorForSelection: TBaseComponentEditor;
|
|
function GetShiftState: TShiftState; override;
|
|
|
|
procedure AddComponentEditorMenuItems(AComponentEditor: TBaseComponentEditor;
|
|
ClearOldOnes: boolean);
|
|
|
|
function IsDesignMsg(Sender: TControl;
|
|
var TheMessage: TLMessage): Boolean; override;
|
|
procedure UTF8KeyPress(var UTF8Key: TUTF8Char); override;
|
|
function UniqueName(const BaseName: string): string; override;
|
|
Procedure RemovePersistentAndChildren(APersistent: TPersistent);
|
|
procedure Notification({%H-}AComponent: TComponent;
|
|
Operation: TOperation); override;
|
|
procedure ValidateRename(AComponent: TComponent;
|
|
const CurName, NewName: string); override;
|
|
function CreateUniqueComponentName(const AClassName: string): string; override;
|
|
|
|
procedure PaintGrid; override;
|
|
procedure PaintClientGrid(AWinControl: TWinControl;
|
|
aDDC: TDesignerDeviceContext);
|
|
procedure DrawNonVisualComponents(aDDC: TDesignerDeviceContext);
|
|
procedure DrawDesignerItems(OnlyIfNeeded: boolean); override;
|
|
procedure CheckFormBounds;
|
|
procedure DoPaintDesignerItems;
|
|
function ComponentIsIcon(AComponent: TComponent): boolean;
|
|
function GetParentFormRelativeClientOrigin(AComponent: TComponent): TPoint;
|
|
public
|
|
property Flags: TDesignerFlags read FFlags;
|
|
property GridSizeX: integer read GetGridSizeX write SetGridSizeX;
|
|
property GridSizeY: integer read GetGridSizeY write SetGridSizeY;
|
|
property GridColor: TColor read GetGridColor write SetGridColor;
|
|
property IsControl: Boolean read GetIsControl;
|
|
property Mediator: TDesignerMediator read FMediator write SetMediator;
|
|
property ProcessingDesignerEvent: Integer read FProcessingDesignerEvent;
|
|
property OnActivated: TNotifyEvent read FOnActivated write FOnActivated;
|
|
property OnCloseQuery: TNotifyEvent read FOnCloseQuery write FOnCloseQuery;
|
|
property OnPersistentDeleted: TOnPersistentDeleted
|
|
read FOnPersistentDeleted write FOnPersistentDeleted;
|
|
property OnGetNonVisualCompIcon: TOnGetNonVisualCompIcon
|
|
read FOnGetNonVisualCompIcon write FOnGetNonVisualCompIcon;
|
|
property OnGetSelectedComponentClass: TOnGetSelectedComponentClass
|
|
read FOnGetSelectedComponentClass
|
|
write FOnGetSelectedComponentClass;
|
|
property OnProcessCommand: TOnProcessCommand
|
|
read FOnProcessCommand write FOnProcessCommand;
|
|
property OnModified: TNotifyEvent read FOnModified write FOnModified;
|
|
property OnPasteComponents: TOnPasteComponents read FOnPasteComponent
|
|
write FOnPasteComponent;
|
|
property OnPastedComponents: TOnPastedComponents read FOnPastedComponents
|
|
write FOnPastedComponents;
|
|
property OnPropertiesChanged: TNotifyEvent
|
|
read FOnPropertiesChanged write FOnPropertiesChanged;
|
|
property OnRenameComponent: TOnRenameComponent
|
|
read FOnRenameComponent write FOnRenameComponent;
|
|
property OnSetDesigning: TOnSetDesigning read FOnSetDesigning write FOnSetDesigning;
|
|
property OnComponentAdded: TOnComponentAdded read FOnComponentAdded
|
|
write FOnComponentAdded;
|
|
property OnShowOptions: TNotifyEvent read FOnShowOptions write FOnShowOptions;
|
|
property OnViewLFM: TNotifyEvent read FOnViewLFM write FOnViewLFM;
|
|
property OnSaveAsXML: TNotifyEvent read FOnSaveAsXML write FOnSaveAsXML;
|
|
property OnShowObjectInspector: TNotifyEvent read FOnShowObjectInspector write FOnShowObjectInspector;
|
|
property OnShowAnchorEditor: TNotifyEvent read FOnShowAnchorEditor write FOnShowAnchorEditor;
|
|
property OnShowTabOrderEditor: TNotifyEvent read FOnShowTabOrderEditor write FOnShowTabOrderEditor;
|
|
property OnForwardKeyToObjectInspector: TOnForwardKeyToOI read FOnForwardKeyToOI
|
|
write FOnForwardKeyToOI;
|
|
property OnChangeParent: TNotifyEvent read FOnChangeParent write FOnChangeParent;
|
|
|
|
property ShowGrid: boolean read GetShowGrid write SetShowGrid;
|
|
property ShowBorderSpacing: boolean read GetShowBorderSpacing write SetShowBorderSpacing;
|
|
property ShowEditorHints: boolean read GetShowEditorHints write SetShowEditorHints;
|
|
property ShowComponentCaptions: boolean read GetShowComponentCaptions
|
|
write SetShowComponentCaptions;
|
|
property ShowNonVisualComponents: boolean read GetShowNonVisualComponents write SetShowNonVisualComponents;
|
|
property SnapToGrid: boolean read GetSnapToGrid write SetSnapToGrid;
|
|
property TheFormEditor: TCustomFormEditor read FTheFormEditor write FTheFormEditor;
|
|
property DefaultFormBounds: TRect read FDefaultFormBounds write SetDefaultFormBounds;
|
|
end;
|
|
|
|
const
|
|
DesignerMenuRootName = 'Designer';
|
|
var
|
|
DesignerMenuAlign: TIDEMenuCommand;
|
|
DesignerMenuMirrorHorizontal: TIDEMenuCommand;
|
|
DesignerMenuMirrorVertical: TIDEMenuCommand;
|
|
DesignerMenuScale: TIDEMenuCommand;
|
|
DesignerMenuSize: TIDEMenuCommand;
|
|
DesignerMenuReset: TIDEMenuCommand;
|
|
|
|
DesignerMenuAnchorEditor: TIDEMenuCommand;
|
|
DesignerMenuTabOrder: TIDEMenuCommand;
|
|
DesignerMenuOrderMoveToFront: TIDEMenuCommand;
|
|
DesignerMenuOrderMoveToBack: TIDEMenuCommand;
|
|
DesignerMenuOrderForwardOne: TIDEMenuCommand;
|
|
DesignerMenuOrderBackOne: TIDEMenuCommand;
|
|
|
|
DesignerMenuCut: TIDEMenuCommand;
|
|
DesignerMenuCopy: TIDEMenuCommand;
|
|
DesignerMenuPaste: TIDEMenuCommand;
|
|
DesignerMenuDeleteSelection: TIDEMenuCommand;
|
|
DesignerMenuSelectAll: TIDEMenuCommand;
|
|
|
|
DesignerMenuChangeClass: TIDEMenuCommand;
|
|
DesignerMenuChangeParent: TIDEMenuCommand;
|
|
DesignerMenuViewLFM: TIDEMenuCommand;
|
|
DesignerMenuSaveAsXML: TIDEMenuCommand;
|
|
DesignerMenuCenterForm: TIDEMenuCommand;
|
|
|
|
DesignerMenuShowNonVisualComponents: TIDEMenuCommand;
|
|
DesignerMenuSnapToGridOption: TIDEMenuCommand;
|
|
DesignerMenuSnapToGuideLinesOption: TIDEMenuCommand;
|
|
DesignerMenuShowOptions: TIDEMenuCommand;
|
|
|
|
|
|
procedure RegisterStandardDesignerMenuItems;
|
|
|
|
|
|
implementation
|
|
|
|
type
|
|
TCustomFormAccess = class(TCustomForm);
|
|
TControlAccess = class(TControl);
|
|
TWinControlAccess = class(TWinControl);
|
|
TComponentAccess = class(TComponent);
|
|
|
|
{ TComponentSearch }
|
|
|
|
TComponentSearch = class(TComponent)
|
|
public
|
|
Best: TComponent;
|
|
BestLevel: integer;
|
|
BestIsNonVisual: boolean;
|
|
Level: integer;
|
|
AtPos: TPoint;
|
|
MinClass: TComponentClass;
|
|
IgnoreHidden: boolean;
|
|
OnlyNonVisual: boolean;
|
|
IgnoreNonVisual: boolean;
|
|
Mediator: TDesignerMediator;
|
|
Root: TComponent;
|
|
procedure Gather(Child: TComponent);
|
|
procedure Search(ARoot: TComponent);
|
|
end;
|
|
|
|
{ TComponentSearch }
|
|
|
|
procedure TComponentSearch.Gather(Child: TComponent);
|
|
var
|
|
Control: TControl;
|
|
ChildBounds: TRect;
|
|
OldRoot: TComponent;
|
|
IsNonVisual: Boolean;
|
|
begin
|
|
if Assigned(Best) and BestIsNonVisual and (BestLevel < Level) then exit;
|
|
{$IFDEF VerboseDesignerSelect}
|
|
DebugLn(['TComponentSearch.Gather ',DbgSName(Child),' ',dbgs(AtPos),' MinClass=',DbgSName(MinClass)]);
|
|
{$ENDIF}
|
|
// check if child is at position
|
|
if Child is TControl then
|
|
begin
|
|
Control := TControl(Child);
|
|
if IgnoreHidden and (csNoDesignVisible in Control.ControlStyle) then
|
|
exit;
|
|
if csNoDesignSelectable in Control.ControlStyle then
|
|
exit;
|
|
if Control.Perform(CM_MASKHITTEST,0,Longint(SmallPoint(AtPos.X, AtPos.Y)))>0 then
|
|
exit;
|
|
end
|
|
else
|
|
Control := nil;
|
|
ChildBounds := GetParentFormRelativeBounds(Child);
|
|
{$IFDEF VerboseDesignerSelect}
|
|
DebugLn(['TComponentSearch.Gather PtInRect=',PtInRect(ChildBounds, AtPos),' ChildBounds=',dbgs(ChildBounds)]);
|
|
{$ENDIF}
|
|
if not PtInRect(ChildBounds, AtPos) then Exit;
|
|
|
|
if Assigned(Mediator) then
|
|
IsNonVisual := Mediator.ComponentIsIcon(Child)
|
|
else
|
|
IsNonVisual := DesignerProcs.ComponentIsNonVisual(Child);
|
|
|
|
if IsNonVisual then begin
|
|
if IgnoreNonVisual then exit;
|
|
if Assigned(IDEComponentsMaster)
|
|
and not IDEComponentsMaster.DrawNonVisualComponents(Root) then
|
|
Exit;
|
|
end;
|
|
|
|
if Child.InheritsFrom(MinClass) and (IsNonVisual or not OnlyNonVisual) then
|
|
begin
|
|
Best := Child;
|
|
BestIsNonVisual := IsNonVisual;
|
|
BestLevel := Level;
|
|
{$IFDEF VerboseDesignerSelect}
|
|
DebugLn(['TComponentSearch.Gather Best=',DbgSName(Best)]);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
// search in children
|
|
if (csInline in Child.ComponentState) or
|
|
(Assigned(Control) and not (csOwnedChildrenNotSelectable in Control.ControlStyle)) then
|
|
begin
|
|
{$IFDEF VerboseDesignerSelect}
|
|
DebugLn(['TComponentSearch.Gather search in children of ',DbgSName(Child)]);
|
|
{$ENDIF}
|
|
OldRoot := Root;
|
|
try
|
|
inc(Level);
|
|
if csInline in Child.ComponentState then
|
|
Root := Child;
|
|
{$IFDEF VerboseDesignerSelect}
|
|
DebugLn(['TComponentSearch.Gather Root=',DbgSName(Root)]);
|
|
{$ENDIF}
|
|
TComponentAccess(Child).GetChildren(@Gather, Root);
|
|
finally
|
|
dec(Level);
|
|
Root := OldRoot;
|
|
end;
|
|
{$IFDEF VerboseDesignerSelect}
|
|
DebugLn(['TComponentSearch.Gather searched in children of ',DbgSName(Child)]);
|
|
{$ENDIF}
|
|
end;
|
|
end;
|
|
|
|
procedure TComponentSearch.Search(ARoot: TComponent);
|
|
begin
|
|
Root := ARoot;
|
|
Level := 1;
|
|
TComponentAccess(Root).GetChildren(@Gather, Root);
|
|
Level := 0;
|
|
end;
|
|
|
|
const
|
|
mk_lbutton = 1;
|
|
mk_rbutton = 2;
|
|
mk_shift = 4;
|
|
mk_control = 8;
|
|
mk_mbutton = $10;
|
|
|
|
procedure RegisterStandardDesignerMenuItems;
|
|
begin
|
|
DesignerMenuRoot:=RegisterIDEMenuRoot(DesignerMenuRootName);
|
|
|
|
// register the dynamic section for the component editor
|
|
DesignerMenuSectionComponentEditor:=RegisterIDEMenuSection(DesignerMenuRoot,
|
|
'Component editor section');
|
|
|
|
// register the custom dynamic section
|
|
DesignerMenuSectionCustomDynamic:=RegisterIDEMenuSection(DesignerMenuRoot,
|
|
'Custom dynamic section');
|
|
|
|
// register align section
|
|
DesignerMenuSectionAlign:=RegisterIDEMenuSection(DesignerMenuRoot,'Align section');
|
|
DesignerMenuAlign:=RegisterIDEMenuCommand(DesignerMenuSectionAlign,
|
|
'Align',fdmAlignMenu, nil, nil, nil, 'align');
|
|
DesignerMenuMirrorHorizontal:=RegisterIDEMenuCommand(DesignerMenuSectionAlign,
|
|
'Mirror horizontal',fdmMirrorHorizontal, nil, nil, nil, 'mirror_horizontal');
|
|
DesignerMenuMirrorVertical:=RegisterIDEMenuCommand(DesignerMenuSectionAlign,
|
|
'Mirror vertical',fdmMirrorVertical, nil, nil, nil, 'mirror_vertical');
|
|
DesignerMenuScale:=RegisterIDEMenuCommand(DesignerMenuSectionAlign,
|
|
'Scale',fdmScaleMenu, nil, nil, nil, 'scale');
|
|
DesignerMenuSize:=RegisterIDEMenuCommand(DesignerMenuSectionAlign,
|
|
'Size',fdmSizeMenu, nil, nil, nil, 'size');
|
|
DesignerMenuReset:=RegisterIDEMenuCommand(DesignerMenuSectionAlign,
|
|
'Reset', fdmResetMenu, nil, nil, nil, '');
|
|
|
|
// register tab and z-order section
|
|
DesignerMenuSectionOrder:=RegisterIDEMenuSection(DesignerMenuRoot,'Order section');
|
|
DesignerMenuAnchorEditor:=RegisterIDEMenuCommand(DesignerMenuSectionOrder,
|
|
'Anchor Editor',lisMenuViewAnchorEditor, nil, nil, nil, 'menu_view_anchor_editor');
|
|
DesignerMenuTabOrder:=RegisterIDEMenuCommand(DesignerMenuSectionOrder,
|
|
'Tab order',lisMenuViewTabOrder, nil, nil, nil, 'tab_order');
|
|
DesignerMenuSectionZOrder:=RegisterIDESubMenu(DesignerMenuSectionOrder,
|
|
'ZOrder section', fdmZOrder);
|
|
DesignerMenuOrderMoveToFront:=RegisterIDEMenuCommand(DesignerMenuSectionZOrder,
|
|
'Move to z order front',fdmOrderMoveTofront, nil, nil, nil, 'Order_move_front');
|
|
DesignerMenuOrderMoveToBack:=RegisterIDEMenuCommand(DesignerMenuSectionZOrder,
|
|
'Move to z order back',fdmOrderMoveToBack, nil, nil, nil, 'Order_move_back');
|
|
DesignerMenuOrderForwardOne:=RegisterIDEMenuCommand(DesignerMenuSectionZOrder,
|
|
'Move z order forward one',fdmOrderForwardOne, nil, nil, nil, 'Order_forward_one');
|
|
DesignerMenuOrderBackOne:=RegisterIDEMenuCommand(DesignerMenuSectionZOrder,
|
|
'Move z order backwards one',fdmOrderBackOne, nil, nil, nil, 'Order_back_one');
|
|
|
|
// register clipboard section
|
|
DesignerMenuSectionClipboard:=RegisterIDEMenuSection(DesignerMenuRoot,'Clipboard section');
|
|
DesignerMenuCut:=RegisterIDEMenuCommand(DesignerMenuSectionClipboard,
|
|
'Cut',lisCut, nil, nil, nil, 'laz_cut');
|
|
DesignerMenuCopy:=RegisterIDEMenuCommand(DesignerMenuSectionClipboard,
|
|
'Copy',lisCopy, nil, nil, nil, 'laz_copy');
|
|
DesignerMenuPaste:=RegisterIDEMenuCommand(DesignerMenuSectionClipboard,
|
|
'Paste',lisPaste, nil, nil, nil, 'laz_paste');
|
|
DesignerMenuDeleteSelection:=RegisterIDEMenuCommand(DesignerMenuSectionClipboard,
|
|
'Delete Selection',fdmDeleteSelection, nil, nil, nil, 'delete_selection');
|
|
DesignerMenuSelectAll:=RegisterIDEMenuCommand(DesignerMenuSectionClipboard,
|
|
'Select All',fdmSelectAll, nil, nil, nil, 'menu_select_all');
|
|
|
|
// register miscellaneous section
|
|
DesignerMenuSectionMisc:=RegisterIDEMenuSection(DesignerMenuRoot,'Miscellaneous section');
|
|
DesignerMenuChangeClass:=RegisterIDEMenuCommand(DesignerMenuSectionMisc,
|
|
'Change class',lisDlgChangeClass);
|
|
DesignerMenuChangeParent:=RegisterIDEMenuCommand(DesignerMenuSectionMisc,
|
|
'Change parent',lisChangeParent+' ...');
|
|
DesignerMenuViewLFM:=RegisterIDEMenuCommand(DesignerMenuSectionMisc,
|
|
'View LFM',lisViewSourceLfm);
|
|
DesignerMenuSaveAsXML:=RegisterIDEMenuCommand(DesignerMenuSectionMisc,
|
|
'Save as XML',fdmSaveFormAsXML);
|
|
DesignerMenuCenterForm:=RegisterIDEMenuCommand(DesignerMenuSectionMisc,
|
|
'Center form', lisCenterForm);
|
|
|
|
// register options section
|
|
DesignerMenuSectionOptions:=RegisterIDEMenuSection(DesignerMenuRoot,'Options section');
|
|
DesignerMenuShowNonVisualComponents:=RegisterIDEMenuCommand(DesignerMenuSectionMisc,
|
|
'Show non visual components',
|
|
lisDsgShowNonVisualComponents);
|
|
DesignerMenuShowNonVisualComponents.ShowAlwaysCheckable:=true;
|
|
DesignerMenuSnapToGridOption:=RegisterIDEMenuCommand(DesignerMenuSectionOptions,
|
|
'Snap to grid',fdmSnapToGridOption);
|
|
DesignerMenuSnapToGuideLinesOption:=RegisterIDEMenuCommand(DesignerMenuSectionOptions,
|
|
'Snap to guide lines',fdmSnapToGuideLinesOption);
|
|
DesignerMenuShowOptions:=RegisterIDEMenuCommand(DesignerMenuSectionOptions,
|
|
'Show options',lisOptions, nil, nil, nil, 'menu_environment_options');
|
|
end;
|
|
|
|
// inline
|
|
procedure TDesigner.SetNextUndoGroupId;
|
|
begin
|
|
LUIncreaseChangeStamp64(FUndoGroupId);
|
|
end;
|
|
|
|
constructor TDesigner.Create(TheDesignerForm: TCustomForm;
|
|
AControlSelection: TControlSelection);
|
|
var
|
|
LNonControlDesigner: INonControlDesigner;
|
|
i: integer;
|
|
begin
|
|
inherited Create;
|
|
//debugln(['TDesigner.Create Self=',dbgs(Pointer(Self)),' TheDesignerForm=',DbgSName(TheDesignerForm)]);
|
|
FForm := TheDesignerForm;
|
|
if FForm is INonControlDesigner then begin
|
|
LNonControlDesigner := FForm as INonControlDesigner;
|
|
FLookupRoot := LNonControlDesigner.LookupRoot;
|
|
Mediator := LNonControlDesigner.Mediator;
|
|
end
|
|
else if FForm is IFrameDesigner then
|
|
FLookupRoot := (FForm as IFrameDesigner).LookupRoot
|
|
else
|
|
FLookupRoot := FForm;
|
|
|
|
Selection := AControlSelection;
|
|
FFlags := [dfShowNonVisualComponents];
|
|
FGridColor := clGray;
|
|
|
|
FHintTimer := TTimer.Create(nil);
|
|
FHintTimer.Interval := 500;
|
|
FHintTimer.Enabled := False;
|
|
FHintTimer.OnTimer := @HintTimer;
|
|
|
|
FHintWindow := THintWindow.Create(nil);
|
|
|
|
FHIntWindow.Visible := False;
|
|
FHintWindow.HideInterval := 4000;
|
|
FHintWindow.AutoHide := True;
|
|
|
|
DDC:=TDesignerDeviceContext.Create;
|
|
LastFormCursor := crDefault;
|
|
DeletingPersistent:=TList.Create;
|
|
FPopupMenuComponentEditor := nil;
|
|
|
|
SetLength(FUndoList, 64);
|
|
for i := Low(FUndoList) to High(FUndoList) do
|
|
ClearUndoItem(i);
|
|
FUndoCurr := Low(FUndoList);
|
|
FUndoLock := 0;
|
|
FUndoState := ucsNone;
|
|
FUndoGroupId := 1;
|
|
end;
|
|
|
|
procedure TDesigner.AddComponent(
|
|
const NewRegisteredComponent: TRegisteredComponent;
|
|
const NewComponentClass: TComponentClass; const NewParent: TComponent;
|
|
const NewLeft, NewTop, NewWidth, NewHeight: Integer);
|
|
var
|
|
NewComponent: TComponent;
|
|
DisableAutoSize: Boolean;
|
|
NewControl: TControl;
|
|
begin
|
|
if NewParent=nil then exit;
|
|
if NewComponentClass = nil then exit;
|
|
|
|
// add a new component
|
|
Selection.RubberbandActive:=false;
|
|
Selection.Clear;
|
|
|
|
if not PropertyEditorHook.BeforeAddPersistent(Self, NewComponentClass, NewParent)
|
|
then begin
|
|
DebugLn('Note: TDesigner.AddComponent BeforeAddPersistent failed: ComponentClass=',
|
|
NewComponentClass.ClassName,' NewParent=',DbgSName(NewParent));
|
|
exit;
|
|
end;
|
|
|
|
// check cycles
|
|
if TheFormEditor.ClassDependsOnComponent(NewComponentClass, LookupRoot) then
|
|
begin
|
|
IDEMessageDialog(lisA2PInvalidCircularDependency,
|
|
Format(lisIsAThisCircularDependencyIsNotAllowed, [dbgsName(LookupRoot),
|
|
dbgsName(NewComponentClass), LineEnding]),
|
|
mtError,[mbOk],'');
|
|
exit;
|
|
end;
|
|
|
|
// create component and component interface
|
|
if ConsoleVerbosity>0 then
|
|
DebugLn(['AddComponent ',DbgSName(NewComponentClass),' Parent=',DbgSName(NewParent),' ',NewLeft,',',NewTop,',',NewWidth,',',NewHeight]);
|
|
DisableAutoSize:=true;
|
|
NewComponent := TheFormEditor.CreateComponent(
|
|
NewParent,NewComponentClass,'',
|
|
NewLeft,NewTop,NewWidth,NewHeight,DisableAutoSize);
|
|
if NewComponent=nil then exit;
|
|
if DisableAutoSize and (NewComponent is TControl) then
|
|
TControl(NewComponent).EnableAutoSizing{$IFDEF DebugDisableAutoSizing}('TDesigner.AddComponent'){$ENDIF};
|
|
TheFormEditor.FixupReferences(NewComponent); // e.g. frame references a datamodule
|
|
|
|
// modified
|
|
Modified;
|
|
|
|
// set initial properties
|
|
if NewComponent is TControl then begin
|
|
NewControl:=TControl(NewComponent);
|
|
//debugln(['AddComponent ',DbgSName(Self),' Bounds=',dbgs(NewControl.BoundsRect),' BaseBounds=',dbgs(NewControl.BaseBounds),' BaseParentClientSize=',dbgs(NewControl.BaseParentClientSize)]);
|
|
NewControl.Visible:=true;
|
|
if csSetCaption in NewControl.ControlStyle then
|
|
NewControl.Caption:=NewComponent.Name;
|
|
end;
|
|
if Assigned(FOnSetDesigning) then
|
|
FOnSetDesigning(Self,NewComponent,True);
|
|
|
|
if EnvironmentGuiOpts.CreateComponentFocusNameProperty then
|
|
ShowComponentNameDialog(LookupRoot,NewComponent); // ask user for name
|
|
|
|
// tell IDE about the new component (e.g. add it to the source)
|
|
NotifyComponentAdded(NewComponent);
|
|
|
|
// creation completed
|
|
// -> select new component
|
|
SelectOnlyThisComponent(NewComponent);
|
|
if Assigned(FOnComponentAdded) then // this resets the component palette to the selection tool
|
|
FOnComponentAdded(Self, NewComponent, NewRegisteredComponent);
|
|
|
|
{$IFDEF VerboseDesigner}
|
|
DebugLn('NEW COMPONENT ADDED: Form.ComponentCount=',DbgS(Form.ComponentCount),
|
|
' NewComponent.Owner.Name=',NewComponent.Owner.Name);
|
|
{$ENDIF}
|
|
AddUndoAction(NewComponent, uopAdd, true, 'Name', '', NewComponent.Name);
|
|
end;
|
|
|
|
procedure TDesigner.AddComponentCheckParent(var NewParent: TComponent;
|
|
const OriginComponent: TComponent; const OriginWinControl: TWinControl;
|
|
const NewComponentClass: TComponentClass);
|
|
var
|
|
NewParentControl: TWinControl;
|
|
begin
|
|
//debugln(['TDesigner.AddComponentCheckParent Mediator=',DbgSName(Mediator),' NewParent=',DbgSName(NewParent),' NewComponentClass=',NewComponentClass.ClassName]);
|
|
if Mediator<>nil then begin
|
|
// mediator, non LCL components
|
|
if NewParent=nil then
|
|
NewParent:=OriginComponent;
|
|
while (NewParent<>nil)
|
|
and (not Mediator.ParentAcceptsChild(NewParent,NewComponentClass)) do
|
|
NewParent:=NewParent.GetParentComponent;
|
|
if NewParent=nil then
|
|
NewParent:=FLookupRoot;
|
|
end else if (FLookupRoot is TCustomForm) or (FLookupRoot is TCustomFrame)
|
|
then begin
|
|
// LCL controls
|
|
if NewParent<>nil then begin
|
|
if not (NewParent is TWinControl) then begin
|
|
debugln(['ERROR: AddComponent failed: AddClicked returned not a TWinControl: ',DbgSName(NewParent)]);
|
|
exit;
|
|
end;
|
|
NewParentControl := TWinControl(NewParent);
|
|
end else if OriginComponent is TWinControl then
|
|
NewParentControl := TWinControl(OriginComponent)
|
|
else
|
|
NewParentControl := OriginWinControl;
|
|
|
|
while (NewParentControl <> nil)
|
|
and not ControlAcceptsStreamableChildComponent(NewParentControl,
|
|
NewComponentClass,FLookupRoot)
|
|
do
|
|
NewParentControl := NewParentControl.Parent;
|
|
NewParent := NewParentControl;
|
|
//debugln(['AddComponent NewParent=',DbgSName(NewParent)]);
|
|
end else begin
|
|
// TDataModule
|
|
NewParent := FLookupRoot;
|
|
end;
|
|
end;
|
|
|
|
procedure TDesigner.PrepareFreeDesigner(AFreeComponent: boolean);
|
|
begin
|
|
// was FinalizeFreeDesigner
|
|
Include(FFlags, dfDestroyingForm);
|
|
// free or hide the form
|
|
TheFormEditor.DeleteComponent(FLookupRoot,AFreeComponent);
|
|
DisconnectComponent;
|
|
Free;
|
|
end;
|
|
|
|
procedure TDesigner.DisconnectComponent;
|
|
begin
|
|
//debugln(['TDesigner.DisconnectComponent Self=',dbgs(Pointer(Self))]);
|
|
inherited DisconnectComponent;
|
|
if Mediator<>nil then begin
|
|
Mediator.Designer:=nil;
|
|
FMediator:=nil;
|
|
end;
|
|
FLookupRoot:=nil;
|
|
end;
|
|
|
|
destructor TDesigner.Destroy;
|
|
begin
|
|
//debugln(['TDesigner.Destroy Self=',dbgs(Pointer(Self))]);
|
|
Application.RemoveAsyncCalls(Self);
|
|
PopupMenuComponentEditor := nil;
|
|
FreeAndNil(FDesignerPopupMenu);
|
|
FreeAndNil(FHintWIndow);
|
|
FreeAndNil(FHintTimer);
|
|
FreeAndNil(DDC);
|
|
FreeAndNil(DeletingPersistent);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TDesigner.NudgePosition(DiffX, DiffY : Integer);
|
|
begin
|
|
{$IFDEF VerboseDesigner}
|
|
DebugLn('[TDesigner.NudgePosition]');
|
|
{$ENDIF}
|
|
if (Selection.SelectionForm<>Form)
|
|
or Selection.LookupRootSelected then exit;
|
|
Selection.MoveSelection(DiffX, DiffY, False);
|
|
Modified;
|
|
Form.Invalidate;
|
|
end;
|
|
|
|
procedure TDesigner.NudgeSize(DiffX, DiffY: Integer);
|
|
begin
|
|
{$IFDEF VerboseDesigner}
|
|
DebugLn('[TDesigner.NudgeSize]');
|
|
{$ENDIF}
|
|
if (Selection.SelectionForm<>Form)
|
|
or Selection.LookupRootSelected then exit;
|
|
Selection.SizeSelection(DiffX, DiffY);
|
|
Modified;
|
|
end;
|
|
|
|
function ComponentsSortByLeft(Item1, Item2: Pointer): Integer;
|
|
var
|
|
Comp1: TComponent absolute Item1;
|
|
Comp2: TComponent absolute Item2;
|
|
L1, L2: Integer;
|
|
begin
|
|
L1 := GetComponentLeft(Comp1);
|
|
L2 := GetComponentLeft(Comp2);
|
|
if L1 < L2 then
|
|
Result := -1
|
|
else
|
|
if L1 > L2 then
|
|
Result := 1
|
|
else
|
|
Result := 0;
|
|
end;
|
|
|
|
function ComponentsSortByTop(Item1, Item2: Pointer): Integer;
|
|
var
|
|
Comp1: TComponent absolute Item1;
|
|
Comp2: TComponent absolute Item2;
|
|
T1, T2: Integer;
|
|
begin
|
|
T1 := GetComponentTop(Comp1);
|
|
T2 := GetComponentTop(Comp2);
|
|
if T1 < T2 then
|
|
Result := -1
|
|
else
|
|
if T1 > T2 then
|
|
Result := 1
|
|
else
|
|
Result := 0;
|
|
end;
|
|
|
|
procedure TDesigner.NudgeSelection(DiffX, DiffY: Integer);
|
|
const
|
|
Delta = 50; // radius for searching components
|
|
var
|
|
List: TFPList;
|
|
Coord, Test: TPoint;
|
|
Current, AComponent: TComponent;
|
|
i: integer;
|
|
begin
|
|
if (Selection.SelectionForm <> Form) or
|
|
(Selection.SelectionForm.ComponentCount = 0) or
|
|
Selection.LookupRootSelected or
|
|
(Selection.Count <> 1) then Exit;
|
|
if not Selection[0].IsTComponent then Exit;
|
|
|
|
// create a list of components at the similar top/left
|
|
Current := TComponent(Selection[0].Persistent);
|
|
AComponent := nil;
|
|
List := TFPList.Create;
|
|
try
|
|
Coord := GetParentFormRelativeClientOrigin(Current);
|
|
if DiffX <> 0 then
|
|
begin
|
|
for i := 0 to Selection.SelectionForm.ComponentCount - 1 do
|
|
begin
|
|
AComponent := Selection.SelectionForm.Components[i];
|
|
if (AComponent = Current) or ComponentIsInvisible(AComponent) then
|
|
Continue;
|
|
Test := GetParentFormRelativeClientOrigin(AComponent);
|
|
if (Abs(Test.Y - Coord.Y) <= Delta) and
|
|
(Sign(Test.X - Coord.X) = Sign(DiffX)) then
|
|
List.Add(AComponent);
|
|
end;
|
|
if List.Count > 0 then
|
|
begin
|
|
List.Sort(@ComponentsSortByLeft);
|
|
if DiffX > 0 then
|
|
AComponent := TComponent(List[0])
|
|
else
|
|
AComponent := TComponent(List[List.Count - 1]);
|
|
end
|
|
else
|
|
AComponent := nil;
|
|
end
|
|
else
|
|
if DiffY <> 0 then
|
|
begin
|
|
for i := 0 to Selection.SelectionForm.ComponentCount - 1 do
|
|
begin
|
|
AComponent := Selection.SelectionForm.Components[i];
|
|
if (AComponent = Current) or ComponentIsInvisible(AComponent) then
|
|
Continue;
|
|
Test := GetParentFormRelativeClientOrigin(AComponent);
|
|
if (Abs(Test.X - Coord.X) <= Delta) and
|
|
(Sign(Test.Y - Coord.Y) = Sign(DiffY)) then
|
|
List.Add(AComponent);
|
|
end;
|
|
if List.Count > 0 then
|
|
begin
|
|
List.Sort(@ComponentsSortByTop);
|
|
if DiffY > 0 then
|
|
AComponent := TComponent(List[0])
|
|
else
|
|
AComponent := TComponent(List[List.Count - 1]);
|
|
end
|
|
else
|
|
AComponent := nil;
|
|
end;
|
|
finally
|
|
List.Free;
|
|
end;
|
|
if AComponent <> nil then
|
|
begin
|
|
Selection.AssignPersistent(AComponent);
|
|
Modified;
|
|
end;
|
|
end;
|
|
|
|
procedure TDesigner.NudgeSelection(SelectNext: Boolean);
|
|
|
|
function StepIndex(Index: Integer): Integer;
|
|
begin
|
|
Result := Index;
|
|
if SelectNext then
|
|
Inc(Result)
|
|
else
|
|
Dec(Result);
|
|
|
|
if Result >= Selection.SelectionForm.ComponentCount then
|
|
Result := 0
|
|
else
|
|
if Result < 0 then
|
|
Result := Selection.SelectionForm.ComponentCount - 1;
|
|
end;
|
|
|
|
var
|
|
Index, StartIndex: Integer;
|
|
AComponent: TComponent;
|
|
begin
|
|
if (Selection.SelectionForm <> Form) or
|
|
(Selection.SelectionForm.ComponentCount = 0) then Exit;
|
|
if (Selection.Count = 1) and Selection[0].IsTComponent then
|
|
Index := TComponent(Selection[0].Persistent).ComponentIndex
|
|
else
|
|
Index := -1;
|
|
|
|
Index := StepIndex(Index);
|
|
StartIndex := Index;
|
|
|
|
AComponent := nil;
|
|
while AComponent = nil do
|
|
begin
|
|
AComponent := Selection.SelectionForm.Components[Index];
|
|
if ComponentIsInvisible(AComponent) then
|
|
begin
|
|
AComponent := nil;
|
|
Index := StepIndex(Index);
|
|
if Index = StartIndex then
|
|
break;
|
|
end;
|
|
end;
|
|
|
|
if AComponent <> nil then
|
|
begin
|
|
Selection.AssignPersistent(AComponent);
|
|
Modified;
|
|
end;
|
|
end;
|
|
|
|
procedure TDesigner.SelectParentOfSelection;
|
|
|
|
function ParentComponent(AComponent: TComponent): TComponent;
|
|
begin
|
|
Result := AComponent.GetParentComponent;
|
|
if (Result = nil) and ComponentIsIcon(AComponent) then
|
|
Result := AComponent.Owner;
|
|
end;
|
|
|
|
var
|
|
i: Integer;
|
|
begin
|
|
// resizing or moving
|
|
if dfHasSized in FFlags then
|
|
begin
|
|
Selection.RestoreBounds;
|
|
Selection.ActiveGrabber := nil;
|
|
Selection.RubberbandActive := False;
|
|
LastMouseMovePos.X := -1;
|
|
Exclude(FFlags, dfHasSized);
|
|
MouseDownComponent := nil;
|
|
MouseDownSender := nil;
|
|
Exit;
|
|
end;
|
|
|
|
if Selection.OnlyInvisiblePersistentsSelected then
|
|
Exit;
|
|
|
|
if Selection.LookupRootSelected then
|
|
begin
|
|
SelectOnlyThisComponent(FLookupRoot);
|
|
Exit;
|
|
end;
|
|
|
|
// if not component moving then select parent
|
|
i := Selection.Count - 1;
|
|
while (i >= 0) and
|
|
(
|
|
Selection[i].ParentInSelection or
|
|
not Selection[i].IsTComponent or
|
|
(ParentComponent(TComponent(Selection[i].Persistent)) = nil)
|
|
)
|
|
do
|
|
Dec(i);
|
|
|
|
if i >= 0 then
|
|
SelectOnlyThisComponent(ParentComponent(TComponent(Selection[i].Persistent)));
|
|
end;
|
|
|
|
function TDesigner.CopySelectionToStream(AllComponentsStream: TStream): boolean;
|
|
|
|
function UnselectDistinctControls: boolean;
|
|
var
|
|
i: Integer;
|
|
AParent, CurParent: TWinControl;
|
|
begin
|
|
Result:=false;
|
|
AParent:=nil;
|
|
i:=0;
|
|
while i<Selection.Count do begin
|
|
if Selection[i].IsTControl then begin
|
|
// unselect controls from which the parent is selected too
|
|
if Selection[i].ParentInSelection then begin
|
|
Selection.Delete(i);
|
|
continue;
|
|
end;
|
|
|
|
// check if not the top level component is selected
|
|
CurParent:=TControl(Selection[i].Persistent).Parent;
|
|
if CurParent=nil then begin
|
|
IDEMessageDialog(lisCanNotCopyTopLevelComponent,
|
|
lisCopyingAWholeFormIsNotImplemented,
|
|
mtError,[mbOk]);
|
|
exit;
|
|
end;
|
|
|
|
// unselect all controls, that do not have the same parent
|
|
if (AParent=nil) then
|
|
AParent:=CurParent
|
|
else if (AParent<>CurParent) then begin
|
|
Selection.Delete(i);
|
|
continue;
|
|
end;
|
|
end;
|
|
inc(i);
|
|
end;
|
|
Result:=true;
|
|
end;
|
|
|
|
var
|
|
i: Integer;
|
|
BinCompStream: TMemoryStream;
|
|
TxtCompStream: TMemoryStream;
|
|
CurComponent: TComponent;
|
|
DestroyDriver: Boolean;
|
|
Writer: TWriter;
|
|
begin
|
|
Result:=false;
|
|
if (Selection.Count=0) then exit;
|
|
|
|
// Because controls will be pasted on a single parent,
|
|
// unselect all controls, that do not have the same parent
|
|
if not UnselectDistinctControls then exit;
|
|
|
|
for i:=0 to Selection.Count-1 do begin
|
|
if not Selection[i].IsTComponent then continue;
|
|
|
|
BinCompStream:=TMemoryStream.Create;
|
|
TxtCompStream:=TMemoryStream.Create;
|
|
try
|
|
// write component binary stream
|
|
try
|
|
CurComponent:=TComponent(Selection[i].Persistent);
|
|
|
|
DestroyDriver:=false;
|
|
Writer := CreateLRSWriter(BinCompStream,DestroyDriver);
|
|
try
|
|
Writer.OnWriteMethodProperty:=@BaseFormEditor1.WriteMethodPropertyEvent;
|
|
Writer.Root:=FLookupRoot;
|
|
Writer.WriteComponent(CurComponent);
|
|
finally
|
|
if DestroyDriver then Writer.Driver.Free;
|
|
Writer.Destroy;
|
|
end;
|
|
except
|
|
on E: Exception do begin
|
|
IDEMessageDialog(lisUnableToStreamSelectedComponents,
|
|
Format(lisThereWasAnErrorDuringWritingTheSelectedComponent, [
|
|
CurComponent.Name, CurComponent.ClassName, LineEnding, E.Message]),
|
|
mtError,[mbOk]);
|
|
exit;
|
|
end;
|
|
end;
|
|
BinCompStream.Position:=0;
|
|
// convert binary to text stream
|
|
try
|
|
LRSObjectBinaryToText(BinCompStream,TxtCompStream);
|
|
except
|
|
on E: Exception do begin
|
|
IDEMessageDialog(lisUnableConvertBinaryStreamToText,
|
|
Format(lisThereWasAnErrorWhileConvertingTheBinaryStreamOfThe, [
|
|
CurComponent.Name, CurComponent.ClassName, LineEnding, E.Message]),
|
|
mtError,[mbOk]);
|
|
exit;
|
|
end;
|
|
end;
|
|
// add text stream to the all stream
|
|
TxtCompStream.Position:=0;
|
|
AllComponentsStream.CopyFrom(TxtCompStream,TxtCompStream.Size);
|
|
finally
|
|
BinCompStream.Free;
|
|
TxtCompStream.Free;
|
|
end;
|
|
end;
|
|
Result:=true;
|
|
end;
|
|
|
|
function TDesigner.InsertFromStream(s: TStream; Parent: TWinControl;
|
|
PasteFlags: TComponentPasteSelectionFlags): Boolean;
|
|
begin
|
|
Result:=DoInsertFromStream(s,Parent,PasteFlags);
|
|
end;
|
|
|
|
function TDesigner.DoCopySelectionToClipboard: boolean;
|
|
var
|
|
AllComponentsStream: TMemoryStream;
|
|
AllComponentText: string;
|
|
begin
|
|
Result := false;
|
|
if Selection.Count = 0 then exit;
|
|
if Selection.OnlyInvisiblePersistentsSelected then exit;
|
|
|
|
AllComponentsStream:=TMemoryStream.Create;
|
|
try
|
|
// copy components to stream
|
|
if not CopySelectionToStream(AllComponentsStream) then exit;
|
|
SetLength(AllComponentText{%H-},AllComponentsStream.Size);
|
|
if AllComponentText<>'' then begin
|
|
AllComponentsStream.Position:=0;
|
|
AllComponentsStream.Read(AllComponentText[1],length(AllComponentText));
|
|
end;
|
|
|
|
// copy to clipboard
|
|
try
|
|
ClipBoard.AsText:=AllComponentText;
|
|
except
|
|
on E: Exception do begin
|
|
IDEMessageDialog(lisUnableCopyComponentsToClipboard,
|
|
Format(lisThereWasAnErrorWhileCopyingTheComponentStreamToCli,
|
|
[LineEnding, E.Message]),
|
|
mtError,[mbOk]);
|
|
exit;
|
|
end;
|
|
end;
|
|
finally
|
|
AllComponentsStream.Free;
|
|
end;
|
|
Result:=true;
|
|
end;
|
|
|
|
function TDesigner.GetPasteParent: TWinControl;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
Result:=nil;
|
|
for i:=0 to Selection.Count-1 do begin
|
|
if (Selection[i].IsTWinControl)
|
|
and (csAcceptsControls in
|
|
TWinControl(Selection[i].Persistent).ControlStyle)
|
|
and (not Selection[i].ParentInSelection) then begin
|
|
Result:=TWinControl(Selection[i].Persistent);
|
|
if GetLookupRootForComponent(Result)<>FLookupRoot then
|
|
Result:=nil;
|
|
break;
|
|
end;
|
|
end;
|
|
if (Result=nil) and (FLookupRoot is TWinControl) then
|
|
Result:=TWinControl(FLookupRoot);
|
|
end;
|
|
|
|
procedure TDesigner.DoModified;
|
|
begin
|
|
if Assigned(OnModified) then
|
|
OnModified(Self)
|
|
end;
|
|
|
|
function TDesigner.DoPasteSelectionFromClipboard(
|
|
PasteFlags: TComponentPasteSelectionFlags): boolean;
|
|
var
|
|
AllComponentText: string;
|
|
CurTextCompStream: TMemoryStream;
|
|
begin
|
|
Result:=false;
|
|
if not CanPaste then exit;
|
|
// read component stream from clipboard
|
|
AllComponentText:=ClipBoard.AsText;
|
|
if AllComponentText='' then exit;
|
|
CurTextCompStream:=TMemoryStream.Create;
|
|
try
|
|
CurTextCompStream.Write(AllComponentText[1],length(AllComponentText));
|
|
CurTextCompStream.Position:=0;
|
|
if not DoInsertFromStream(CurTextCompStream,nil,PasteFlags) then
|
|
exit;
|
|
finally
|
|
CurTextCompStream.Free;
|
|
end;
|
|
Result:=true;
|
|
end;
|
|
|
|
function TDesigner.DoInsertFromStream(s: TStream;
|
|
PasteParent: TWinControl; PasteFlags: TComponentPasteSelectionFlags): Boolean;
|
|
var
|
|
NewSelection: TPersistentSelectionList;
|
|
NewComps: TFPList;
|
|
|
|
procedure FindUniquePosition(AComponent: TComponent);
|
|
var
|
|
OverlappedComponent: TComponent;
|
|
P: TPoint;
|
|
AControl: TControl;
|
|
AParent: TWinControl;
|
|
i: Integer;
|
|
OverlappedControl: TControl;
|
|
begin
|
|
if AComponent is TControl then begin
|
|
AControl:=TControl(AComponent);
|
|
AParent:=AControl.Parent;
|
|
if AParent=nil then exit;
|
|
P:=Point(AControl.Left,AControl.Top);
|
|
i:=AParent.ControlCount-1;
|
|
while i>=0 do begin
|
|
OverlappedControl:=AParent.Controls[i];
|
|
if (NewComps.IndexOf(OverlappedControl)<0)
|
|
and (OverlappedControl.Left=P.X)
|
|
and (OverlappedControl.Top=P.Y) then begin
|
|
inc(P.X,NonVisualCompWidth);
|
|
inc(P.Y,NonVisualCompWidth);
|
|
if (P.X>AParent.ClientWidth-AControl.Width)
|
|
or (P.Y>AParent.ClientHeight-AControl.Height) then
|
|
break;
|
|
i:=AParent.ControlCount-1;
|
|
end else
|
|
dec(i);
|
|
end;
|
|
P.x:=Max(0,Min(P.x,AParent.ClientWidth-AControl.Width));
|
|
P.y:=Max(0,Min(P.y,AParent.ClientHeight-AControl.Height));
|
|
AControl.SetBounds(P.x,P.y,AControl.Width,AControl.Height);
|
|
end else begin
|
|
P:=GetParentFormRelativeTopLeft(AComponent);
|
|
repeat
|
|
OverlappedComponent:=NonVisualComponentAtPos(P.x,P.y);
|
|
if (OverlappedComponent=nil) then break;
|
|
inc(P.X,NonVisualCompWidth);
|
|
inc(P.Y,NonVisualCompWidth);
|
|
if (P.X+NonVisualCompWidth>Form.ClientWidth)
|
|
or (P.Y+NonVisualCompWidth>Form.ClientHeight) then
|
|
break;
|
|
until false;
|
|
AComponent.DesignInfo := LeftTopToDesignInfo(
|
|
SmallInt(Max(0, Min(P.x, Form.ClientWidth - NonVisualCompWidth))),
|
|
SmallInt(Max(0, Min(P.y, Form.ClientHeight - NonVisualCompWidth))));
|
|
end;
|
|
end;
|
|
|
|
var
|
|
i: Integer;
|
|
NewComponent: TComponent;
|
|
begin
|
|
Result:=false;
|
|
//debugln('TDesigner.DoInsertFromStream A');
|
|
if (cpsfReplace in PasteFlags) and (not DeleteSelection) then exit;
|
|
|
|
//debugln('TDesigner.DoInsertFromStream B s.Size=',dbgs(s.Size),' S.Position=',dbgs(S.Position));
|
|
if PasteParent=nil then PasteParent:=GetPasteParent;
|
|
NewSelection:=TPersistentSelectionList.Create;
|
|
NewComps:=TFPList.Create;
|
|
try
|
|
Form.DisableAutoSizing{$IFDEF DebugDisableAutoSizing}('TDesigner.DoInsertFromStream'){$ENDIF};
|
|
try
|
|
|
|
// read component stream from clipboard
|
|
if (s.Size<=S.Position) then begin
|
|
debugln('TDesigner.DoInsertFromStream Stream Empty s.Size=',dbgs(s.Size),' S.Position=',dbgs(S.Position));
|
|
exit;
|
|
end;
|
|
|
|
// create components and add to LookupRoot
|
|
FOnPasteComponent(Self,FLookupRoot,s,PasteParent,NewComps);
|
|
// add new component to new selection
|
|
for i:=0 to NewComps.Count-1 do begin
|
|
NewComponent:=TComponent(NewComps[i]);
|
|
NewSelection.Add(NewComponent);
|
|
// set new nice bounds
|
|
if cpsfFindUniquePositions in PasteFlags then
|
|
FindUniquePosition(NewComponent);
|
|
// finish adding component
|
|
NotifyComponentAdded(NewComponent);
|
|
Modified;
|
|
// add action in undo list
|
|
AddUndoAction(NewComponent, uopAdd, i = 0, 'Name', '', NewComponent.Name);
|
|
end;
|
|
|
|
if NewSelection.Count>0 then
|
|
FOnPastedComponents(Self,FLookupRoot);
|
|
|
|
finally
|
|
Form.EnableAutoSizing{$IFDEF DebugDisableAutoSizing}('TDesigner.DoInsertFromStream'){$ENDIF};
|
|
end;
|
|
finally
|
|
NewComps.Free;
|
|
if NewSelection.Count>0 then
|
|
Selection.AssignSelection(NewSelection);
|
|
NewSelection.Free;
|
|
end;
|
|
Result:=true;
|
|
end;
|
|
|
|
function TDesigner.DoUndo: Boolean;
|
|
var GroupId: int64;
|
|
begin
|
|
repeat
|
|
Result := CanUndo;
|
|
if not Result then Exit;
|
|
Dec(FUndoCurr);
|
|
GroupId := FUndoList[FUndoCurr].GroupId;
|
|
ExecuteUndoItem(true);
|
|
until (FUndoCurr=Low(FUndoList)) or (GroupId <> FUndoList[FUndoCurr - 1].GroupId);
|
|
end;
|
|
|
|
function TDesigner.DoRedo: Boolean;
|
|
var GroupId: int64;
|
|
begin
|
|
repeat
|
|
Result := CanRedo;
|
|
if not Result then Exit;
|
|
ExecuteUndoItem(false);
|
|
GroupId := FUndoList[FUndoCurr].GroupId;
|
|
Inc(FUndoCurr);
|
|
until (FUndoCurr>High(FUndoList)) or (GroupId <> FUndoList[FUndoCurr].GroupId);
|
|
end;
|
|
|
|
procedure TDesigner.ExecuteUndoItem(IsActUndo: boolean);
|
|
var
|
|
AValue: Variant;
|
|
ValueStr, tmpFieldN: string;
|
|
tmpObj: TComponent;
|
|
|
|
procedure SetPublished; // published field
|
|
var
|
|
aPropType: PTypeInfo;
|
|
s: string;
|
|
i: integer;
|
|
begin
|
|
aPropType:=FUndoList[FUndoCurr].propInfo^.propType;
|
|
case aPropType^.Kind of
|
|
tkInteger, tkInt64:
|
|
begin
|
|
if (aPropType^.Name = 'TColor') or
|
|
(aPropType^.Name = 'TGraphicsColor') then
|
|
SetOrdProp(tmpObj, tmpFieldN, StringToColor(ValueStr))
|
|
else if aPropType^.Name = 'TCursor' then
|
|
SetOrdProp(tmpObj, tmpFieldN, StringToCursor(ValueStr))
|
|
else
|
|
SetOrdProp(tmpObj, tmpFieldN, StrToInt(ValueStr));
|
|
end;
|
|
tkChar, tkWChar, tkUChar:
|
|
begin
|
|
if Length(ValueStr) = 1 then
|
|
SetOrdProp(tmpObj, tmpFieldN, Ord(ValueStr[1]))
|
|
else if (ValueStr[1] = '#') then
|
|
begin
|
|
s := Copy(ValueStr, 2, Length(ValueStr) - 1);
|
|
if TryStrToInt(s, i) and (i >= 0) and (i <= High(Byte)) then
|
|
SetOrdProp(tmpObj, tmpFieldN, i);
|
|
end;
|
|
end;
|
|
tkEnumeration:
|
|
SetEnumProp(tmpObj, tmpFieldN, ValueStr);
|
|
tkFloat:
|
|
SetFloatProp(tmpObj, tmpFieldN, StrToFloat(ValueStr));
|
|
tkBool:
|
|
SetOrdProp(tmpObj, tmpFieldN, Integer(StrToBoolOI(ValueStr)));
|
|
tkString, tkLString, tkAString, tkUString, tkWString:
|
|
SetStrProp(tmpObj, tmpFieldN, ValueStr);
|
|
tkSet:
|
|
SetSetProp(tmpObj, tmpFieldN, ValueStr);
|
|
tkVariant:
|
|
SetVariantProp(tmpObj, tmpFieldN, AValue);
|
|
else
|
|
ShowMessage(Format('error: unknown TTypeKind(%d)', [Integer(aPropType^.Kind)]));
|
|
end;
|
|
end;
|
|
|
|
procedure SetUnPublished; // field is not published
|
|
var
|
|
NewParent: TComponent;
|
|
begin
|
|
if tmpObj is TControl then
|
|
begin
|
|
if CompareText(tmpFieldN,'Parent')=0 then // Special treatment for Parent.
|
|
begin
|
|
if FForm.Name <> ValueStr then // Find the parent by name.
|
|
NewParent := FForm.FindComponent(ValueStr)
|
|
else
|
|
NewParent := FForm;
|
|
Assert(NewParent is TWinControl, 'TDesigner.ExecuteUndoItem: New Parent "'
|
|
+ DbgS(NewParent) + '" is not a TWinControl.');
|
|
TControl(tmpObj).Parent := TWinControl(NewParent);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
var
|
|
CurTextCompStream: TMemoryStream;
|
|
SaveControlSelection: TControlSelection;
|
|
CompN: TComponentName;
|
|
begin
|
|
// Undo Add component
|
|
if (IsActUndo and (FUndoList[FUndoCurr].opType = uopAdd)) or
|
|
(not IsActUndo and (FUndoList[FUndoCurr].opType = uopDelete)) then
|
|
begin
|
|
Selection.BeginUpdate;
|
|
try
|
|
SaveControlSelection := TControlSelection.Create;
|
|
try
|
|
Inc(FUndoLock);
|
|
SaveControlSelection.Assign(Selection);
|
|
Selection.AssignPersistent(FForm.FindComponent(FUndoList[FUndoCurr].compName));
|
|
DeleteSelection;
|
|
finally
|
|
Dec(FUndoLock);
|
|
Selection.Assign(SaveControlSelection);
|
|
SaveControlSelection.Free;
|
|
end;
|
|
finally
|
|
Selection.EndUpdate;
|
|
end;
|
|
end;
|
|
|
|
// Undo Delete component
|
|
if (IsActUndo and (FUndoList[FUndoCurr].opType = uopDelete)) or
|
|
(not IsActUndo and (FUndoList[FUndoCurr].opType = uopAdd)) then
|
|
begin
|
|
CurTextCompStream := TMemoryStream.Create;
|
|
try
|
|
Inc(FUndoLock);
|
|
CurTextCompStream.Write(FUndoList[FUndoCurr].obj[1], Length(FUndoList[FUndoCurr].obj));
|
|
CurTextCompStream.Position := 0;
|
|
DoInsertFromStream(CurTextCompStream,
|
|
TWinControl(FForm.FindChildControl(FUndoList[FUndoCurr].parentName)), []);
|
|
finally
|
|
Dec(FUndoLock);
|
|
CurTextCompStream.Free;
|
|
end;
|
|
end;
|
|
|
|
// Undo Change properties of component
|
|
if FUndoList[FUndoCurr].opType = uopChange then
|
|
begin
|
|
Inc(FUndoLock);
|
|
try
|
|
tmpFieldN := FUndoList[FUndoCurr].fieldName;
|
|
if tmpFieldN = 'Name' then
|
|
begin
|
|
if IsActUndo then
|
|
CompN := String(FUndoList[FUndoCurr].newVal)
|
|
else
|
|
CompN := String(FUndoList[FUndoCurr].oldVal);
|
|
end
|
|
else
|
|
CompN := FUndoList[FUndoCurr].compName;
|
|
|
|
if FForm.Name <> CompN then
|
|
tmpObj := FForm.FindSubComponent(CompN)
|
|
else
|
|
tmpObj := FForm;
|
|
|
|
if IsActUndo then
|
|
AValue := FUndoList[FUndoCurr].oldVal
|
|
else
|
|
AValue := FUndoList[FUndoCurr].newVal;
|
|
if VarIsError(AValue) or VarIsEmpty(AValue) or VarIsNull(AValue) then
|
|
ShowMessage('error: invalid var type');
|
|
ValueStr := VarToStr(AValue);
|
|
//DebugLn(['TDesigner.ExecuteUndoItem: FForm=', FForm.Name, ', CompName=', CompN,
|
|
// ', FieldName=', tmpFieldN, ', tmpObj=', tmpObj, ', tmpStr=', ValueStr, ', IsActUndo=', IsActUndo]);
|
|
|
|
if FUndoList[FUndoCurr].propInfo<>nil then
|
|
SetPublished
|
|
else
|
|
SetUnPublished;
|
|
PropertyEditorHook.Modified(tmpObj);
|
|
finally
|
|
Dec(FUndoLock);
|
|
end;
|
|
end;
|
|
|
|
PropertyEditorHook.RefreshPropertyValues;
|
|
end;
|
|
|
|
procedure TDesigner.DoShowAnchorEditor;
|
|
begin
|
|
if Assigned(FOnShowAnchorEditor) then
|
|
FOnShowAnchorEditor(Self);
|
|
end;
|
|
|
|
procedure TDesigner.DoShowTabOrderEditor;
|
|
begin
|
|
if Assigned(FOnShowTabOrderEditor) then
|
|
FOnShowTabOrderEditor(Self);
|
|
end;
|
|
|
|
procedure TDesigner.DoShowObjectInspector;
|
|
begin
|
|
if Assigned(FOnShowObjectInspector) then
|
|
OnShowObjectInspector(Self);
|
|
end;
|
|
|
|
procedure TDesigner.DoChangeZOrder(TheAction: TChangeOrderAction);
|
|
var
|
|
Control: TControl;
|
|
Parent: TWinControl;
|
|
OI: TObjectInspectorDlg;
|
|
begin
|
|
if Selection.Count <> 1 then Exit;
|
|
if not Selection[0].IsTControl then Exit;
|
|
|
|
Control := TControl(Selection[0].Persistent);
|
|
Parent := Control.Parent;
|
|
if (Parent = nil) and (TheAction in [coaForwardOne, coaBackOne]) then Exit;
|
|
|
|
case TheAction of
|
|
coaMoveToFront: Control.BringToFront;
|
|
coaMoveToBack : Control.SendToBack;
|
|
coaForwardOne : Parent.SetControlIndex(Control, Parent.GetControlIndex(Control) + 1);
|
|
coaBackOne : Parent.SetControlIndex(Control, Parent.GetControlIndex(Control) - 1);
|
|
end;
|
|
|
|
// Ensure the order of controls in the OI now reflects the new ZOrder
|
|
// Unfortunately, if there is no parent, this code doesn't achieve a refresh
|
|
// of ComponentTree in the OI
|
|
if assigned(Parent) then
|
|
begin
|
|
Parent.ReAlign;
|
|
SelectOnlyThisComponent(Parent);
|
|
end;
|
|
SelectOnlyThisComponent(Control);
|
|
|
|
Modified;
|
|
OI := FormEditingHook.GetCurrentObjectInspector;
|
|
if Assigned(OI) then
|
|
OI.ComponentTree.BuildComponentNodes(True);
|
|
end;
|
|
|
|
procedure TDesigner.NotifyComponentAdded(AComponent: TComponent);
|
|
var
|
|
i: Integer;
|
|
SubContrl: TControl;
|
|
begin
|
|
try
|
|
if AComponent.Name='' then
|
|
AComponent.Name:=UniqueName(AComponent.ClassName);
|
|
// Iterating Controls is needed at least for Side1 and Side2 of TPairSplitter.
|
|
if AComponent is TWinControl then
|
|
for i:=0 to TWinControl(AComponent).ControlCount-1 do
|
|
begin
|
|
SubContrl:=TWinControl(AComponent).Controls[i];
|
|
if (SubContrl.Owner<>AComponent) and (SubContrl.Name='') then
|
|
SubContrl.Name:=UniqueName(SubContrl.ClassName);
|
|
end;
|
|
GlobalDesignHook.PersistentAdded(AComponent,false);
|
|
except
|
|
on E: Exception do
|
|
IDEMessageDialog('Error:',E.Message,mtError,[mbOk]);
|
|
end;
|
|
end;
|
|
|
|
procedure TDesigner.SelectOnlyThisComponent(AComponent: TComponent);
|
|
begin
|
|
Selection.AssignPersistent(AComponent);
|
|
end;
|
|
|
|
function TDesigner.CopySelection: boolean;
|
|
begin
|
|
Result := DoCopySelectionToClipboard;
|
|
end;
|
|
|
|
function TDesigner.CutSelection: boolean;
|
|
begin
|
|
Result := DoCopySelectionToClipboard and DoDeleteSelectedPersistents;
|
|
end;
|
|
|
|
procedure TDesigner.CutSelectionAsync(Data: PtrInt);
|
|
begin
|
|
CutSelection;
|
|
end;
|
|
|
|
function TDesigner.CanCopy: Boolean;
|
|
begin
|
|
Result := (Selection.Count > 0) and
|
|
(Selection.SelectionForm = Form) and
|
|
Selection.OkToCopy and
|
|
not Selection.OnlyInvisiblePersistentsSelected and
|
|
not Selection.LookupRootSelected;
|
|
end;
|
|
|
|
function TDesigner.CanPaste: Boolean;
|
|
begin
|
|
Result:= Assigned(Form) and
|
|
Assigned(FLookupRoot) and
|
|
ClipBoard.HasFormat(CF_Text) and
|
|
not (csDestroying in FLookupRoot.ComponentState);
|
|
end;
|
|
|
|
function TDesigner.PasteSelection(
|
|
PasteFlags: TComponentPasteSelectionFlags): boolean;
|
|
begin
|
|
Result:=DoPasteSelectionFromClipboard(PasteFlags);
|
|
end;
|
|
|
|
function TDesigner.ClearSelection: boolean;
|
|
begin
|
|
Selection.Clear;
|
|
Result:=Selection.Count=0;
|
|
end;
|
|
|
|
function TDesigner.DeleteSelection: boolean;
|
|
begin
|
|
Result:=DoDeleteSelectedPersistents;
|
|
end;
|
|
|
|
function TDesigner.InvokeComponentEditor(AComponent: TComponent): boolean;
|
|
begin
|
|
Result:=false;
|
|
DebugLn('TDesigner.InvokeComponentEditor A ',AComponent.Name,':',AComponent.ClassName);
|
|
PopupMenuComponentEditor:=TheFormEditor.GetComponentEditor(AComponent);
|
|
if PopupMenuComponentEditor=nil then begin
|
|
DebugLn('TDesigner.InvokeComponentEditor WARNING: no component editor found for ',
|
|
AComponent.Name,':',AComponent.ClassName);
|
|
exit;
|
|
end;
|
|
DebugLn('TDesigner.InvokeComponentEditor B ',PopupMenuComponentEditor.ClassName);
|
|
try
|
|
PopupMenuComponentEditor.Edit;
|
|
Result:=true;
|
|
except
|
|
on E: Exception do begin
|
|
DebugLn('TDesigner.InvokeComponentEditor ERROR: ',E.Message);
|
|
IDEMessageDialog(Format(lisErrorIn, [PopupMenuComponentEditor.ClassName]),
|
|
Format(lisTheComponentEditorOfClassHasCreatedTheError,
|
|
[PopupMenuComponentEditor.ClassName, LineEnding, E.Message]),
|
|
mtError,[mbOk]);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TDesigner.ChangeClass: boolean;
|
|
begin
|
|
if (Selection.Count=1) and (not Selection.LookupRootSelected) then
|
|
Result:=ShowChangeClassDialog(Self,Selection[0].Persistent)=mrOK
|
|
else
|
|
Result:=false;
|
|
end;
|
|
|
|
procedure TDesigner.DoProcessCommand(Sender: TObject; var Command: word;
|
|
var Handled: boolean);
|
|
begin
|
|
if Assigned(OnProcessCommand) and (Command <> ecNone)
|
|
then begin
|
|
OnProcessCommand(Self,Command,Handled);
|
|
Handled := Handled or (Command = ecNone);
|
|
end;
|
|
|
|
if Handled then Exit;
|
|
|
|
case Command of
|
|
ecDesignerSelectParent : SelectParentOfSelection;
|
|
ecDesignerCopy : CopySelection;
|
|
ecDesignerCut : CutSelection;
|
|
ecDesignerPaste : PasteSelection([cpsfFindUniquePositions]);
|
|
ecDesignerMoveToFront : DoChangeZOrder(coaMoveToFront);
|
|
ecDesignerMoveToBack : DoChangeZOrder(coaMoveToBack);
|
|
ecDesignerForwardOne : DoChangeZOrder(coaForwardOne);
|
|
ecDesignerBackOne : DoChangeZOrder(coaBackOne );
|
|
ecDesignerToggleNonVisComps: ShowNonVisualComponents:=not ShowNonVisualComponents;
|
|
else
|
|
Exit;
|
|
end;
|
|
|
|
Handled := True;
|
|
end;
|
|
|
|
function TDesigner.CanUndo: Boolean;
|
|
begin
|
|
Result := Assigned(Form) and (FUndoCurr > Low(FUndoList)) and
|
|
(FUndoList[FUndoCurr - 1].isValid) and (FUndoList[FUndoCurr - 1].opType <> uopNone);
|
|
end;
|
|
|
|
function TDesigner.CanRedo: Boolean;
|
|
begin
|
|
Result := Assigned(Form) and (FUndoCurr <= High(FUndoList)) and
|
|
(FUndoList[FUndoCurr].isValid) and (FUndoList[FUndoCurr].opType <> uopNone);
|
|
end;
|
|
|
|
function TDesigner.Undo: Boolean;
|
|
begin
|
|
Result := DoUndo;
|
|
end;
|
|
|
|
function TDesigner.Redo: Boolean;
|
|
begin
|
|
Result := DoRedo;
|
|
end;
|
|
|
|
function TDesigner.AddUndoAction(const aPersistent: TPersistent;
|
|
aOpType: TUndoOpType; StartNewGroup: boolean; aFieldName: string;
|
|
const aOldVal, aNewVal: Variant): boolean;
|
|
|
|
procedure ShiftUndoList;
|
|
var
|
|
i: integer;
|
|
begin
|
|
for i := Low(FUndoList) + 1 to High(FUndoList) do
|
|
FUndoList[i - 1] := FUndoList[i];
|
|
ClearUndoItem(High(FUndoList));
|
|
Dec(FUndoCurr);
|
|
end;
|
|
|
|
var
|
|
i: integer;
|
|
SaveControlSelection: TControlSelection;
|
|
AStream: TStringStream;
|
|
APropInfo: PPropInfo;
|
|
Comp: TComponent;
|
|
begin
|
|
Result := (FUndoLock = 0);
|
|
if not Result then Exit;
|
|
|
|
APropInfo := GetPropInfo(aPersistent, aFieldName);
|
|
|
|
Inc(FUndoLock);
|
|
try
|
|
if FUndoCurr > High(FUndoList) then
|
|
ShiftUndoList;
|
|
|
|
// clear Redo items
|
|
i := FUndoCurr;
|
|
while (i <= High(FUndoList)) do
|
|
begin
|
|
ClearUndoItem(i);
|
|
Inc(i);
|
|
end;
|
|
|
|
if StartNewGroup then
|
|
SetNextUndoGroupId;
|
|
|
|
if (aOpType in [uopAdd, uopDelete]) and (FForm <> aPersistent) then
|
|
begin
|
|
Selection.BeginUpdate;
|
|
try
|
|
SaveControlSelection := TControlSelection.Create;
|
|
try
|
|
SaveControlSelection.Assign(Selection);
|
|
AStream := TStringStream.Create('');
|
|
try
|
|
Selection.AssignPersistent(aPersistent);
|
|
CopySelectionToStream(AStream);
|
|
FUndoList[FUndoCurr].obj := AStream.DataString;
|
|
finally
|
|
AStream.Free;
|
|
end;
|
|
finally
|
|
Selection.Assign(SaveControlSelection);
|
|
SaveControlSelection.Free;
|
|
end;
|
|
finally
|
|
Selection.EndUpdate;
|
|
end;
|
|
end;
|
|
|
|
// add to FUndoList
|
|
with FUndoList[FUndoCurr] do
|
|
begin
|
|
oldVal := aOldVal;
|
|
newVal := aNewVal;
|
|
fieldName := aFieldName;
|
|
compName := '';
|
|
parentName := '';
|
|
if aPersistent is TComponent then begin
|
|
Comp := TComponent(aPersistent);
|
|
compName := Comp.Name;
|
|
// Add owner to the name of a subcomponent.
|
|
if Assigned(Comp.Owner) and (Comp.Owner <> LookupRoot) then
|
|
compName := Comp.Owner.Name + '.' + compName;
|
|
if Comp.HasParent then
|
|
parentName := Comp.GetParentComponent.Name;
|
|
end;
|
|
opType := aOpType;
|
|
isValid := true;
|
|
GroupId := FUndoGroupId;
|
|
propInfo := APropInfo;
|
|
end;
|
|
Inc(FUndoCurr);
|
|
finally
|
|
Dec(FUndoLock);
|
|
end;
|
|
end;
|
|
|
|
function TDesigner.IsUndoLocked: boolean;
|
|
begin
|
|
Result := FUndoLock > 0;
|
|
end;
|
|
|
|
procedure TDesigner.ClearUndoItem(AIndex: Integer);
|
|
begin
|
|
if (AIndex < 0) or (AIndex >= Length(FUndoList)) then Exit;
|
|
with FUndoList[AIndex] do
|
|
begin
|
|
obj := '';
|
|
fieldName := '';
|
|
VarClear(oldVal);
|
|
VarClear(newVal);
|
|
compName := '';
|
|
parentName := '';
|
|
opType := uopNone;
|
|
isValid := false;
|
|
GroupId := 0;
|
|
end;
|
|
end;
|
|
|
|
function TDesigner.NonVisualComponentLeftTop(AComponent: TComponent): TPoint;
|
|
var
|
|
ParentForm: TPoint;
|
|
begin
|
|
Result.X := LeftFromDesignInfo(AComponent.DesignInfo);
|
|
Result.Y := TopFromDesignInfo(AComponent.DesignInfo);
|
|
// convert to lookuproot coords
|
|
if (AComponent.Owner <> FLookupRoot) then
|
|
begin
|
|
ParentForm:=GetParentFormRelativeClientOrigin(AComponent.Owner);
|
|
inc(Result.X,ParentForm.X);
|
|
inc(Result.Y,ParentForm.Y);
|
|
end;
|
|
end;
|
|
|
|
procedure TDesigner.SetDefaultFormBounds(const AValue: TRect);
|
|
begin
|
|
FDefaultFormBounds:=AValue;
|
|
end;
|
|
|
|
procedure TDesigner.SetGridColor(const AValue: TColor);
|
|
begin
|
|
if GridColor=AValue then exit;
|
|
EnvironmentGuiOpts.GridColor:=AValue;
|
|
Form.Invalidate;
|
|
end;
|
|
|
|
procedure TDesigner.SetShowBorderSpacing(const AValue: boolean);
|
|
begin
|
|
if ShowBorderSpacing=AValue then exit;
|
|
EnvironmentGuiOpts.ShowBorderSpacing:=AValue;
|
|
Form.Invalidate;
|
|
end;
|
|
|
|
procedure TDesigner.SetShowComponentCaptions(const AValue: boolean);
|
|
begin
|
|
if AValue=ShowComponentCaptions then exit;
|
|
if AValue then
|
|
Include(FFlags, dfShowComponentCaptions)
|
|
else
|
|
Exclude(FFlags, dfShowComponentCaptions);
|
|
Form.Invalidate;
|
|
end;
|
|
|
|
function TDesigner.PaintControl(Sender: TControl; TheMessage: TLMPaint): Boolean;
|
|
var
|
|
OldDuringPaintControl: boolean;
|
|
begin
|
|
Result:=true;
|
|
|
|
{$IFDEF VerboseDsgnPaintMsg}
|
|
writeln('*** TDesigner.PaintControl A ',Sender.Name,':',Sender.ClassName,
|
|
' DC=',DbgS(TheMessage.DC));
|
|
{$ENDIF}
|
|
// Set flag
|
|
OldDuringPaintControl:=dfDuringPaintControl in FFlags;
|
|
Include(FFlags,dfDuringPaintControl);
|
|
|
|
// send the Paint message to the control, so that it paints itself
|
|
//writeln('TDesigner.PaintControl B ',Sender.Name);
|
|
Sender.Dispatch(TheMessage);
|
|
//writeln('TDesigner.PaintControl C ',Sender.Name,' DC=',DbgS(TheMessage.DC));
|
|
|
|
// paint the Designer stuff
|
|
if TheMessage.DC <> 0 then begin
|
|
Include(FFlags,dfNeedPainting);
|
|
|
|
if Sender is TControl then
|
|
DDC.SetDC(Form, TControl(Sender), TheMessage.DC)
|
|
else
|
|
if Sender <> nil then
|
|
DDC.SetDC(Form, Sender.Parent, TheMessage.DC)
|
|
else
|
|
DDC.SetDC(Form, nil, TheMessage.DC);
|
|
{$IFDEF VerboseDesignerDraw}
|
|
writeln('TDesigner.PaintControl D ',dbgsname(Sender),
|
|
' DC=',DbgS(DDC.DC,8),
|
|
{' FormOrigin=',DDC.FormOrigin.X,',',DDC.FormOrigin.Y,}
|
|
' DCOrigin=',DDC.DCOrigin.X,',',DDC.DCOrigin.Y,
|
|
' FormClientOrigin=',DDC.FormClientOrigin.X,',',DDC.FormClientOrigin.Y
|
|
);
|
|
{$ENDIF}
|
|
if LastPaintSender=Sender then begin
|
|
//writeln('NOTE: TDesigner.PaintControl E control painted twice: ',
|
|
// Sender.Name,':',Sender.ClassName,' DC=',DbgS(TheMessage.DC));
|
|
//RaiseGDBException('');
|
|
end;
|
|
LastPaintSender:=Sender;
|
|
|
|
if IsDesignerDC(Form.Handle, TheMessage.DC) then
|
|
DoPaintDesignerItems
|
|
else
|
|
begin
|
|
// client grid
|
|
if (Sender is TWinControl) and (csAcceptsControls in Sender.ControlStyle) then
|
|
PaintClientGrid(TWinControl(Sender),DDC);
|
|
end;
|
|
|
|
// clean up
|
|
DDC.Clear;
|
|
end;
|
|
//writeln('TDesigner.PaintControl END ',Sender.Name);
|
|
|
|
if not OldDuringPaintControl then
|
|
Exclude(FFlags,dfDuringPaintControl);
|
|
end;
|
|
|
|
function TDesigner.HandleSetCursor(var TheMessage: TLMessage): boolean;
|
|
begin
|
|
Result := Lo(DWord(TheMessage.LParam)) = HTCLIENT;
|
|
if Result then
|
|
begin
|
|
SetTempCursor(Form, LastFormCursor);
|
|
TheMessage.Result := 1;
|
|
end;
|
|
end;
|
|
|
|
procedure TDesigner.HandlePopupMenu(Sender: TControl; var Message: TLMContextMenu);
|
|
begin
|
|
//debugln(['TDesigner.HandlePopupMenu ',DbgSName(Sender),' ',Message.XPos,',',Message.YPos]);
|
|
{$IFDEF EnableDesignerPopupRightClick}
|
|
if Message.XPos = -1 then
|
|
{$ENDIF}
|
|
begin
|
|
PopupMenuComponentEditor := GetComponentEditorForSelection;
|
|
BuildPopupMenu;
|
|
if (Message.XPos = -1) and (Message.YPos = -1) then
|
|
// called from keyboard (VK_APPS or Shift+F10)
|
|
with Form.ClientToScreen(Point(Selection.Left, Selection.Top)) do
|
|
FDesignerPopupMenu.Popup(X, Y)
|
|
else
|
|
// coordinates can be negative with multiple monitors
|
|
FDesignerPopupMenu.Popup(Message.XPos, Message.YPos);
|
|
end;
|
|
Message.Result := 1;
|
|
end;
|
|
|
|
procedure TDesigner.GetMouseMsgShift(TheMessage: TLMMouse; out
|
|
Shift: TShiftState; out Button: TMouseButton);
|
|
begin
|
|
Shift := [];
|
|
Button := mbLeft;
|
|
if (TheMessage.Keys and MK_Shift) = MK_Shift then
|
|
Include(Shift, ssShift);
|
|
if (TheMessage.Keys and MK_Control) = MK_Control then
|
|
Include(Shift, ssCtrl);
|
|
|
|
if GetKeyState(VK_MENU) < 0 then Include(Shift, ssAlt);
|
|
if (GetKeyState(VK_LWIN) < 0) or (GetKeyState(VK_RWIN) < 0) then Include(Shift, ssMeta);
|
|
|
|
case TheMessage.Msg of
|
|
LM_LBUTTONUP,LM_LBUTTONDBLCLK,LM_LBUTTONTRIPLECLK,LM_LBUTTONQUADCLK:
|
|
begin
|
|
Include(Shift, ssLeft);
|
|
Button := mbLeft;
|
|
end;
|
|
LM_MBUTTONUP,LM_MBUTTONDBLCLK,LM_MBUTTONTRIPLECLK,LM_MBUTTONQUADCLK:
|
|
begin
|
|
Include(Shift, ssMiddle);
|
|
Button := mbMiddle;
|
|
end;
|
|
LM_RBUTTONUP,LM_RBUTTONDBLCLK,LM_RBUTTONTRIPLECLK,LM_RBUTTONQUADCLK:
|
|
begin
|
|
Include(Shift, ssRight);
|
|
Button := mbRight;
|
|
end;
|
|
else
|
|
if (TheMessage.Keys and MK_MButton) <> 0 then
|
|
begin
|
|
Include(Shift, ssMiddle);
|
|
Button := mbMiddle;
|
|
end;
|
|
if (TheMessage.Keys and MK_RButton) <> 0 then
|
|
begin
|
|
Include(Shift, ssRight);
|
|
Button := mbRight;
|
|
end;
|
|
if (TheMessage.Keys and MK_LButton) <> 0 then
|
|
begin
|
|
Include(Shift, ssLeft);
|
|
Button := mbLeft;
|
|
end;
|
|
if (TheMessage.Keys and MK_XBUTTON1) <> 0 then
|
|
begin
|
|
Include(Shift, ssExtra1);
|
|
Button := mbExtra1;
|
|
end;
|
|
if (TheMessage.Keys and MK_XBUTTON2) <> 0 then
|
|
begin
|
|
Include(Shift, ssExtra2);
|
|
Button := mbExtra2;
|
|
end;
|
|
end;
|
|
|
|
case TheMessage.Msg of
|
|
LM_LBUTTONDBLCLK,LM_MBUTTONDBLCLK,LM_RBUTTONDBLCLK,LM_XBUTTONDBLCLK:
|
|
Include(Shift, ssDouble);
|
|
LM_LBUTTONTRIPLECLK,LM_MBUTTONTRIPLECLK,LM_RBUTTONTRIPLECLK,LM_XBUTTONTRIPLECLK:
|
|
Include(Shift, ssTriple);
|
|
LM_LBUTTONQUADCLK,LM_MBUTTONQUADCLK,LM_RBUTTONQUADCLK,LM_XBUTTONQUADCLK:
|
|
Include(Shift, ssQuad);
|
|
end;
|
|
end;
|
|
|
|
function TDesigner.GetDesignControl(AControl: TControl): TControl;
|
|
// checks if AControl is designable.
|
|
// if not check Owner.
|
|
// AControl can be a TNonControlDesignerForm
|
|
var
|
|
OwnerControl: TControl;
|
|
AComponent: TComponent;
|
|
begin
|
|
Result:=AControl;
|
|
if (Result=nil) or (Result=LookupRoot) or (Result.Owner=LookupRoot) then exit;
|
|
if Result=Form then exit;
|
|
if (Result.Owner is TControl) then begin
|
|
OwnerControl:=TControl(Result.Owner);
|
|
if (not (csOwnedChildrenNotSelectable in OwnerControl.ControlStyle)) then
|
|
exit;
|
|
Result:=GetDesignControl(OwnerControl);
|
|
end else begin
|
|
AComponent:=GetDesignedComponent(AControl);
|
|
if AComponent is TControl then
|
|
Result:=TControl(AComponent)
|
|
else
|
|
Result:=nil;
|
|
end;
|
|
end;
|
|
|
|
function TDesigner.SizeControl(Sender: TControl; TheMessage: TLMSize): Boolean;
|
|
begin
|
|
Result := True;
|
|
Sender.Dispatch(TheMessage);
|
|
if Selection.SelectionForm = Form then
|
|
begin
|
|
Selection.CheckForLCLChanges(True);
|
|
end;
|
|
end;
|
|
|
|
function TDesigner.MoveControl(Sender: TControl; TheMessage: TLMMove): Boolean;
|
|
begin
|
|
Result := True;
|
|
Sender.Dispatch(TheMessage);
|
|
//debugln('*** TDesigner.MoveControl A ',Sender.Name,':',Sender.ClassName,' ',Selection.SelectionForm=Form,' ',not Selection.IsResizing,' ',Selection.IsSelected(Sender));
|
|
if Selection.SelectionForm = Form then
|
|
begin
|
|
if not Selection.CheckForLCLChanges(True) and (Sender = Form) and
|
|
Selection.LookupRootSelected then
|
|
begin
|
|
// the selected form was moved (nothing else has changed)
|
|
// Selection does not need an update, but properties like
|
|
// Form.Left/Top have to be updated in the OI
|
|
OnPropertiesChanged(Self);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TDesigner.MouseDownOnControl(Sender: TControl; var TheMessage: TLMMouse);
|
|
var
|
|
CompIndex:integer;
|
|
SelectedCompClass: TRegisteredComponent;
|
|
ParentForm: TCustomForm;
|
|
Shift: TShiftState;
|
|
DesignSender: TControl;
|
|
Button: TMouseButton;
|
|
Handled: Boolean;
|
|
MouseDownControl: TControl;
|
|
p: types.TPoint;
|
|
begin
|
|
FHintTimer.Enabled := False;
|
|
FHintWindow.Visible := False;
|
|
|
|
Exclude(FFLags, dfHasSized);
|
|
SetCaptureControl(nil);
|
|
DesignSender := GetDesignControl(Sender);
|
|
ParentForm := GetDesignerForm(DesignSender);
|
|
//DebugLn(['TDesigner.MouseDownOnControl DesignSender=',dbgsName(DesignSender),' ParentForm=',dbgsName(ParentForm)]);
|
|
if (ParentForm = nil) then exit;
|
|
|
|
MouseDownPos := GetFormRelativeMousePosition(Form);
|
|
LastMouseMovePos := MouseDownPos;
|
|
MouseDownSender := nil;
|
|
MouseDownComponent := ComponentAtPos(MouseDownPos.X, MouseDownPos.Y, True, True);
|
|
if (MouseDownComponent = nil) then exit;
|
|
|
|
if ComponentIsIcon(MouseDownComponent) then
|
|
begin
|
|
if Assigned(IDEComponentsMaster) then
|
|
if not IDEComponentsMaster.DrawNonVisualComponents(FLookupRoot) then
|
|
begin
|
|
MouseDownComponent := nil;
|
|
Exit;
|
|
end;
|
|
MoveNonVisualComponentIntoForm(MouseDownComponent);
|
|
end;
|
|
|
|
MouseDownSender := DesignSender;
|
|
|
|
GetMouseMsgShift(TheMessage,Shift,Button);
|
|
MouseDownShift:=Shift;
|
|
|
|
{$IFDEF VerboseDesigner}
|
|
DebugLn('************************************************************');
|
|
DbgOut('MouseDownOnControl');
|
|
DbgOut(' Sender=',dbgsName(Sender),' DesignSender=',dbgsName(DesignSender));
|
|
//write(' Msg=',TheMessage.Pos.X,',',TheMessage.Pos.Y);
|
|
//write(' Mouse=',MouseDownPos.X,',',MouseDownPos.Y);
|
|
//writeln('');
|
|
|
|
if (TheMessage.Keys and MK_Shift) = MK_Shift then
|
|
DbgOut(' Shift down')
|
|
else
|
|
DbgOut(' No Shift down');
|
|
|
|
if (TheMessage.Keys and MK_Control) = MK_Control then
|
|
DebugLn(', CTRL down')
|
|
else
|
|
DebugLn(', No CTRL down');
|
|
{$ENDIF}
|
|
|
|
if MouseDownComponent is TControl then
|
|
begin
|
|
MouseDownControl:=TControl(MouseDownComponent);
|
|
p:=MouseDownControl.ScreenToClient(Form.ClientToScreen(MouseDownPos));
|
|
if (csDesignInteractive in MouseDownControl.ControlStyle)
|
|
or (MouseDownControl.Perform(CM_DESIGNHITTEST, TheMessage.Keys, Longint(SmallPoint(p.X, p.Y))) > 0) then
|
|
begin
|
|
TControlAccess(MouseDownComponent).MouseDown(Button, Shift, p.X, p.Y);
|
|
Exit;
|
|
end;
|
|
end
|
|
else
|
|
p:=Point(0,0);
|
|
|
|
if Mediator<>nil then begin
|
|
Handled:=false;
|
|
Mediator.MouseDown(Button,Shift,MouseDownPos,Handled);
|
|
if Handled then exit;
|
|
end;
|
|
|
|
SelectedCompClass := GetSelectedComponentClass;
|
|
|
|
if Button=mbLeft then begin
|
|
// left button
|
|
// -> check if a grabber was activated
|
|
Selection.ActiveGrabber:=Selection.GrabberAtPos(MouseDownPos.X, MouseDownPos.Y);
|
|
SetCaptureControl(ParentForm);
|
|
|
|
if SelectedCompClass = nil then begin
|
|
// selection mode
|
|
if Selection.ActiveGrabber=nil then begin
|
|
// no grabber resizing
|
|
|
|
CompIndex:=Selection.IndexOf(MouseDownComponent);
|
|
if ssCtrl in Shift then begin
|
|
// child selection
|
|
end
|
|
else if (ssShift in Shift) then begin
|
|
// shift key pressed (multiselection)
|
|
|
|
if CompIndex<0 then begin
|
|
// not selected
|
|
// add component to selection
|
|
if (Selection.SelectionForm<>nil)
|
|
and (Selection.SelectionForm<>Form)
|
|
then begin
|
|
IDEMessageDialog(lisInvalidMultiselection,
|
|
fdInvalidMultiselectionText,
|
|
mtInformation,[mbOk]);
|
|
end else begin
|
|
Selection.Add(MouseDownComponent);
|
|
end;
|
|
end else begin
|
|
// remove from multiselection
|
|
Selection.Delete(CompIndex);
|
|
Form.Invalidate; // redraw markers
|
|
end;
|
|
end else begin
|
|
// no shift key (single selection or keeping multiselection)
|
|
|
|
if (CompIndex<0) then begin
|
|
// select only this component
|
|
Selection.AssignPersistent(MouseDownComponent);
|
|
end else
|
|
// sync with the interface
|
|
Selection.UpdateBounds;
|
|
end;
|
|
end else begin
|
|
// mouse down on grabber -> begin sizing
|
|
// grabber is already activated
|
|
// the sizing is handled in mousemove and mouseup
|
|
end;
|
|
end else begin
|
|
// add component mode -> handled in mousemove and mouseup
|
|
// but check if we pressed mouse on the form which is not selected
|
|
if (Selection.SelectionForm <> Form) then
|
|
Selection.AssignPersistent(MouseDownComponent);
|
|
end;
|
|
end else begin
|
|
// not left button
|
|
Selection.ActiveGrabber := nil;
|
|
if (Button = mbRight) and EnvironmentGuiOpts.RightClickSelects and
|
|
(Selection.SelectionForm <> Form) then
|
|
Selection.AssignPersistent(MouseDownComponent);
|
|
end;
|
|
|
|
if PropertyEditorHook<>nil then
|
|
PropertyEditorHook.DesignerMouseDown(Sender, Button, Shift, p.X, p.Y);
|
|
|
|
if not Selection.OnlyVisualComponentsSelected and ShowComponentCaptions then
|
|
Form.Invalidate;
|
|
|
|
{$IFDEF VerboseDesigner}
|
|
DebugLn('[TDesigner.MouseDownOnControl] END');
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure TDesigner.MouseUpOnControl(Sender : TControl; var TheMessage:TLMMouse);
|
|
var
|
|
Button: TMouseButton;
|
|
Shift: TShiftState;
|
|
SelectedCompClass: TRegisteredComponent;
|
|
|
|
procedure DoAddComponent;
|
|
var
|
|
NewParent: TComponent;
|
|
NewComponentClass: TComponentClass;
|
|
NewLeft, NewTop, NewWidth, NewHeight: Integer;
|
|
ParentClientOrigin: TPoint;
|
|
begin
|
|
if MouseDownComponent=nil then exit;
|
|
NewComponentClass := SelectedCompClass.GetCreationClass;
|
|
//debugln(['AddComponent NewComponentClass=',DbgSName(NewComponentClass)]);
|
|
|
|
// find a parent for the new component
|
|
NewParent:=nil;
|
|
if not PropertyEditorHook.AddClicked(Self,MouseDownComponent,Button,Shift,
|
|
MouseUpPos.X,MouseUpPos.Y,NewComponentClass,NewParent) then exit;
|
|
|
|
AddComponentCheckParent(NewParent, MouseDownComponent,
|
|
WinControlAtPos(MouseUpPos.X, MouseUpPos.Y, true, true), NewComponentClass);
|
|
if not Assigned(NewParent) then exit;
|
|
|
|
// calculate initial bounds
|
|
NewLeft:=Min(MouseDownPos.X,MouseUpPos.X);
|
|
NewTop:=Min(MouseDownPos.Y,MouseUpPos.Y);
|
|
if (Mediator<>nil) then begin
|
|
ParentClientOrigin:=Mediator.GetComponentOriginOnForm(NewParent);
|
|
DebugLn(['AddComponent ParentClientOrigin=',dbgs(ParentClientOrigin)]);
|
|
// adjust left,top to parent origin
|
|
dec(NewLeft,ParentClientOrigin.X);
|
|
dec(NewTop,ParentClientOrigin.Y);
|
|
end else if NewComponentClass.InheritsFrom(TControl) then
|
|
begin
|
|
ParentClientOrigin:=GetParentFormRelativeClientOrigin(NewParent);
|
|
// adjust left,top to parent origin
|
|
dec(NewLeft,ParentClientOrigin.X);
|
|
dec(NewTop,ParentClientOrigin.Y);
|
|
end;
|
|
NewWidth:=Abs(MouseUpPos.X-MouseDownPos.X);
|
|
NewHeight:=Abs(MouseUpPos.Y-MouseDownPos.Y);
|
|
if Abs(NewWidth+NewHeight)<7 then begin
|
|
// this very small component is probably only a wag, take default size
|
|
NewWidth:=0;
|
|
NewHeight:=0;
|
|
end;
|
|
//DebugLn(['AddComponent ',dbgsName(NewComponentClass)]);
|
|
if NewComponentClass = nil then exit;
|
|
AddComponent(SelectedCompClass,NewComponentClass,NewParent,NewLeft,NewTop,NewWidth,NewHeight);
|
|
end;
|
|
|
|
procedure RubberbandSelect;
|
|
var
|
|
MaxParentComponent: TComponent;
|
|
NewRubberSelection: boolean;
|
|
begin
|
|
if (ssShift in Shift)
|
|
and (Selection.SelectionForm<>nil)
|
|
and (Selection.SelectionForm<>Form)
|
|
then begin
|
|
IDEMessageDialog(lisInvalidMultiselection,
|
|
fdInvalidMultiselectionText,
|
|
mtInformation,[mbOk]);
|
|
exit;
|
|
end;
|
|
|
|
// check if start new selection or add/remove:
|
|
NewRubberSelection:= (not (ssShift in Shift)) or (Selection.SelectionForm<>Form);
|
|
// update non visual components
|
|
MoveNonVisualComponentsIntoForm;
|
|
// if user press the Control key, then component candidates are only
|
|
// children of the control, where the mouse started
|
|
if (ssCtrl in shift) then begin
|
|
if MouseDownComponent=Form then
|
|
MaxParentComponent:=FLookupRoot
|
|
else
|
|
MaxParentComponent:=MouseDownComponent;
|
|
end else
|
|
MaxParentComponent:=FLookupRoot;
|
|
|
|
Selection.SelectWithRubberBand(FLookupRoot, Mediator, NewRubberSelection,
|
|
ssShift in Shift, MaxParentComponent);
|
|
if Selection.Count=0 then begin
|
|
Selection.Add(FLookupRoot);
|
|
end;
|
|
Selection.RubberbandActive:=false;
|
|
{$IFDEF VerboseDesigner}
|
|
DebugLn('RubberbandSelect ',DbgS(ControlSelection.Grabbers[0]));
|
|
{$ENDIF}
|
|
Form.Invalidate;
|
|
end;
|
|
|
|
var
|
|
SenderParentForm: TCustomForm;
|
|
SelectedPersistent: TSelectedControl;
|
|
DesignSender, MouseDownControl: TControl;
|
|
RubberBandWasActive, Handled: Boolean;
|
|
p: TPoint;
|
|
{$IFDEF EnableDesignerPopupRightClick}
|
|
PopupPos: TPoint;
|
|
{$ENDIF}
|
|
i, j: Integer;
|
|
begin
|
|
FHintTimer.Enabled := False;
|
|
FHintWindow.Visible := False;
|
|
|
|
SetCaptureControl(nil);
|
|
|
|
// check if the message is for the designed form and there was a mouse down before
|
|
DesignSender:=GetDesignControl(Sender);
|
|
SenderParentForm:=GetDesignerForm(DesignSender);
|
|
//DebugLn(['TDesigner.MouseUpOnControl DesignSender=',dbgsName(DesignSender),' SenderParentForm=',dbgsName(SenderParentForm),' ',TheMessage.XPos,',',TheMessage.YPos]);
|
|
if (MouseDownComponent=nil) or (SenderParentForm=nil) or (SenderParentForm<>Form)
|
|
or ( (Selection.SelectionForm<>nil) and (Selection.SelectionForm<>Form) ) then
|
|
begin
|
|
MouseDownComponent:=nil;
|
|
MouseDownSender:=nil;
|
|
exit;
|
|
end;
|
|
|
|
Selection.ActiveGrabber:=nil;
|
|
RubberBandWasActive:=Selection.RubberBandActive;
|
|
SelectedCompClass:=GetSelectedComponentClass;
|
|
|
|
GetMouseMsgShift(TheMessage,Shift,Button);
|
|
MouseUpPos:=GetFormRelativeMousePosition(Form);
|
|
|
|
{$IFDEF VerboseDesigner}
|
|
DebugLn('************************************************************');
|
|
DbgOut('MouseUpOnControl');
|
|
DbgOut(' Sender=',dbgsName(Sender),' DesignSender=',dbgsName(DesignSender));
|
|
//write(' Msg=',TheMessage.Pos.X,',',TheMessage.Pos.Y);
|
|
DebugLn('');
|
|
{$ENDIF}
|
|
|
|
if MouseDownComponent is TControl then
|
|
begin
|
|
MouseDownControl:=TControl(MouseDownComponent);
|
|
p:=MouseDownControl.ScreenToClient(Form.ClientToScreen(MouseUpPos));
|
|
if (csDesignInteractive in MouseDownControl.ControlStyle)
|
|
or (MouseDownControl.Perform(CM_DESIGNHITTEST, TheMessage.Keys, Longint(SmallPoint(p.X, p.Y))) > 0) then
|
|
begin
|
|
TControlAccess(MouseDownComponent).MouseUp(Button, Shift, p.X, p.Y);
|
|
Exit;
|
|
end;
|
|
end
|
|
else
|
|
p:=Point(0,0);
|
|
|
|
if Mediator<>nil then
|
|
begin
|
|
Handled:=false;
|
|
Mediator.MouseUp(Button,Shift,MouseUpPos,Handled);
|
|
if Handled then exit;
|
|
end;
|
|
|
|
Selection.BeginUpdate;
|
|
if Button=mbLeft then
|
|
begin
|
|
if SelectedCompClass = nil then
|
|
begin
|
|
if (FUndoState = ucsSaveChange) then
|
|
begin
|
|
// update undo list stored component bounds (Left, Top, Width, Height)
|
|
// see TControlSelection.EndResizing
|
|
// the list of all TComponent, Left,Top,Width,Height
|
|
// Note: not every component has all four properties.
|
|
j := FUndoCurr - 1;
|
|
i := Selection.Count-1;
|
|
while i>=0 do
|
|
begin
|
|
SelectedPersistent:=Selection.Items[i];
|
|
if SelectedPersistent.IsTComponent then
|
|
begin
|
|
while (j>=0) do
|
|
begin
|
|
if (FUndoList[j].compName <> TComponent(SelectedPersistent.Persistent).Name)
|
|
then begin
|
|
// this is not a list of bounds -> stop
|
|
i:=0;
|
|
break;
|
|
end;
|
|
if (FUndoList[j].fieldName = 'Width') then
|
|
FUndoList[j].newVal := SelectedPersistent.Width
|
|
else if (FUndoList[j].fieldName = 'Height') then
|
|
FUndoList[j].newVal := SelectedPersistent.Height
|
|
else if (FUndoList[j].fieldName = 'Left') then
|
|
FUndoList[j].newVal := SelectedPersistent.Left
|
|
else if (FUndoList[j].fieldName = 'Top') then
|
|
FUndoList[j].newVal := SelectedPersistent.Top
|
|
else begin
|
|
// this is not a list of bounds -> stop
|
|
i:=0;
|
|
break;
|
|
end;
|
|
dec(j);
|
|
end;
|
|
end;
|
|
dec(i);
|
|
end;
|
|
end;
|
|
FUndoState := ucsNone;
|
|
|
|
// layout mode (selection, moving and resizing)
|
|
if not (dfHasSized in FFlags) then
|
|
begin
|
|
// new selection
|
|
if RubberBandWasActive then
|
|
RubberbandSelect // rubberband selection
|
|
else if not (ssShift in Shift) then
|
|
begin // point selection, select only the mouse down component
|
|
Selection.AssignPersistent(MouseDownComponent);
|
|
if (ssDouble in MouseDownShift) and (Selection.SelectionForm = Form) then
|
|
begin // Double Click -> invoke 'Edit' of the component editor
|
|
PopupMenuComponentEditor := GetComponentEditorForSelection;
|
|
Assert(Assigned(PopupMenuComponentEditor),
|
|
'TDesigner.MouseUpOnControl: no component editor found for '
|
|
+MouseDownComponent.Name+':'+MouseDownComponent.ClassName);
|
|
PopupMenuComponentEditor.Edit;
|
|
end;
|
|
end;
|
|
end
|
|
else
|
|
Selection.UpdateBounds;
|
|
end else
|
|
DoAddComponent; // create new a component on the form
|
|
end
|
|
else if Button=mbRight then
|
|
begin
|
|
// right click -> popup menu
|
|
Selection.RubberbandActive := False;
|
|
Selection.EndUpdate;
|
|
if EnvironmentGuiOpts.RightClickSelects
|
|
and (not Selection.IsSelected(MouseDownComponent))
|
|
and (Shift = [ssRight]) then begin
|
|
// select only the mouse down component
|
|
Selection.AssignPersistent(MouseDownComponent);
|
|
end;
|
|
{$IFDEF EnableDesignerPopupRightClick}
|
|
PopupMenuComponentEditor := GetComponentEditorForSelection;
|
|
BuildPopupMenu;
|
|
PopupPos := Form.ClientToScreen(MouseUpPos);
|
|
FDesignerPopupMenu.Popup(PopupPos.X, PopupPos.Y);
|
|
{$ENDIF}
|
|
Selection.BeginUpdate;
|
|
end;
|
|
Selection.RubberbandActive := False;
|
|
LastMouseMovePos.X:=-1;
|
|
if (not Selection.OnlyVisualComponentsSelected and ShowComponentCaptions)
|
|
or (dfHasSized in FFlags) then
|
|
Form.Invalidate;
|
|
Exclude(FFlags,dfHasSized);
|
|
MouseDownComponent:=nil;
|
|
MouseDownSender:=nil;
|
|
if PropertyEditorHook<>nil then
|
|
PropertyEditorHook.DesignerMouseUp(Sender, Button, Shift, p.X, p.Y);
|
|
|
|
Selection.EndUpdate;
|
|
|
|
{$IFDEF VerboseDesigner}
|
|
DebugLn('[TDesigner.MouseUpOnControl] END');
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure TDesigner.MouseMoveOnControl(Sender: TControl;
|
|
var TheMessage: TLMMouse);
|
|
var
|
|
Button: TMouseButton;
|
|
Shift : TShiftState;
|
|
SenderParentForm:TCustomForm;
|
|
OldMouseMovePos: TPoint;
|
|
Grabber: TGrabber;
|
|
ACursor: TCursor;
|
|
SelectedCompClass: TRegisteredComponent;
|
|
CurSnappedMousePos, OldSnappedMousePos: TPoint;
|
|
DesignSender: TControl;
|
|
Handled: Boolean;
|
|
MouseMoveComponent: TComponent;
|
|
MouseMoveControl: TControl;
|
|
p: types.TPoint;
|
|
begin
|
|
GetMouseMsgShift(TheMessage, Shift, Button);
|
|
|
|
if [dfShowEditorHints] * FFlags <> [] then
|
|
begin
|
|
FHintTimer.Enabled := False;
|
|
// hide hint
|
|
FHintTimer.Enabled := Shift * [ssLeft, ssRight, ssMiddle] = [];
|
|
if not (dfHasSized in FFlags) then
|
|
FHintWindow.Visible := False;
|
|
end;
|
|
|
|
DesignSender := GetDesignControl(Sender);
|
|
//DebugLn('TDesigner.MouseMoveOnControl Sender=',dbgsName(Sender),' ',dbgsName(DesignSender));
|
|
SenderParentForm := GetDesignerForm(DesignSender);
|
|
if (SenderParentForm = nil) or (SenderParentForm <> Form) then Exit;
|
|
|
|
OldMouseMovePos := LastMouseMovePos;
|
|
LastMouseMovePos := GetFormRelativeMousePosition(Form);
|
|
|
|
MouseMoveComponent := MouseDownComponent;
|
|
if MouseMoveComponent = nil then
|
|
MouseMoveComponent := ComponentAtPos(LastMouseMovePos.X, LastMouseMovePos.Y, True, True);
|
|
if MouseMoveComponent is TControl then
|
|
begin
|
|
MouseMoveControl:=TControl(MouseMoveComponent);
|
|
p:=MouseMoveControl.ScreenToClient(Form.ClientToScreen(LastMouseMovePos));
|
|
if (csDesignInteractive in MouseMoveControl.ControlStyle)
|
|
or (MouseMoveControl.Perform(CM_DESIGNHITTEST, TheMessage.Keys, Longint(SmallPoint(p.X, p.Y))) > 0) then
|
|
begin
|
|
TControlAccess(MouseMoveComponent).MouseMove(Shift, p.X, p.Y);
|
|
Exit;
|
|
end;
|
|
end;
|
|
|
|
if Mediator <> nil then
|
|
begin
|
|
Handled := False;
|
|
Mediator.MouseMove(Shift, LastMouseMovePos, Handled);
|
|
if Handled then Exit;
|
|
end;
|
|
|
|
if Selection.SelectionForm = Form then
|
|
Grabber := Selection.GrabberAtPos(LastMouseMovePos.X, LastMouseMovePos.Y)
|
|
else
|
|
Grabber := nil;
|
|
|
|
if MouseDownComponent = nil then
|
|
begin
|
|
if Grabber = nil then
|
|
ACursor := crDefault
|
|
else
|
|
ACursor := Grabber.Cursor;
|
|
|
|
LastFormCursor := ACursor;
|
|
SetTempCursor(Form, ACursor);
|
|
Exit;
|
|
end;
|
|
|
|
if (OldMouseMovePos.X = LastMouseMovePos.X) and (OldMouseMovePos.Y = LastMouseMovePos.Y) then
|
|
Exit;
|
|
|
|
if (Selection.SelectionForm = nil) or (Selection.SelectionForm = Form) then
|
|
begin
|
|
if Button = mbLeft then // left button pressed
|
|
begin
|
|
if (Selection.ActiveGrabber <> nil) then // grabber active => resizing
|
|
begin
|
|
// grabber moving -> size selection
|
|
if not Selection.LookupRootSelected then // if not current form is selected then resize selection
|
|
begin
|
|
if not (dfHasSized in FFlags) then
|
|
begin
|
|
Selection.SaveBounds(false);
|
|
Include(FFlags, dfHasSized);
|
|
end;
|
|
// skip snapping when Alt is pressed
|
|
if not (ssAlt in Shift) then
|
|
begin
|
|
OldSnappedMousePos := Selection.SnapGrabberMousePos(OldMouseMovePos);
|
|
CurSnappedMousePos := Selection.SnapGrabberMousePos(LastMouseMovePos);
|
|
end
|
|
else
|
|
begin
|
|
OldSnappedMousePos := OldMouseMovePos;
|
|
CurSnappedMousePos := LastMouseMovePos;
|
|
end;
|
|
Selection.SizeSelection(
|
|
CurSnappedMousePos.X - OldSnappedMousePos.X,
|
|
CurSnappedMousePos.Y - OldSnappedMousePos.Y);
|
|
DoModified;
|
|
end;
|
|
end
|
|
else
|
|
begin // no grabber active => moving
|
|
SelectedCompClass := GetSelectedComponentClass;
|
|
if (not Selection.RubberBandActive) and
|
|
(SelectedCompClass=nil) and
|
|
((Shift=[ssLeft]) or (Shift=[ssAlt, ssLeft])) and
|
|
(Selection.Count>=1) and
|
|
(not Selection.LookupRootSelected) then
|
|
begin // move selection
|
|
if not (dfHasSized in FFlags) then
|
|
begin
|
|
Selection.SaveBounds(false);
|
|
Include(FFlags, dfHasSized);
|
|
end;
|
|
//debugln('TDesigner.MouseMoveOnControl Move MouseDownComponent=',dbgsName(MouseDownComponent),' OldMouseMovePos=',dbgs(OldMouseMovePos),' MouseMovePos',dbgs(LastMouseMovePos),' MouseDownPos=',dbgs(MouseDownPos));
|
|
if (ssAlt in Shift) then begin
|
|
if Selection.MoveSelection(LastMouseMovePos.X - MouseDownPos.X, LastMouseMovePos.Y - MouseDownPos.Y, True) then
|
|
DoModified;
|
|
end else begin
|
|
if Selection.MoveSelectionWithSnapping(LastMouseMovePos.X - MouseDownPos.X, LastMouseMovePos.Y - MouseDownPos.Y) then
|
|
DoModified;
|
|
end;
|
|
end
|
|
else
|
|
begin // rubberband sizing (selection or creation)
|
|
Selection.RubberBandBounds := Rect(MouseDownPos.X, MouseDownPos.Y,
|
|
LastMouseMovePos.X, LastMouseMovePos.Y);
|
|
if SelectedCompClass = nil then
|
|
Selection.RubberbandType := rbtSelection
|
|
else
|
|
Selection.RubberbandType := rbtCreating;
|
|
Selection.RubberBandActive := True;
|
|
end;
|
|
end;
|
|
end
|
|
else
|
|
Selection.ActiveGrabber:=nil;
|
|
end;
|
|
if [dfShowEditorHints, dfHasSized] * FFlags = [dfShowEditorHints, dfHasSized] then
|
|
HintTimer(Self);
|
|
end;
|
|
|
|
|
|
{
|
|
-----------------------------K E Y D O W N -------------------------------
|
|
}
|
|
{
|
|
Handles the keydown messages. DEL deletes the selected controls, CTRL-ARROR
|
|
moves the selection up one, SHIFT-ARROW resizes, etc.
|
|
}
|
|
procedure TDesigner.KeyDown(Sender: TControl; var TheMessage: TLMKEY);
|
|
var
|
|
Shift: TShiftState;
|
|
Command: word;
|
|
Handled: boolean;
|
|
Current: TComponent;
|
|
NameRes: TAskCompNameDialogResult;
|
|
UTF8Char: TUTF8Char;
|
|
|
|
procedure Nudge(x, y: integer);
|
|
begin
|
|
if (ssCtrl in Shift) then
|
|
begin
|
|
if ssShift in Shift then
|
|
begin
|
|
x := x * GetGridSizeX;
|
|
y := y * GetGridSizeY;
|
|
end;
|
|
NudgePosition(x, y)
|
|
end
|
|
else
|
|
if (ssShift in Shift) then
|
|
NudgeSize(x, y)
|
|
else
|
|
if (Shift = []) then
|
|
NudgeSelection(x, y);
|
|
end;
|
|
|
|
begin
|
|
{$IFDEF VerboseDesigner}
|
|
DebugLn(['TDesigner.KEYDOWN ',TheMessage.CharCode,' ',TheMessage.KeyData]);
|
|
{$ENDIF}
|
|
Shift := KeyDataToShiftState(TheMessage.KeyData);
|
|
Handled := False;
|
|
if Mediator<>nil then
|
|
Mediator.KeyDown(Sender,TheMessage.CharCode,Shift);
|
|
|
|
Command := FTheFormEditor.TranslateKeyToDesignerCommand(TheMessage.CharCode, Shift);
|
|
//DebugLn(['TDesigner.KEYDOWN Command=',dbgs(Command),' ',TheMessage.CharCode,' ',dbgs(Shift)]);
|
|
DoProcessCommand(Self, Command, Handled);
|
|
//DebugLn(['TDesigner.KeyDown Command=',Command,' Handled=',Handled,' TheMessage.CharCode=',TheMessage.CharCode]);
|
|
|
|
if not Handled and (SourceEditorManager.ActiveSourceWindow<>nil)
|
|
and (GetParentForm(SourceEditorManager.ActiveSourceWindow) = GetParentForm(Sender)) then
|
|
begin
|
|
// send special commands to current editor if they have same parent (designer is docked to the editor)
|
|
case Command of
|
|
ecNextEditor, ecPrevEditor, ecNextEditorInHistory, ecPrevEditorInHistory:
|
|
begin
|
|
FillChar(UTF8Char{%H-}, SizeOf(UTF8Char), 0);
|
|
SourceEditorManager.ActiveSourceWindow.ProcessParentCommand(Self, Command, UTF8Char, nil, Handled);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
if not Handled then
|
|
begin
|
|
Handled := True;
|
|
case TheMessage.CharCode of
|
|
VK_DELETE:
|
|
if not Selection.OnlyInvisiblePersistentsSelected then
|
|
DoDeleteSelectedPersistents;
|
|
|
|
VK_UP:
|
|
Nudge(0,-1);
|
|
|
|
VK_DOWN:
|
|
Nudge(0,1);
|
|
|
|
VK_RIGHT:
|
|
Nudge(1,0);
|
|
|
|
VK_LEFT:
|
|
Nudge(-1,0);
|
|
|
|
VK_TAB:
|
|
if Shift = [ssShift] then
|
|
NudgeSelection(False)
|
|
else
|
|
if Shift = [] then
|
|
NudgeSelection(True)
|
|
else
|
|
Handled := False;
|
|
|
|
VK_RETURN:
|
|
if Shift = [] then
|
|
DoShowObjectInspector
|
|
else if Shift = [ssCtrl] then
|
|
begin
|
|
// ToDo: create an event for each selected control (currently
|
|
// GetComponentEditorForSelection returns nil if more than one is selected)
|
|
PopupMenuComponentEditor := GetComponentEditorForSelection;
|
|
if assigned(PopupMenuComponentEditor) then
|
|
PopupMenuComponentEditor.Edit;
|
|
end else
|
|
Handled := False;
|
|
|
|
VK_A:
|
|
if Shift = [ssCtrl] then
|
|
DoSelectAll
|
|
else
|
|
Handled := False;
|
|
|
|
VK_F2:
|
|
if (Selection.Count=1) and Selection[0].IsTComponent then begin
|
|
Current := TComponent(Selection[0].Persistent);
|
|
NameRes := ShowComponentNameDialog(LookupRoot, Current);
|
|
if NameRes.NameChanged then
|
|
GlobalDesignHook.ComponentRenamed(Current);
|
|
if NameRes.TextChanged then
|
|
GlobalDesignHook.Modified(Current, NameRes.TextPropertyName);
|
|
if NameRes.Changed then
|
|
Modified;
|
|
end; // don't forget the semicolon before else !!!
|
|
|
|
else
|
|
Handled := False;
|
|
end;
|
|
end;
|
|
|
|
if Handled then
|
|
begin
|
|
TheMessage.CharCode := 0;
|
|
TheMessage.Result := 1;
|
|
end;
|
|
end;
|
|
|
|
|
|
{------------------------------------K E Y U P --------------------------------}
|
|
procedure TDesigner.KeyUp(Sender: TControl; var TheMessage: TLMKEY);
|
|
var
|
|
Shift: TShiftState;
|
|
Begin
|
|
{$IFDEF VerboseDesigner}
|
|
//Writeln('TDesigner.KEYUP ',TheMessage.CharCode,' ',TheMessage.KeyData);
|
|
{$ENDIF}
|
|
if Mediator<>nil then begin
|
|
Shift := KeyDataToShiftState(TheMessage.KeyData);
|
|
Mediator.KeyUp(Sender,TheMessage.CharCode,Shift);
|
|
end;
|
|
end;
|
|
|
|
function TDesigner.DoDeleteSelectedPersistents: boolean;
|
|
var
|
|
i: integer;
|
|
APersistent: TPersistent;
|
|
AncestorRoot: TComponent;
|
|
AComponent: TComponent;
|
|
begin
|
|
Result:=true;
|
|
if (Selection.Count=0) or (Selection.SelectionForm<>Form) then
|
|
exit;
|
|
Result:=false;
|
|
// check if a component is the lookup root (can not be deleted)
|
|
if (Selection.LookupRootSelected) then begin
|
|
if Selection.Count>1 then
|
|
IDEMessageDialog(lisInvalidDelete,
|
|
lisTheRootComponentCanNotBeDeleted, mtInformation,
|
|
[mbOk]);
|
|
exit;
|
|
end;
|
|
// check if a selected component is inherited (can not be deleted)
|
|
for i:=0 to Selection.Count-1 do begin
|
|
if not Selection[i].IsTComponent then continue;
|
|
AncestorRoot:=TheFormEditor.GetAncestorLookupRoot(
|
|
TComponent(Selection[i].Persistent));
|
|
if AncestorRoot<>nil then begin
|
|
IDEMessageDialog(lisInvalidDelete,
|
|
Format(lisTheComponentIsInheritedFromToDeleteAnInheritedComp,
|
|
[dbgsName(Selection[i].Persistent), dbgsName(AncestorRoot), LineEnding]),
|
|
mtInformation, [mbOk]);
|
|
exit;
|
|
end;
|
|
end;
|
|
// check if a selected component is not owned by lookuproot (can not be deleted)
|
|
for i:=0 to Selection.Count-1 do begin
|
|
if not Selection[i].IsTComponent then continue;
|
|
AComponent:=TComponent(Selection[i].Persistent);
|
|
if AComponent.Owner<>FLookupRoot then begin
|
|
IDEMessageDialog(lisInvalidDelete,
|
|
Format(lisTheComponentCanNotBeDeletedBecauseItIsNotOwnedBy, [dbgsName(
|
|
Selection[i].Persistent), dbgsName(FLookupRoot)]),
|
|
mtInformation, [mbOk]);
|
|
exit;
|
|
end;
|
|
end;
|
|
|
|
for i := 0 to Selection.Count - 1 do
|
|
begin
|
|
if not Selection[i].IsTComponent then continue;
|
|
AComponent := TComponent(Selection[i].Persistent);
|
|
AddUndoAction(AComponent, uopDelete, i = 0, 'Name', AComponent.Name, '');
|
|
end;
|
|
|
|
// mark selected components for deletion
|
|
for i:=0 to Selection.Count-1 do
|
|
begin
|
|
APersistent := Selection[i].Persistent;
|
|
if DeletingPersistent.IndexOf(APersistent) = -1 then
|
|
DeletingPersistent.Add(APersistent);
|
|
end;
|
|
// clear selection by selecting the LookupRoot
|
|
SelectOnlyThisComponent(FLookupRoot);
|
|
// delete marked components
|
|
try
|
|
if DeletingPersistent.Count=0 then exit;
|
|
while DeletingPersistent.Count>0 do begin
|
|
APersistent:=TPersistent(DeletingPersistent[DeletingPersistent.Count-1]);
|
|
//debugln(['TDesigner.DoDeleteSelectedComponents A ',dbgsName(APersistent),' ',(APersistent is TComponent) and (TheFormEditor.FindComponent(TComponent(APersistent))<>nil)]);
|
|
RemovePersistentAndChildren(APersistent);
|
|
end;
|
|
MouseDownComponent := Nil;
|
|
finally
|
|
Modified;
|
|
end;
|
|
Result:=true;
|
|
end;
|
|
|
|
procedure TDesigner.DoDeleteSelectedPersistentsAsync(Data: PtrInt);
|
|
begin
|
|
DoDeleteSelectedPersistents;
|
|
end;
|
|
|
|
procedure TDesigner.DoSelectAll;
|
|
begin
|
|
Selection.BeginUpdate;
|
|
Selection.Clear;
|
|
Selection.SelectAll(FLookupRoot);
|
|
Selection.EndUpdate;
|
|
Form.Invalidate;
|
|
end;
|
|
|
|
procedure TDesigner.DoDeletePersistent(APersistent: TPersistent; FreeIt: boolean);
|
|
var
|
|
Hook: TPropertyEditorHook;
|
|
Special: Boolean;
|
|
begin
|
|
if APersistent=nil then exit;
|
|
try
|
|
//debugln(['TDesigner.DoDeletePersistent A ',dbgsName(APersistent),' FreeIt=',FreeIt]);
|
|
// unselect component
|
|
Selection.Remove(APersistent);
|
|
if APersistent is TComponent then begin
|
|
PopupMenuComponentEditor:=nil;
|
|
if csDestroying in TComponent(APersistent).ComponentState then
|
|
FreeIt:=false;
|
|
end;
|
|
if GetDesignerForm(APersistent)=nil then begin
|
|
// has no designer
|
|
// -> do not call handlers and simply get rid of the rubbish
|
|
if FreeIt then begin
|
|
//debugln('TDesigner.DoDeletePersistent UNKNOWN in formeditor: ',dbgsName(APersistent));
|
|
APersistent.Free;
|
|
end;
|
|
exit;
|
|
end;
|
|
// call component deleting handlers
|
|
Hook:=GetPropertyEditorHook;
|
|
if Assigned(Hook) then
|
|
Hook.PersistentDeleting(APersistent);
|
|
Special := (Copy(APersistent.ClassName,1,3) = 'TPS') // A hack for PSScript plugins. ToDo...
|
|
or ((APersistent is TWinControl) and TWinControl(APersistent).IsSpecialSubControl);
|
|
// delete component
|
|
if APersistent is TComponent then
|
|
TheFormEditor.DeleteComponent(TComponent(APersistent),FreeIt)
|
|
else if FreeIt then
|
|
APersistent.Free;
|
|
// call ComponentDeleted handler
|
|
if Assigned(FOnPersistentDeleted) then begin
|
|
if Special then // Special treatment is needed for TPairSplitterSide.
|
|
FOnPersistentDeleted(Self,nil) // Will rebuild whole OI Tree.
|
|
else
|
|
FOnPersistentDeleted(Self,APersistent);
|
|
end;
|
|
if Assigned(Hook) then
|
|
Hook.PersistentDeleted(APersistent);
|
|
finally
|
|
// unmark component
|
|
DeletingPersistent.Remove(APersistent);
|
|
end;
|
|
end;
|
|
|
|
function TDesigner.GetSelectedComponentClass: TRegisteredComponent;
|
|
begin
|
|
Result:=nil;
|
|
if Assigned(FOnGetSelectedComponentClass) then
|
|
FOnGetSelectedComponentClass(Self,Result);
|
|
end;
|
|
|
|
function TDesigner.IsDesignMsg(Sender: TControl; var TheMessage: TLMessage): Boolean;
|
|
var
|
|
Act: Word;
|
|
begin
|
|
Result := false;
|
|
if csDesigning in Sender.ComponentState then begin
|
|
Result:=true;
|
|
Inc(FProcessingDesignerEvent);
|
|
try
|
|
case TheMessage.Msg of
|
|
LM_PAINT: Result := PaintControl(Sender, TLMPaint(TheMessage));
|
|
CN_KEYDOWN,CN_SYSKEYDOWN: KeyDown(Sender,TLMKey(TheMessage));
|
|
CN_KEYUP,CN_SYSKEYUP: KeyUP(Sender,TLMKey(TheMessage));
|
|
LM_LBUTTONDOWN,
|
|
LM_RBUTTONDOWN,
|
|
LM_LBUTTONDBLCLK: MouseDownOnControl(Sender,TLMMouse(TheMessage));
|
|
LM_LBUTTONUP,
|
|
LM_RBUTTONUP: MouseUpOnControl(Sender, TLMMouse(TheMessage));
|
|
LM_MOUSEMOVE: MouseMoveOnControl(Sender, TLMMouse(TheMessage));
|
|
LM_SIZE: Result:=SizeControl(Sender, TLMSize(TheMessage));
|
|
LM_MOVE: Result:=MoveControl(Sender, TLMMove(TheMessage));
|
|
LM_ACTIVATE: begin
|
|
{$IFDEF VerboseComponentPalette}
|
|
DebugLn(['TDesigner.IsDesignMsg: Got LM_ACTIVATE message.',
|
|
' Message.Active=',TLMActivate(TheMessage).Active]);
|
|
{$ENDIF}
|
|
Act:=TLMActivate(TheMessage).Active;
|
|
Result:=DoFormActivated(Act in [WA_ACTIVE, WA_CLICKACTIVE]);
|
|
end;
|
|
LM_CLOSEQUERY: Result:=DoFormCloseQuery;
|
|
LM_SETCURSOR: Result:=HandleSetCursor(TheMessage);
|
|
LM_CONTEXTMENU: HandlePopupMenu(Sender, TLMContextMenu(TheMessage));
|
|
else
|
|
Result:=false;
|
|
end;
|
|
finally
|
|
Dec(FProcessingDesignerEvent);
|
|
end;
|
|
end else begin
|
|
if (TheMessage.Msg=LM_PAINT)
|
|
or (TheMessage.Msg=CN_KEYDOWN)
|
|
or (TheMessage.Msg=CN_KEYUP)
|
|
or (TheMessage.Msg=LM_LBUTTONDOWN)
|
|
or (TheMessage.Msg=LM_RBUTTONDOWN)
|
|
or (TheMessage.Msg=LM_LBUTTONDBLCLK)
|
|
or (TheMessage.Msg=LM_LBUTTONUP)
|
|
or (TheMessage.Msg=LM_RBUTTONUP)
|
|
or (TheMessage.Msg=LM_MOUSEMOVE)
|
|
or (TheMessage.Msg=LM_SIZE)
|
|
or (TheMessage.Msg=LM_MOVE)
|
|
or (TheMessage.Msg=LM_ACTIVATE)
|
|
or (TheMessage.Msg=LM_CLOSEQUERY)
|
|
or (TheMessage.Msg=LM_SETCURSOR)
|
|
then
|
|
DebugLn(['TDesigner.IsDesignMsg NOT DESIGNING? ',dbgsName(Sender),' TheMessage.Msg=',GetMessageName(TheMessage.Msg)]);
|
|
end;
|
|
end;
|
|
|
|
function TDesigner.UniqueName(const BaseName: string): string;
|
|
begin
|
|
Result:=TheFormEditor.CreateUniqueComponentName(BaseName,LookupRoot);
|
|
end;
|
|
|
|
procedure TDesigner.UTF8KeyPress(var UTF8Key: TUTF8Char);
|
|
begin
|
|
if ((Length(UTF8Key) = 1) and (Ord(UTF8Key[1]) < 32))
|
|
or (UTF8Key = sLineBreak) then // pass only printable characters
|
|
Exit;
|
|
|
|
if UTF8Key<>'' then
|
|
begin
|
|
DoOnForwardKeyToObjectInspector(Self, UTF8Key);
|
|
UTF8Key := '';
|
|
end;
|
|
end;
|
|
|
|
procedure TDesigner.Modified;
|
|
Begin
|
|
Selection.SaveBounds;
|
|
DoModified;
|
|
inherited Modified;
|
|
end;
|
|
|
|
procedure TDesigner.RemovePersistentAndChildren(APersistent: TPersistent);
|
|
var
|
|
i: integer;
|
|
AWinControl: TWinControl;
|
|
ChildControl: TControl;
|
|
Begin
|
|
if APersistent=nil then exit;
|
|
{$IFDEF VerboseDesigner}
|
|
DebugLn('[TDesigner.RemovePersistentAndChilds] START ',dbgsName(APersistent),' ',DbgS(APersistent));
|
|
{$ENDIF}
|
|
if (APersistent=FLookupRoot) or (APersistent=Form)
|
|
then exit;
|
|
// remove all child controls owned by the LookupRoot
|
|
if (APersistent is TWinControl) then begin
|
|
AWinControl:=TWinControl(APersistent);
|
|
// Component may auto-create new components during deletion unless informed.
|
|
// ComponentState does not have csDestroying yet when removing children.
|
|
AWinControl.DesignerDeleting := True;
|
|
i:=AWinControl.ControlCount-1;
|
|
while (i>=0) do begin
|
|
ChildControl:=AWinControl.Controls[i];
|
|
if ChildControl.Owner=FLookupRoot then begin
|
|
//Debugln(['[TDesigner.RemoveComponentAndChildren] B ',dbgsName(APersistent),' Child=',dbgsName(ChildControl),' i=',i,' ',TheFormEditor.FindComponent(ChildControl)<>nil]);
|
|
RemovePersistentAndChildren(ChildControl);
|
|
// the component list of the form has changed -> restart the search
|
|
i:=AWinControl.ControlCount-1;
|
|
end else
|
|
dec(i);
|
|
end;
|
|
AWinControl.DesignerDeleting := False;
|
|
end;
|
|
// remove component
|
|
{$IFDEF VerboseDesigner}
|
|
DebugLn('[TDesigner.RemovePersistentAndChildren] DoDeletePersistent ',dbgsName(APersistent));
|
|
{$ENDIF}
|
|
DoDeletePersistent(APersistent,true);
|
|
end;
|
|
|
|
procedure TDesigner.Notification(AComponent: TComponent; Operation: TOperation);
|
|
begin
|
|
if Operation = opInsert then begin
|
|
{$IFDEF VerboseDesigner}
|
|
DebugLn('opInsert ',dbgsName(AComponent),' ',DbgS(AComponent));
|
|
{$ENDIF}
|
|
end
|
|
else
|
|
if Operation = opRemove then begin
|
|
{$IFDEF VerboseDesigner}
|
|
DebugLn('[TDesigner.Notification] opRemove ',dbgsName(AComponent));
|
|
{$ENDIF}
|
|
// Notification is usually triggered by TheFormEditor.DeleteComponent in DoDeletePersistent.
|
|
DoDeletePersistent(AComponent,false);
|
|
end;
|
|
end;
|
|
|
|
procedure TDesigner.PaintGrid;
|
|
begin
|
|
// This is normally done in PaintControls
|
|
if FLookupRoot<>FForm then begin
|
|
// this is a special designer form -> lets draw itself
|
|
TCustomFormAccess(FForm).Paint;
|
|
end;
|
|
end;
|
|
|
|
function RoundToMultiple(AValue, ABasis: Integer): Integer; inline;
|
|
begin
|
|
Result := AValue div ABasis * ABasis;
|
|
end;
|
|
|
|
procedure TDesigner.PaintClientGrid(AWinControl: TWinControl;
|
|
aDDC: TDesignerDeviceContext);
|
|
var
|
|
Clip: integer;
|
|
Count: integer;
|
|
i: integer;
|
|
CurControl: TControl;
|
|
R: TRect;
|
|
P: TPoint;
|
|
begin
|
|
if (AWinControl=nil)
|
|
or (not (csAcceptsControls in AWinControl.ControlStyle))
|
|
or ((not ShowGrid) and (not ShowBorderSpacing)) then exit;
|
|
|
|
aDDC.BeginPainting;
|
|
try
|
|
// exclude all child control areas
|
|
Count:=AWinControl.ControlCount;
|
|
for i := 0 to Count - 1 do begin
|
|
with AWinControl.Controls[I] do begin
|
|
if (Visible or ((csDesigning in ComponentState)
|
|
and not (csNoDesignVisible in ControlStyle)))
|
|
then begin
|
|
Clip := ExcludeClipRect(aDDC.DC, Left, Top, Left + Width, Top + Height);
|
|
if Clip = NullRegion then exit;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
// paint points
|
|
if ShowGrid then
|
|
begin
|
|
ADDC.Canvas.Pen.Color := GridColor;
|
|
ADDC.Canvas.Pen.Width := 1;
|
|
ADDC.Canvas.Pen.Style := psSolid;
|
|
P := TWinControlAccess(AWinControl).GetClientScrollOffset;
|
|
R := AWinControl.ClientRect;
|
|
R.BottomRight := R.BottomRight + Point(GridSizeX, GridSizeY);
|
|
Types.OffsetRect(R, RoundToMultiple(P.X, GridSizeX), RoundToMultiple(P.Y, GridSizeY));
|
|
DrawGrid(ADDC.Canvas.Handle, R, GridSizeX, GridSizeY);
|
|
end;
|
|
|
|
if ShowBorderSpacing then
|
|
begin
|
|
aDDC.Canvas.Brush.Color := EnvironmentGuiOpts.BorderSpacingColor;
|
|
for i := 0 to Count - 1 do
|
|
begin
|
|
CurControl := AWinControl.Controls[i];
|
|
if csNoDesignSelectable in CurControl.ControlStyle then
|
|
Continue;
|
|
aDDC.Canvas.FrameRect(
|
|
CurControl.Left-CurControl.BorderSpacing.GetSideSpace(akLeft),
|
|
CurControl.Top-CurControl.BorderSpacing.GetSideSpace(akTop),
|
|
CurControl.Left+CurControl.Width+CurControl.BorderSpacing.GetSideSpace(akRight),
|
|
CurControl.Top+CurControl.Height+CurControl.BorderSpacing.GetSideSpace(akBottom)
|
|
);
|
|
end;
|
|
end;
|
|
finally
|
|
aDDC.EndPainting;
|
|
end;
|
|
end;
|
|
|
|
procedure TDesigner.ValidateRename(AComponent: TComponent;
|
|
const CurName, NewName: string);
|
|
begin
|
|
// check if component is initialized
|
|
if (CurName='') or (NewName='')
|
|
or ((AComponent<>nil) and (csDestroying in AComponent.ComponentState)) then
|
|
exit;
|
|
|
|
// check if component is the LookupRoot
|
|
if AComponent=nil then AComponent:=FLookupRoot;
|
|
|
|
// consistency check
|
|
if CurName<>AComponent.Name then
|
|
DebugLn('WARNING: TDesigner.ValidateRename: OldComponentName="',CurName,'" <> AComponent=',dbgsName(AComponent));
|
|
if Assigned(OnRenameComponent) then
|
|
OnRenameComponent(Self,AComponent,NewName);
|
|
end;
|
|
|
|
function TDesigner.GetShiftState: TShiftState;
|
|
begin
|
|
Result:=FShiftState;
|
|
end;
|
|
|
|
function TDesigner.CreateUniqueComponentName(const AClassName: string): string;
|
|
begin
|
|
Result:=TheFormEditor.CreateUniqueComponentName(AClassName,FLookupRoot);
|
|
end;
|
|
|
|
procedure TDesigner.ComponentEditorVerbMenuItemClick(Sender: TObject);
|
|
var
|
|
Verb: integer;
|
|
VerbCaption: string;
|
|
AMenuItem: TMenuItem;
|
|
begin
|
|
if (PopupMenuComponentEditor=nil) or (Sender=nil) then exit;
|
|
//DebugLn(['TDesigner.OnComponentEditorVerbMenuItemClick Sender=',dbgsName(Sender)]);
|
|
if Sender is TMenuItem then
|
|
AMenuItem:=TMenuItem(Sender)
|
|
else if Sender is TIDEMenuCommand then
|
|
AMenuItem:=TIDEMenuCommand(Sender).MenuItem
|
|
else
|
|
exit;
|
|
Verb:=PopupMenuComponentEditor.GetVerbCount-1;
|
|
VerbCaption:=AMenuItem.Caption;
|
|
while (Verb>=0) and (VerbCaption<>PopupMenuComponentEditor.GetVerb(Verb)) do
|
|
dec(Verb);
|
|
if Verb<0 then exit;
|
|
try
|
|
PopupMenuComponentEditor.ExecuteVerb(Verb);
|
|
except
|
|
on E: Exception do begin
|
|
DebugLn('TDesigner.OnComponentEditorVerbMenuItemClick ERROR: ',E.Message);
|
|
IDEMessageDialog(Format(lisErrorIn, [PopupMenuComponentEditor.ClassName]),
|
|
Format(lisTheComponentEditorOfClassInvokedWithVerbHasCreated,
|
|
[PopupMenuComponentEditor.ClassName, LineEnding, IntToStr(Verb),
|
|
VerbCaption, LineEnding, LineEnding, E.Message]),
|
|
mtError,[mbOk]);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TDesigner.DeleteSelectionMenuClick(Sender: TObject);
|
|
begin
|
|
Application.QueueAsyncCall(@DoDeleteSelectedPersistentsAsync, 0);
|
|
end;
|
|
|
|
procedure TDesigner.SelectAllMenuClick(Sender: TObject);
|
|
begin
|
|
DoSelectAll;
|
|
end;
|
|
|
|
procedure TDesigner.ChangeClassMenuClick(Sender: TObject);
|
|
begin
|
|
ChangeClass;
|
|
end;
|
|
|
|
procedure TDesigner.ChangeParentMenuClick(Sender: TObject);
|
|
begin
|
|
if Assigned(OnChangeParent) then
|
|
OnChangeParent(Self);
|
|
end;
|
|
|
|
procedure TDesigner.ShowNonVisualComponentsMenuClick(Sender: TObject);
|
|
begin
|
|
ShowNonVisualComponents:=not ShowNonVisualComponents;
|
|
end;
|
|
|
|
procedure TDesigner.SnapToGridOptionMenuClick(Sender: TObject);
|
|
begin
|
|
EnvironmentGuiOpts.SnapToGrid := not EnvironmentGuiOpts.SnapToGrid;
|
|
end;
|
|
|
|
procedure TDesigner.ShowOptionsMenuItemClick(Sender: TObject);
|
|
begin
|
|
if Assigned(OnShowOptions) then OnShowOptions(Self);
|
|
end;
|
|
|
|
procedure TDesigner.SnapToGuideLinesOptionMenuClick(Sender: TObject);
|
|
begin
|
|
EnvironmentGuiOpts.SnapToGuideLines := not EnvironmentGuiOpts.SnapToGuideLines;
|
|
end;
|
|
|
|
procedure TDesigner.ViewLFMMenuClick(Sender: TObject);
|
|
begin
|
|
if Assigned(OnViewLFM) then OnViewLFM(Self);
|
|
end;
|
|
|
|
procedure TDesigner.SaveAsXMLMenuClick(Sender: TObject);
|
|
begin
|
|
if Assigned(OnSaveAsXML) then OnSaveAsXML(Self);
|
|
end;
|
|
|
|
procedure TDesigner.CenterFormMenuClick(Sender: TObject);
|
|
var
|
|
NewLeft: Integer;
|
|
NewTop: Integer;
|
|
begin
|
|
if Form=nil then exit;
|
|
NewLeft:=Max(30,(Screen.Width-Form.Width) div 2);
|
|
NewTop:=Max(30,(Screen.Height-Form.Height) div 2);
|
|
Form.SetBounds(NewLeft,NewTop,Form.Width,Form.Height);
|
|
if Assigned(IDETabMaster) then
|
|
IDETabMaster.ShowForm(Form);
|
|
end;
|
|
|
|
procedure TDesigner.CopyMenuClick(Sender: TObject);
|
|
begin
|
|
CopySelection;
|
|
end;
|
|
|
|
procedure TDesigner.CutMenuClick(Sender: TObject);
|
|
begin
|
|
Application.QueueAsyncCall(@CutSelectionAsync, 0);
|
|
end;
|
|
|
|
procedure TDesigner.PasteMenuClick(Sender: TObject);
|
|
begin
|
|
PasteSelection([cpsfFindUniquePositions]);
|
|
end;
|
|
|
|
procedure TDesigner.AnchorEditorMenuClick(Sender: TObject);
|
|
begin
|
|
DoShowAnchorEditor;
|
|
end;
|
|
|
|
procedure TDesigner.TabOrderMenuClick(Sender: TObject);
|
|
begin
|
|
DoShowTabOrderEditor;
|
|
end;
|
|
|
|
function TDesigner.GetGridColor: TColor;
|
|
begin
|
|
Result:=EnvironmentGuiOpts.GridColor;
|
|
end;
|
|
|
|
function TDesigner.GetShowBorderSpacing: boolean;
|
|
begin
|
|
Result:=EnvironmentGuiOpts.ShowBorderSpacing;
|
|
end;
|
|
|
|
function TDesigner.GetShowComponentCaptions: boolean;
|
|
begin
|
|
Result:=dfShowComponentCaptions in FFlags;
|
|
end;
|
|
|
|
function TDesigner.GetShowGrid: boolean;
|
|
begin
|
|
Result:=EnvironmentGuiOpts.ShowGrid;
|
|
end;
|
|
|
|
function TDesigner.GetShowNonVisualComponents: boolean;
|
|
begin
|
|
Result:=dfShowNonVisualComponents in FFlags;
|
|
end;
|
|
|
|
function TDesigner.GetGridSizeX: integer;
|
|
begin
|
|
Result:=EnvironmentGuiOpts.GridSizeX;
|
|
if Result<2 then Result:=2;
|
|
end;
|
|
|
|
function TDesigner.GetGridSizeY: integer;
|
|
begin
|
|
Result:=EnvironmentGuiOpts.GridSizeY;
|
|
if Result<2 then Result:=2;
|
|
end;
|
|
|
|
function TDesigner.GetIsControl: Boolean;
|
|
Begin
|
|
Result := True;
|
|
end;
|
|
|
|
function TDesigner.GetShowEditorHints: boolean;
|
|
begin
|
|
Result:=dfShowEditorHints in FFlags;
|
|
end;
|
|
|
|
function TDesigner.GetSnapToGrid: boolean;
|
|
begin
|
|
Result := EnvironmentGuiOpts.SnapToGrid;
|
|
end;
|
|
|
|
procedure TDesigner.SetShowGrid(const AValue: boolean);
|
|
begin
|
|
if ShowGrid=AValue then exit;
|
|
EnvironmentGuiOpts.ShowGrid:=AValue;
|
|
Form.Invalidate;
|
|
end;
|
|
|
|
procedure TDesigner.SetShowNonVisualComponents(AValue: boolean);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
if ShowNonVisualComponents=AValue then exit;
|
|
|
|
if AValue then begin
|
|
Include(FFlags,dfShowNonVisualComponents);
|
|
Form.Invalidate;
|
|
end else begin
|
|
Exclude(FFlags,dfShowNonVisualComponents);
|
|
Selection.BeginUpdate;
|
|
try
|
|
for i:=Selection.Count-1 downto 0 do
|
|
if Selection[i].IsNonVisualComponent then
|
|
Selection.Delete(i);
|
|
finally
|
|
Selection.EndUpdate;
|
|
Form.Invalidate;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TDesigner.SetGridSizeX(const AValue: integer);
|
|
begin
|
|
if GridSizeX=AValue then exit;
|
|
EnvironmentGuiOpts.GridSizeX:=AValue;
|
|
end;
|
|
|
|
procedure TDesigner.SetGridSizeY(const AValue: integer);
|
|
begin
|
|
if GridSizeY=AValue then exit;
|
|
EnvironmentGuiOpts.GridSizeY:=AValue;
|
|
end;
|
|
|
|
procedure TDesigner.SetMediator(const AValue: TDesignerMediator);
|
|
begin
|
|
if Mediator=AValue then exit;
|
|
if Mediator<>nil then Mediator.Designer:=nil;
|
|
FMediator:=AValue;
|
|
if Mediator<>nil then Mediator.Designer:=Self;
|
|
end;
|
|
|
|
procedure TDesigner.SetPopupMenuComponentEditor(const AValue: TBaseComponentEditor);
|
|
begin
|
|
if FPopupMenuComponentEditor <> AValue then
|
|
begin
|
|
FPopupMenuComponentEditor.Free;
|
|
FPopupMenuComponentEditor := AValue;
|
|
end;
|
|
end;
|
|
|
|
procedure TDesigner.SetShowEditorHints(const AValue: boolean);
|
|
begin
|
|
if AValue = ShowEditorHints then Exit;
|
|
if AValue then
|
|
Include(FFlags, dfShowEditorHints)
|
|
else
|
|
Exclude(FFlags, dfShowEditorHints);
|
|
end;
|
|
|
|
procedure TDesigner.DrawNonVisualComponent(AComponent: TComponent);
|
|
var
|
|
ItemLeft, ItemTop, ItemRight, ItemBottom: integer;
|
|
Diff, ItemLeftTop: TPoint;
|
|
OwnerRect, IconRect, TextRect: TRect;
|
|
TextSize: TSize;
|
|
IsSelected: Boolean;
|
|
RGN: HRGN;
|
|
IL: TCustomImageList;
|
|
II: TImageIndex;
|
|
Res: TScaledImageListResolution;
|
|
Icon: TBitmap;
|
|
ScaleFactor: Double;
|
|
begin
|
|
if (AComponent is TControl)
|
|
and (csNoDesignVisible in TControl(AComponent).ControlStyle) then
|
|
exit;
|
|
if (csDestroying in AComponent.ComponentState) then
|
|
exit;
|
|
|
|
// draw children
|
|
if (AComponent.Owner=nil) then
|
|
begin
|
|
FDDC.BeginPainting;
|
|
TComponentAccess(AComponent).GetChildren(@DrawNonVisualComponent, AComponent);
|
|
FDDC.EndPainting;
|
|
end
|
|
else if (csInline in AComponent.ComponentState) then
|
|
begin
|
|
if AComponent is TControl then
|
|
begin
|
|
// clip to client area
|
|
FDDC.BeginPainting;
|
|
FDDC.Canvas.SaveHandleState;
|
|
OwnerRect := TControl(AComponent).ClientRect;
|
|
Diff := GetParentFormRelativeClientOrigin(AComponent);
|
|
Types.OffsetRect(OwnerRect, Diff.X, Diff.Y);
|
|
with OwnerRect do
|
|
RGN := CreateRectRGN(Left, Top, Right, Bottom);
|
|
SelectClipRGN(FDDC.DC, RGN);
|
|
DeleteObject(RGN);
|
|
end;
|
|
TComponentAccess(AComponent).GetChildren(@DrawNonVisualComponent, AComponent);
|
|
if AComponent is TControl then
|
|
begin
|
|
FDDC.Canvas.RestoreHandleState;
|
|
FDDC.EndPainting;
|
|
end;
|
|
end
|
|
else
|
|
TComponentAccess(AComponent).GetChildren(@DrawNonVisualComponent, AComponent.Owner);
|
|
|
|
if not ComponentIsIcon(AComponent) or (AComponent.Owner = nil) then
|
|
Exit;
|
|
// actual draw
|
|
Diff := FDDC.FormOrigin;
|
|
//DebugLn(['FDDC.FormOrigin - ', Diff.X, ' : ' ,Diff.Y]);
|
|
// non-visual component
|
|
if FDDC.Form<>nil then
|
|
ScaleFactor := FDDC.Form.GetCanvasScaleFactor
|
|
else
|
|
ScaleFactor := 1;
|
|
ItemLeftTop := NonVisualComponentLeftTop(AComponent);
|
|
ItemLeft := ItemLeftTop.X - Diff.X;
|
|
ItemTop := ItemLeftTop.Y - Diff.Y;
|
|
ItemRight := ItemLeft + NonVisualCompWidth;
|
|
ItemBottom := ItemTop + NonVisualCompWidth;
|
|
if not FDDC.RectVisible(ItemLeft, ItemTop, ItemRight, ItemBottom) then
|
|
Exit;
|
|
|
|
IsSelected := Selection.IsSelected(AComponent);
|
|
|
|
if FSurface = nil then
|
|
begin
|
|
FSurface := TBitmap.Create;
|
|
FSurface.SetSize(Round(NonVisualCompWidth*ScaleFactor),
|
|
Round(NonVisualCompWidth*ScaleFactor));
|
|
FSurface.Canvas.Brush.Color := clBtnFace;
|
|
FSurface.Canvas.Pen.Width := 1;
|
|
end;
|
|
|
|
IconRect := Rect(0, 0, Round(NonVisualCompWidth*ScaleFactor),
|
|
Round(NonVisualCompWidth*ScaleFactor));
|
|
FSurface.Canvas.Frame3D(IconRect, 1, bvRaised);
|
|
FSurface.Canvas.FillRect(IconRect);
|
|
|
|
// draw component Name
|
|
if ShowComponentCaptions
|
|
and (((GetKeyState(VK_LBUTTON) and $80) = 0) or not IsSelected) then
|
|
begin
|
|
// workarounds gtk2 problem with DrawText on gc with GDK_INCLUDE_INFERIORS
|
|
// it uses pango drawing and this for some reason does not take subwindow_mode
|
|
// into account
|
|
Icon := TBitmap.Create;
|
|
try
|
|
TextSize := Icon.Canvas.TextExtent(AComponent.Name);
|
|
Icon.SetSize(Round(TextSize.cx * ScaleFactor), Round(TextSize.cy * ScaleFactor));
|
|
LCLIntf.SetCanvasScaleFactor(Icon.Canvas.Handle, ScaleFactor);
|
|
Icon.Canvas.Font.Assign(FDDC.Canvas.Font);
|
|
Icon.Canvas.Font.PixelsPerInch := FDDC.Canvas.Font.PixelsPerInch;
|
|
TextRect := Rect(0, 0, TextSize.cx, TextSize.cy);
|
|
if FDDC.Form <> nil then
|
|
Icon.Canvas.Brush.Color := FDDC.Form.Brush.Color
|
|
else
|
|
Icon.Canvas.Brush.Color := clBtnFace;
|
|
Icon.Canvas.FillRect(TextRect);
|
|
Icon.Canvas.Font.Color := clWindowText;
|
|
DrawText(Icon.Canvas.Handle, PChar(AComponent.Name), -1, TextRect,
|
|
DT_CENTER or DT_VCENTER or DT_SINGLELINE or DT_NOCLIP);
|
|
TextRect.Left := (ItemLeft + ItemRight - TextSize.cx) div 2;
|
|
TextRect.Top := (ItemBottom + NonVisualCompBorder + 2);
|
|
TextRect.Right := TextRect.Left + Icon.Width;
|
|
TextRect.Bottom := TextRect.Top + Icon.Height;
|
|
FDDC.Canvas.StretchDraw(TextRect, Icon);
|
|
finally
|
|
Icon.Free;
|
|
end;
|
|
end;
|
|
// draw component icon
|
|
if Assigned(FOnGetNonVisualCompIcon) then
|
|
begin
|
|
Icon := nil;
|
|
FOnGetNonVisualCompIcon(Self, AComponent, IL{%H-}, II{%H-});
|
|
if (IL<>nil) and (II>=0) then
|
|
begin
|
|
Res := IL.ResolutionForPPI[0, FDDC.Canvas.Font.PixelsPerInch, ScaleFactor];
|
|
InflateRect(IconRect,
|
|
- (IconRect.Right-IconRect.Left-Res.Resolution.Width) div 2,
|
|
- (IconRect.Bottom-IconRect.Top-Res.Resolution.Height) div 2);
|
|
Res.StretchDraw(FSurface.Canvas, II, IconRect);
|
|
end;
|
|
end;
|
|
FDDC.Canvas.StretchDraw(Rect(ItemLeft, ItemTop, ItemRight, ItemBottom), FSurface);
|
|
if (Selection.Count > 1) and IsSelected then
|
|
Selection.DrawMarkerAt(FDDC,
|
|
ItemLeft, ItemTop, NonVisualCompWidth, NonVisualCompWidth);
|
|
end;
|
|
|
|
procedure TDesigner.DrawNonVisualComponents(aDDC: TDesignerDeviceContext);
|
|
begin
|
|
if not ShowNonVisualComponents then exit;
|
|
FSurface := nil;
|
|
FDDC := aDDC;
|
|
DrawNonVisualComponent(FLookupRoot);
|
|
FDDC := nil;
|
|
FreeAndNil(FSurface);
|
|
end;
|
|
|
|
procedure TDesigner.DrawDesignerItems(OnlyIfNeeded: boolean);
|
|
var
|
|
DesignerDC: HDC;
|
|
begin
|
|
if WidgetSet.GetLCLCapability(lcCanDrawOutsideOnPaint) = 0 then Exit;
|
|
if OnlyIfNeeded and (not (dfNeedPainting in FFlags)) then exit;
|
|
Exclude(FFlags,dfNeedPainting);
|
|
|
|
if (Form=nil) or (not Form.HandleAllocated) then exit;
|
|
|
|
//writeln('TDesigner.DrawDesignerItems B painting');
|
|
DesignerDC := GetDesignerDC(Form.Handle);
|
|
DDC.SetDC(Form, Form, DesignerDC);
|
|
DDC.BeginPainting;
|
|
DoPaintDesignerItems;
|
|
DDC.EndPainting;
|
|
DDC.Clear;
|
|
ReleaseDesignerDC(Form.Handle, DesignerDC);
|
|
end;
|
|
|
|
procedure TDesigner.CheckFormBounds;
|
|
// check if the Form was moved or resized
|
|
// Note: During form loading the window manager can resize and position
|
|
// the Form. Such initial changes are ignored, by waiting and comparing
|
|
// not before the IDE becomes idle. When the IDE becomes the first time
|
|
// idle, the form bounds are stored and used as default.
|
|
// After that any change of the Form Bounds is treated as a user move
|
|
// and thus calls Modified.
|
|
var
|
|
NewFormBounds: TRect;
|
|
begin
|
|
NewFormBounds:=Form.BoundsRect;
|
|
if FDefaultFormBoundsValid then begin
|
|
if (not SameRect(@NewFormBounds,@FLastFormBounds))
|
|
and (not SameRect(@NewFormBounds,@FDefaultFormBounds)) then begin
|
|
//debugln('TDesigner.CheckFormBounds');
|
|
Modified;
|
|
if Selection.SelectionForm=Form then begin
|
|
Selection.CheckForLCLChanges(true);
|
|
end;
|
|
end;
|
|
end else begin
|
|
FDefaultFormBoundsValid:=true;
|
|
FDefaultFormBounds:=NewFormBounds;
|
|
end;
|
|
FLastFormBounds:=NewFormBounds;
|
|
end;
|
|
|
|
procedure TDesigner.DoPaintDesignerItems;
|
|
begin
|
|
// marker (multi selection markers)
|
|
if (Selection.SelectionForm = Form) and (Selection.Count > 1) then
|
|
begin
|
|
Selection.DrawMarkers(DDC);
|
|
end;
|
|
// non visual component icons
|
|
if not Assigned(IDEComponentsMaster)
|
|
or IDEComponentsMaster.DrawNonVisualComponents(FLookupRoot) then
|
|
DrawNonVisualComponents(DDC);
|
|
|
|
// guidelines and grabbers
|
|
if (Selection.SelectionForm=Form) then
|
|
begin
|
|
if EnvironmentGuiOpts.ShowGuideLines then
|
|
Selection.DrawGuideLines(DDC);
|
|
Selection.DrawGrabbers(DDC);
|
|
end;
|
|
// rubberband
|
|
if Selection.RubberBandActive and
|
|
((Selection.SelectionForm = Form) or (Selection.SelectionForm = nil)) then
|
|
begin
|
|
Selection.DrawRubberBand(DDC);
|
|
end;
|
|
end;
|
|
|
|
function TDesigner.ComponentIsIcon(AComponent: TComponent): boolean;
|
|
begin
|
|
Result:=ComponentIsNonVisual(AComponent);
|
|
if Result and (Mediator<>nil) then
|
|
Result:=Mediator.ComponentIsIcon(AComponent);
|
|
end;
|
|
|
|
function TDesigner.GetParentFormRelativeClientOrigin(AComponent: TComponent): TPoint;
|
|
begin
|
|
if Mediator<>nil then begin
|
|
Result:=Mediator.GetComponentOriginOnForm(AComponent);
|
|
end else begin
|
|
Result:=DesignerProcs.GetParentFormRelativeClientOrigin(AComponent);
|
|
end;
|
|
end;
|
|
|
|
function TDesigner.GetDesignedComponent(AComponent: TComponent): TComponent;
|
|
begin
|
|
Result:=AComponent;
|
|
if AComponent=Form then begin
|
|
Result:=FLookupRoot;
|
|
end else begin
|
|
while (Result<>nil)
|
|
and (Result<>FLookupRoot)
|
|
and (Result.Owner<>FLookupRoot)
|
|
and (Result is TControl) do
|
|
Result:=TControl(Result).Parent;
|
|
end;
|
|
end;
|
|
|
|
function TDesigner.GetComponentEditorForSelection: TBaseComponentEditor;
|
|
begin
|
|
Result := nil;
|
|
if (Selection.Count <> 1) or
|
|
(Selection.SelectionForm <> Form) or
|
|
(not Selection[0].IsTComponent) then Exit;
|
|
Result := TheFormEditor.GetComponentEditor(TComponent(Selection[0].Persistent));
|
|
end;
|
|
|
|
procedure TDesigner.AddComponentEditorMenuItems(
|
|
AComponentEditor: TBaseComponentEditor; ClearOldOnes: boolean);
|
|
var
|
|
VerbCount, i: integer;
|
|
NewMenuCmd: TIDEMenuCommand;
|
|
begin
|
|
if ClearOldOnes then
|
|
DesignerMenuSectionComponentEditor.Clear;
|
|
|
|
if (AComponentEditor = nil) or (DesignerMenuSectionComponentEditor = nil) then
|
|
Exit;
|
|
|
|
VerbCount := AComponentEditor.GetVerbCount;
|
|
for i := 0 to VerbCount - 1 do
|
|
begin
|
|
NewMenuCmd:=RegisterIDEMenuCommand(DesignerMenuSectionComponentEditor,
|
|
'ComponentEditorVerMenuItem' + IntToStr(i),
|
|
AComponentEditor.GetVerb(i),
|
|
@ComponentEditorVerbMenuItemClick);
|
|
if NewMenuCmd.MenuItem<>nil then
|
|
AComponentEditor.PrepareItem(i, NewMenuCmd.MenuItem);
|
|
end;
|
|
end;
|
|
|
|
function TDesigner.NonVisualComponentAtPos(X, Y: integer): TComponent;
|
|
var
|
|
s: TComponentSearch;
|
|
begin
|
|
// Note: Do not check ShowNonVisualComponents
|
|
s := TComponentSearch.Create(nil);
|
|
try
|
|
s.MinClass := TComponent;
|
|
s.AtPos := Point(X,Y);
|
|
s.IgnoreHidden := true;
|
|
s.OnlyNonVisual := true;
|
|
s.Search(FLookupRoot);
|
|
s.Mediator := Mediator;
|
|
Result := s.Best;
|
|
finally
|
|
s.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TDesigner.MoveNonVisualComponentIntoForm(AComponent: TComponent);
|
|
var
|
|
X, Y: SmallInt;
|
|
begin
|
|
DesignInfoToLeftTop(AComponent.DesignInfo, X, Y);
|
|
AComponent.DesignInfo := LeftTopToDesignInfo(X, Y);
|
|
end;
|
|
|
|
procedure TDesigner.MoveNonVisualComponentsIntoForm;
|
|
var
|
|
i: Integer;
|
|
AComponent: TComponent;
|
|
begin
|
|
for i:=0 to FLookupRoot.ComponentCount-1 do begin
|
|
AComponent:=FLookupRoot.Components[i];
|
|
if ComponentIsIcon(AComponent) then begin
|
|
MoveNonVisualComponentIntoForm(AComponent);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TDesigner.ComponentClassAtPos(const AClass: TComponentClass;
|
|
const APos: TPoint; const UseRootAsDefault, IgnoreHidden: boolean): TComponent;
|
|
var
|
|
s: TComponentSearch;
|
|
MediatorFlags: TDMCompAtPosFlags;
|
|
begin
|
|
if Mediator <> nil then
|
|
begin
|
|
MediatorFlags := [];
|
|
if IgnoreHidden then
|
|
Include(MediatorFlags, dmcapfOnlyVisible);
|
|
Result := Mediator.ComponentAtPos(APos,AClass,MediatorFlags);
|
|
end
|
|
else
|
|
begin
|
|
s := TComponentSearch.Create(nil);
|
|
try
|
|
s.AtPos := APos;
|
|
s.MinClass := AClass;
|
|
s.IgnoreHidden := IgnoreHidden;
|
|
s.IgnoreNonVisual := not ShowNonVisualComponents;
|
|
s.Search(FLookupRoot);
|
|
s.Mediator := Mediator;
|
|
Result := s.Best;
|
|
finally
|
|
s.Free;
|
|
end;
|
|
end;
|
|
if (Result = nil) and UseRootAsDefault and (FLookupRoot.InheritsFrom(AClass)) then
|
|
Result := LookupRoot;
|
|
end;
|
|
|
|
procedure TDesigner.SetTempCursor(ARoot: TWinControl; ACursor: TCursor);
|
|
|
|
procedure Traverse(ARoot: TWinControl);
|
|
var
|
|
i: integer;
|
|
begin
|
|
for i := 0 to ARoot.ControlCount - 1 do
|
|
begin
|
|
ARoot.Controls[i].SetTempCursor(ACursor);
|
|
if ARoot.Controls[i] is TWinControl then
|
|
Traverse(TWinControl(ARoot.Controls[i]));
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
Traverse(ARoot);
|
|
ARoot.SetTempCursor(ACursor);
|
|
end;
|
|
|
|
function TDesigner.WinControlAtPos(x, y: integer; UseRootAsDefault,
|
|
IgnoreHidden: boolean): TWinControl;
|
|
begin
|
|
Result := TWinControl(ComponentClassAtPos(TWinControl, Point(x,y),
|
|
UseRootAsDefault, IgnoreHidden));
|
|
end;
|
|
|
|
function TDesigner.ControlAtPos(x, y: integer; UseRootAsDefault,
|
|
IgnoreHidden: boolean): TControl;
|
|
begin
|
|
Result := TControl(ComponentClassAtPos(TControl, Point(x,y), UseRootAsDefault,
|
|
IgnoreHidden));
|
|
end;
|
|
|
|
function TDesigner.ComponentAtPos(x, y: integer; UseRootAsDefault,
|
|
IgnoreHidden: boolean): TComponent;
|
|
begin
|
|
Result := ComponentClassAtPos(TComponent, Point(x,y), UseRootAsDefault,
|
|
IgnoreHidden);
|
|
end;
|
|
|
|
procedure TDesigner.BuildPopupMenu;
|
|
begin
|
|
if FDesignerPopupMenu = nil then
|
|
begin
|
|
FDesignerPopupMenu:=TPopupMenu.Create(nil);
|
|
with FDesignerPopupMenu do
|
|
begin
|
|
Name := 'DesignerPopupmenu';
|
|
OnPopup := @DesignerPopupMenuPopup;
|
|
Images := IDEImages.Images_16;
|
|
end;
|
|
end;
|
|
// assign the root TMenuItem to the registered menu root.
|
|
// This will automatically create all registered items
|
|
{$IFDEF VerboseMenuIntf}
|
|
FDesignerPopupMenu.Items.WriteDebugReport('TSourceNotebook.BuildPopupMenu ');
|
|
DesignerMenuRoot.ConsistencyCheck;
|
|
{$ENDIF}
|
|
DesignerMenuRoot.MenuItem := FDesignerPopupMenu.Items;
|
|
|
|
DesignerMenuAlign.OnClick := @AlignPopupMenuClick;
|
|
DesignerMenuMirrorHorizontal.OnClick := @MirrorHorizontalPopupMenuClick;
|
|
DesignerMenuMirrorVertical.OnClick := @MirrorVerticalPopupMenuClick;
|
|
DesignerMenuScale.OnClick := @ScalePopupMenuClick;
|
|
DesignerMenuSize.OnClick := @SizePopupMenuClick;
|
|
DesignerMenuReset.OnClick := @ResetPopupMenuClick;
|
|
|
|
DesignerMenuAnchorEditor.OnClick:=@AnchorEditorMenuClick;
|
|
DesignerMenuTabOrder.OnClick:=@TabOrderMenuClick;
|
|
DesignerMenuOrderMoveToFront.OnClick := @OrderMoveToFrontMenuClick;
|
|
DesignerMenuOrderMoveToFront.MenuItem.ShortCut :=
|
|
EditorOpts.KeyMap.CommandToShortCut(ecDesignerMoveToFront);
|
|
DesignerMenuOrderMoveToBack.OnClick := @OrderMoveToBackMenuClick;
|
|
DesignerMenuOrderMoveToBack.MenuItem.ShortCut :=
|
|
EditorOpts.KeyMap.CommandToShortCut(ecDesignerMoveToBack);
|
|
DesignerMenuOrderForwardOne.OnClick := @OrderForwardOneMenuClick;
|
|
DesignerMenuOrderForwardOne.MenuItem.ShortCut :=
|
|
EditorOpts.KeyMap.CommandToShortCut(ecDesignerForwardOne);
|
|
DesignerMenuOrderBackOne.OnClick := @OrderBackOneMenuClick;
|
|
DesignerMenuOrderBackOne.MenuItem.ShortCut :=
|
|
EditorOpts.KeyMap.CommandToShortCut(ecDesignerBackOne);
|
|
|
|
DesignerMenuCut.OnClick:=@CutMenuClick;
|
|
DesignerMenuCopy.OnClick:=@CopyMenuClick;
|
|
DesignerMenuPaste.OnClick:=@PasteMenuClick;
|
|
DesignerMenuDeleteSelection.OnClick:=@DeleteSelectionMenuClick;
|
|
DesignerMenuSelectAll.OnClick:=@SelectAllMenuClick;
|
|
|
|
DesignerMenuChangeClass.OnClick:=@ChangeClassMenuClick;
|
|
DesignerMenuChangeParent.OnClick:=@ChangeParentMenuClick;
|
|
DesignerMenuViewLFM.OnClick:=@ViewLFMMenuClick;
|
|
DesignerMenuSaveAsXML.OnClick:=@SaveAsXMLMenuClick;
|
|
DesignerMenuCenterForm.OnClick:=@CenterFormMenuClick;
|
|
|
|
DesignerMenuShowNonVisualComponents.OnClick:=@ShowNonVisualComponentsMenuClick;
|
|
DesignerMenuShowNonVisualComponents.ShowAlwaysCheckable:=true;
|
|
DesignerMenuSnapToGridOption.OnClick:=@SnapToGridOptionMenuClick;
|
|
DesignerMenuSnapToGridOption.ShowAlwaysCheckable:=true;
|
|
DesignerMenuSnapToGuideLinesOption.OnClick:=@SnapToGuideLinesOptionMenuClick;
|
|
DesignerMenuSnapToGuideLinesOption.ShowAlwaysCheckable:=true;
|
|
DesignerMenuShowOptions.OnClick:=@ShowOptionsMenuItemClick;
|
|
end;
|
|
|
|
procedure TDesigner.DesignerPopupMenuPopup(Sender: TObject);
|
|
var
|
|
ControlSelIsNotEmpty,
|
|
LookupRootIsSelected,
|
|
OnlyNonVisualsAreSelected,
|
|
CompsAreSelected: boolean;
|
|
MultiCompsAreSelected: boolean;
|
|
OneControlSelected: Boolean;
|
|
SelectionVisible: Boolean;
|
|
SrcFile: TLazProjectFile;
|
|
UnitIsVirtual, DesignerCanCopy, HasChangeParentCandidates,
|
|
HasAncestorComponent: Boolean;
|
|
PersistentSelection: TPersistentSelectionList;
|
|
ChangeParentCandidates: TFPList;
|
|
i: Integer;
|
|
Item: TSelectedControl;
|
|
AComponent, AncestorComponent: TComponent;
|
|
begin
|
|
SrcFile:=LazarusIDE.GetProjectFileWithDesigner(Self);
|
|
ControlSelIsNotEmpty:=(Selection.Count>0)
|
|
and (Selection.SelectionForm=Form);
|
|
LookupRootIsSelected:=Selection.LookupRootSelected;
|
|
OnlyNonVisualsAreSelected := Selection.OnlyNonVisualPersistentsSelected;
|
|
SelectionVisible:=not Selection.OnlyInvisiblePersistentsSelected;
|
|
CompsAreSelected:=ControlSelIsNotEmpty and SelectionVisible
|
|
and not LookupRootIsSelected;
|
|
OneControlSelected := ControlSelIsNotEmpty and not Selection[0].IsNonVisualComponent;
|
|
MultiCompsAreSelected := CompsAreSelected and (Selection.Count>1);
|
|
UnitIsVirtual:=(SrcFile=nil) or not FilenameIsAbsolute(SrcFile.Filename);
|
|
PersistentSelection:=TPersistentSelectionList.Create;
|
|
try
|
|
Selection.GetSelection(PersistentSelection);
|
|
|
|
ChangeParentCandidates:=GetChangeParentCandidates(GlobalDesignHook,PersistentSelection);
|
|
HasChangeParentCandidates:=ChangeParentCandidates.Count>0;
|
|
FreeAndNil(ChangeParentCandidates);
|
|
|
|
HasAncestorComponent:=false;
|
|
for i:=0 to Selection.Count-1 do
|
|
begin
|
|
Item:=Selection[i];
|
|
AComponent:=TComponent(Item.Persistent);
|
|
AncestorComponent:=TheFormEditor.GetAncestorInstance(AComponent);
|
|
if AncestorComponent<>nil then
|
|
begin
|
|
HasAncestorComponent:=true;
|
|
break;
|
|
end;
|
|
end;
|
|
finally
|
|
FreeAndNil(PersistentSelection);
|
|
end;
|
|
|
|
AddComponentEditorMenuItems(PopupMenuComponentEditor,true);
|
|
|
|
DesignerMenuAlign.Enabled := CompsAreSelected and not OnlyNonVisualsAreSelected;
|
|
DesignerMenuMirrorHorizontal.Enabled := MultiCompsAreSelected and not OnlyNonVisualsAreSelected;
|
|
DesignerMenuMirrorVertical.Enabled := MultiCompsAreSelected and not OnlyNonVisualsAreSelected;
|
|
DesignerMenuScale.Enabled := CompsAreSelected and not OnlyNonVisualsAreSelected;
|
|
DesignerMenuSize.Enabled := CompsAreSelected and not OnlyNonVisualsAreSelected;
|
|
DesignerMenuReset.Enabled := HasAncestorComponent;
|
|
|
|
DesignerMenuSectionZOrder.Enabled := CompsAreSelected and not OnlyNonVisualsAreSelected;
|
|
DesignerMenuOrderMoveToFront.Enabled := OneControlSelected and not OnlyNonVisualsAreSelected;
|
|
DesignerMenuOrderMoveToBack.Enabled := OneControlSelected and not OnlyNonVisualsAreSelected;
|
|
DesignerMenuOrderForwardOne.Enabled := OneControlSelected and not OnlyNonVisualsAreSelected;
|
|
DesignerMenuOrderBackOne.Enabled := OneControlSelected and not OnlyNonVisualsAreSelected;
|
|
|
|
DesignerCanCopy := CanCopy;
|
|
DesignerMenuCut.Enabled := DesignerCanCopy;
|
|
DesignerMenuCopy.Enabled := DesignerCanCopy;
|
|
DesignerMenuPaste.Enabled := CanPaste;
|
|
DesignerMenuDeleteSelection.Enabled := CompsAreSelected;
|
|
|
|
DesignerMenuChangeClass.Enabled := CompsAreSelected and (Selection.Count = 1);
|
|
// Disable ViewLFM menu item for virtual units. There is no form file yet.
|
|
DesignerMenuViewLFM.Enabled := not UnitIsVirtual;
|
|
DesignerMenuChangeParent.Enabled := HasChangeParentCandidates;
|
|
DesignerMenuSnapToGridOption.Checked := EnvironmentGuiOpts.SnapToGrid;
|
|
DesignerMenuShowNonVisualComponents.Checked := ShowNonVisualComponents;
|
|
DesignerMenuSnapToGuideLinesOption.Checked := EnvironmentGuiOpts.SnapToGuideLines;
|
|
end;
|
|
|
|
procedure TDesigner.AlignPopupMenuClick(Sender: TObject);
|
|
var
|
|
HorizAlignment, VertAlignment: TComponentAlignment;
|
|
HorizAlignID, VertAlignID: integer;
|
|
begin
|
|
if ShowAlignComponentsDialog(HorizAlignID,VertAlignID)=mrOk then
|
|
begin
|
|
case HorizAlignID of
|
|
1: HorizAlignment:=csaSides1;
|
|
2: HorizAlignment:=csaCenters;
|
|
3: HorizAlignment:=csaSides2;
|
|
4: HorizAlignment:=csaCenterInWindow;
|
|
5: HorizAlignment:=csaSpaceEqually;
|
|
6: HorizAlignment:=csaSide1SpaceEqually;
|
|
7: HorizAlignment:=csaSide2SpaceEqually;
|
|
else HorizAlignment:=csaNone; // value=0, this prevents compiler warning.
|
|
end;
|
|
case VertAlignID of
|
|
1: VertAlignment:=csaSides1;
|
|
2: VertAlignment:=csaCenters;
|
|
3: VertAlignment:=csaSides2;
|
|
4: VertAlignment:=csaCenterInWindow;
|
|
5: VertAlignment:=csaSpaceEqually;
|
|
6: VertAlignment:=csaSide1SpaceEqually;
|
|
7: VertAlignment:=csaSide2SpaceEqually;
|
|
else VertAlignment:=csaNone; // value=0, this prevents compiler warning.
|
|
end;
|
|
Selection.AlignComponents(HorizAlignment,VertAlignment);
|
|
Modified;
|
|
end;
|
|
end;
|
|
|
|
procedure TDesigner.MirrorHorizontalPopupMenuClick(Sender: TObject);
|
|
begin
|
|
Selection.MirrorHorizontal;
|
|
Modified;
|
|
end;
|
|
|
|
procedure TDesigner.MirrorVerticalPopupMenuClick(Sender: TObject);
|
|
begin
|
|
Selection.MirrorVertical;
|
|
Modified;
|
|
end;
|
|
|
|
procedure TDesigner.ScalePopupMenuClick(Sender: TObject);
|
|
var
|
|
ScaleInPercent: integer;
|
|
begin
|
|
if ShowScaleComponentsDialog(ScaleInPercent)=mrOk then
|
|
begin
|
|
Selection.ScaleComponents(ScaleInPercent);
|
|
Modified;
|
|
end;
|
|
end;
|
|
|
|
procedure TDesigner.SizePopupMenuClick(Sender: TObject);
|
|
var
|
|
HorizSizing, VertSizing: TComponentSizing;
|
|
HorizSizingID, VertSizingID: integer;
|
|
AWidth, AHeight: integer;
|
|
begin
|
|
if ShowSizeComponentsDialog(HorizSizingID,AWidth,VertSizingID,AHeight) = mrOk then
|
|
begin
|
|
case HorizSizingID of
|
|
1: HorizSizing:=cssShrinkToSmallest;
|
|
2: HorizSizing:=cssGrowToLargest;
|
|
3: HorizSizing:=cssFixed;
|
|
else HorizSizing:=cssNone; // value=0, this prevents compiler warning.
|
|
end;
|
|
case VertSizingID of
|
|
1: VertSizing:=cssShrinkToSmallest;
|
|
2: VertSizing:=cssGrowToLargest;
|
|
3: VertSizing:=cssFixed;
|
|
else VertSizing:=cssNone; // value=0, this prevents compiler warning.
|
|
end;
|
|
Selection.SizeComponents(HorizSizing,AWidth,VertSizing,AHeight);
|
|
Modified;
|
|
end;
|
|
end;
|
|
|
|
procedure TDesigner.ResetPopupMenuClick(Sender: TObject);
|
|
var
|
|
ResetComps: TFPList;
|
|
HasChanged: Boolean;
|
|
|
|
procedure ResetControl(AControl: TControl; Recursive: boolean);
|
|
var
|
|
Ancestor: TControl;
|
|
i: Integer;
|
|
OldBounds: TRect;
|
|
NewBounds: TRect;
|
|
begin
|
|
if ResetComps.IndexOf(AControl)>=0 then exit;
|
|
ResetComps.Add(AControl);
|
|
Ancestor:=TControl(TheFormEditor.GetAncestorInstance(AControl));
|
|
if not (Ancestor is TControl) then exit;
|
|
OldBounds:=AControl.BoundsRect;
|
|
NewBounds:=Ancestor.BoundsRect;
|
|
if not SameRect(@OldBounds,@NewBounds) then begin
|
|
AControl.BoundsRect:=NewBounds;
|
|
HasChanged:=true;
|
|
end;
|
|
if Recursive and (AControl is TWinControl) then begin
|
|
for i:=0 to TWinControl(AControl).ControlCount-1 do
|
|
ResetControl(TWinControl(AControl).Controls[i],true);
|
|
end;
|
|
end;
|
|
|
|
var
|
|
MsgResult: TModalResult;
|
|
i: Integer;
|
|
Item: TSelectedControl;
|
|
AComponent: TComponent;
|
|
AncestorComponent: TComponent;
|
|
begin
|
|
MsgResult:=IDEQuestionDialog(lisReset,
|
|
lisResetLeftTopWidthHeightOfSelectedComponentsToTheir,
|
|
mtConfirmation, [mrYes, lisSelected,
|
|
mrYesToAll, lisSelectedAndChildControls,
|
|
mrCancel]);
|
|
if not (MsgResult in [mrYes,mrYesToAll]) then exit;
|
|
HasChanged:=false;
|
|
Form.DisableAutoSizing{$IFDEF DebugDisableAutoSizing}('TDesigner.OnResetPopupMenuClick'){$ENDIF};
|
|
ResetComps:=TFPList.Create;
|
|
try
|
|
for i:=0 to Selection.Count-1 do begin
|
|
Item:=Selection[i];
|
|
if Item.IsTControl then begin
|
|
ResetControl(TControl(Item.Persistent),MsgResult=mrYesToAll);
|
|
end else if Item.IsTComponent then begin
|
|
AComponent:=TComponent(Item.Persistent);
|
|
if ResetComps.IndexOf(AComponent)>=0 then continue;
|
|
ResetComps.Add(AComponent);
|
|
if Item.IsNonVisualComponent then begin
|
|
AncestorComponent:=TheFormEditor.GetAncestorInstance(AComponent);
|
|
if AncestorComponent=nil then continue;
|
|
if AComponent.DesignInfo=AncestorComponent.DesignInfo then continue;
|
|
AComponent.DesignInfo:=AncestorComponent.DesignInfo;
|
|
HasChanged:=true;
|
|
end;
|
|
end;
|
|
end;
|
|
finally
|
|
ResetComps.Free;
|
|
Form.EnableAutoSizing{$IFDEF DebugDisableAutoSizing}('TDesigner.OnResetPopupMenuClick'){$ENDIF};
|
|
if HasChanged then
|
|
Modified;
|
|
end;
|
|
end;
|
|
|
|
procedure TDesigner.OrderMoveToFrontMenuClick(Sender: TObject);
|
|
begin
|
|
DoChangeZOrder(coaMoveToFront);
|
|
end;
|
|
|
|
procedure TDesigner.OrderMoveToBackMenuClick(Sender: TObject);
|
|
begin
|
|
DoChangeZOrder(coaMoveToBack);
|
|
end;
|
|
|
|
procedure TDesigner.OrderForwardOneMenuClick(Sender: TObject);
|
|
begin
|
|
DoChangeZOrder(coaForwardOne);
|
|
end;
|
|
|
|
procedure TDesigner.OrderBackOneMenuClick(Sender: TObject);
|
|
begin
|
|
DoChangeZOrder(coaBackOne);
|
|
end;
|
|
|
|
procedure TDesigner.HintTimer(Sender: TObject);
|
|
|
|
function GetComponentHintText(AComponent: TComponent): String;
|
|
const
|
|
HintNameStr = '%s: %s';
|
|
HintPositionStr = 'Position: %d, %d';
|
|
HintSizeStr = 'Size: %d x %d';
|
|
HintTabStr = 'TabStop: %s; TabOrder: %d';
|
|
var
|
|
AControl: TControl absolute AComponent;
|
|
AWinControl: TWinControl absolute AComponent;
|
|
AComponentEditor: TBaseComponentEditor;
|
|
S: String;
|
|
begin
|
|
// component name and classname
|
|
Result := Format(HintNameStr, [AComponent.Name, AComponent.ClassName]);
|
|
// component position
|
|
Result := Result + LineEnding + Format(HintPositionStr, [GetComponentLeft(AComponent), GetComponentTop(AComponent)]);
|
|
if AComponent is TControl then // more info for controls
|
|
begin
|
|
// size
|
|
Result := Result + '; ' + Format(HintSizeStr, [AControl.Width, AControl.Height]);
|
|
// and TabStop, TabOrder for TWinControl
|
|
if (AComponent is TWinControl) and not (AComponent = Form) then
|
|
Result := Result + LineEnding + Format(HintTabStr, [BoolToStr(AWinControl.TabStop, True), AWinControl.TabOrder]);
|
|
end;
|
|
AComponentEditor := TheFormEditor.GetComponentEditor(AComponent);
|
|
if Assigned(AComponentEditor) then
|
|
begin
|
|
S := AComponentEditor.GetCustomHint;
|
|
if S <> '' then
|
|
Result := Result + LineEnding + S;
|
|
AComponentEditor.Free;
|
|
end;
|
|
end;
|
|
|
|
function ParentComponent(AComponent: TComponent): TComponent;
|
|
begin
|
|
Result := AComponent.GetParentComponent;
|
|
if (Result = nil) and ComponentIsIcon(AComponent) then
|
|
Result := AComponent.Owner;
|
|
end;
|
|
|
|
function GetSelectionSizeHintText: String;
|
|
begin
|
|
Result := Format('%d x %d', [Selection.Width, Selection.Height]);
|
|
end;
|
|
|
|
function GetSelectionPosHintText: String;
|
|
var
|
|
BaseParent, TestParent: TComponent;
|
|
BaseFound: Boolean;
|
|
i: integer;
|
|
P: TPoint;
|
|
begin
|
|
BaseFound := Selection[0].IsTComponent;
|
|
// search for one parent of our selection
|
|
if BaseFound then
|
|
begin
|
|
BaseParent := ParentComponent(TComponent(Selection[0].Persistent));
|
|
BaseFound := BaseParent is TWinControl;
|
|
if BaseFound then
|
|
begin
|
|
for i := 1 to Selection.Count - 1 do
|
|
begin
|
|
if Selection[0].IsTComponent then
|
|
TestParent := ParentComponent(TComponent(Selection[0].Persistent))
|
|
else
|
|
TestParent := nil;
|
|
if TestParent <> BaseParent then
|
|
begin
|
|
BaseFound := False;
|
|
Break;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
P := Point(Selection.Left, Selection.Top);
|
|
if BaseFound then
|
|
P := TWinControl(BaseParent).ScreenToClient(Form.ClientToScreen(P));
|
|
Result := Format('%d, %d', [P.X, P.Y]);
|
|
end;
|
|
|
|
var
|
|
Rect: TRect;
|
|
AHint: String;
|
|
Position, ClientPos: TPoint;
|
|
AWinControl: TWinControl;
|
|
AComponent: TComponent;
|
|
begin
|
|
FHintTimer.Enabled := False;
|
|
if ([dfShowEditorHints]*FFlags=[]) or (Form=nil) then exit;
|
|
|
|
Position := Mouse.CursorPos;
|
|
if not (dfHasSized in FFlags) then
|
|
begin
|
|
AWinControl := FindLCLWindow(Position);
|
|
if not (Assigned(AWinControl)) then Exit;
|
|
if GetDesignerForm(AWinControl) <> Form then exit;
|
|
|
|
// search a component at the position
|
|
ClientPos := Form.ScreenToClient(Position);
|
|
AComponent := ComponentAtPos(ClientPos.X,ClientPos.Y,true,true);
|
|
if not Assigned(AComponent) then
|
|
AComponent := AWinControl;
|
|
AComponent := GetDesignedComponent(AComponent);
|
|
if AComponent = nil then exit;
|
|
AHint := GetComponentHintText(AComponent);
|
|
end
|
|
else
|
|
begin
|
|
// components are either resize or move
|
|
if (Selection.LookupRoot <> Form) or (Selection.Count = 0) then
|
|
Exit;
|
|
if Selection.ActiveGrabber <> nil then
|
|
AHint := GetSelectionSizeHintText
|
|
else
|
|
AHint := GetSelectionPosHintText;
|
|
end;
|
|
|
|
Rect := FHintWindow.CalcHintRect(0, AHint, Nil); //no maxwidth
|
|
Rect.Left := Position.X + 15;
|
|
Rect.Top := Position.Y + 15;
|
|
Rect.Right := Rect.Left + Rect.Right;
|
|
Rect.Bottom := Rect.Top + Rect.Bottom;
|
|
FHintWindow.ActivateHint(Rect, AHint);
|
|
end;
|
|
|
|
procedure TDesigner.SetSnapToGrid(const AValue: boolean);
|
|
begin
|
|
if SnapToGrid=AValue then exit;
|
|
EnvironmentGuiOpts.SnapToGrid:=AValue;
|
|
end;
|
|
|
|
procedure TDesigner.DoOnForwardKeyToObjectInspector(Sender: TObject;
|
|
Key: TUTF8Char);
|
|
begin
|
|
if Assigned(FOnForwardKeyToOI) then
|
|
FOnForwardKeyToOI(Self, Key);
|
|
end;
|
|
|
|
function TDesigner.DoFormActivated(Active: boolean): boolean;
|
|
begin
|
|
if Active then begin
|
|
// designer form was activated.
|
|
if Assigned(FOnActivated) then FOnActivated(Self);
|
|
end else begin
|
|
// designer form deactivated
|
|
end;
|
|
Result:=false; // pass message to form, needed for focussing
|
|
end;
|
|
|
|
function TDesigner.DoFormCloseQuery: boolean;
|
|
begin
|
|
if Assigned(FOnCloseQuery) then FOnCloseQuery(Self);
|
|
Result:=true; // do not pass to form
|
|
end;
|
|
|
|
function TDesigner.GetPropertyEditorHook: TPropertyEditorHook;
|
|
begin
|
|
Result:=TheFormEditor.PropertyEditorHook;
|
|
end;
|
|
|
|
end.
|
|
|