{ /*************************************************************************** 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 . You can also * * obtain it by writing to the Free Software Foundation, * * Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. * * * *************************************************************************** } unit Designer; {$mode objfpc}{$H+} interface {off $DEFINE VerboseDesigner} {off $DEFINE VerboseDesignerDraw} uses // FCL + LCL Types, Classes, SysUtils, Math, LCLProc, LCLType, LResources, LCLIntf, LMessages, InterfaceBase, Forms, Controls, GraphType, Graphics, Dialogs, ExtCtrls, Menus, ClipBrd, // IDEIntf IDEDialogs, PropEdits, ComponentEditors, MenuIntf, IDEImagesIntf, // IDE LazarusIDEStrConsts, EnvironmentOpts, IDECommands, ComponentReg, NonControlDesigner, FrameDesigner, AlignCompsDlg, SizeCompsDlg, ScaleCompsDlg, TabOrderDlg, DesignerProcs, CustomFormEditor, ControlSelection, ChangeClassDialog, EditorOptions; type TDesigner = class; TOnGetSelectedComponentClass = procedure(Sender: TObject; var RegisteredComponent: TRegisteredComponent) of object; TOnSetDesigning = procedure(Sender: TObject; Component: TComponent; Value: boolean) of object; TOnPasteComponent = procedure(Sender: TObject; LookupRoot: TComponent; TxtCompStream: TStream; Parent: TWinControl; var NewComponent: TComponent) of object; TOnPersistentDeleted = procedure(Sender: TObject; APersistent: TPersistent) of object; TOnGetNonVisualCompIcon = procedure(Sender: TObject; AComponent: TComponent; var Icon: TCustomBitmap) of object; TOnRenameComponent = procedure(Designer: TDesigner; AComponent: TComponent; const NewName: string) of object; TOnProcessCommand = procedure(Sender: TObject; Command: word; var Handled: boolean) of object; TDesignerFlag = ( dfHasSized, dfDuringPaintControl, dfShowEditorHints, dfShowComponentCaptions, dfDestroyingForm, dfDeleting, dfNeedPainting ); TDesignerFlags = set of TDesignerFlag; { TDesigner } TDesigner = class(TComponentEditorDesigner) private DesignerPopupMenu: TPopupMenu; FDefaultFormBounds: TRect; FLastFormBounds: TRect; FDefaultFormBoundsValid: boolean; FFlags: TDesignerFlags; FGridColor: TColor; FLookupRoot: TComponent; FOnActivated: TNotifyEvent; FOnCloseQuery: TNotifyEvent; FOnPersistentDeleted: TOnPersistentDeleted; FOnGetNonVisualCompIcon: TOnGetNonVisualCompIcon; FOnGetSelectedComponentClass: TOnGetSelectedComponentClass; FOnModified: TNotifyEvent; FOnPasteComponent: TOnPasteComponent; FOnProcessCommand: TOnProcessCommand; FOnPropertiesChanged: TNotifyEvent; FOnRenameComponent: TOnRenameComponent; FOnSaveAsXML: TNotifyEvent; FOnSetDesigning: TOnSetDesigning; FOnShowOptions: TNotifyEvent; FOnComponentAdded: TNotifyEvent; FOnViewLFM: TNotifyEvent; FShiftState: TShiftState; FTheFormEditor: TCustomFormEditor; //hint stuff FHintTimer: TTimer; FHintWIndow: THintWindow; 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 SetIsControl(Value: Boolean); 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); protected MouseDownComponent: TComponent; MouseDownSender: TComponent; MouseDownPos: TPoint; MouseDownClickCount: integer; MouseUpPos: TPoint; LastMouseMovePos: TPoint; PopupMenuComponentEditor: TBaseComponentEditor; LastFormCursor: TCursor; DeletingPersistent: TList; IgnoreDeletingPersistent: 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; // procedures for working with components and persistents function GetDesignControl(AControl: TControl): TControl; function DoDeleteSelectedPersistents: boolean; procedure DoSelectAll; procedure DoDeletePersistent(APersistent: TPersistent; FreeIt: boolean); procedure MarkPersistentForDeletion(APersistent: TPersistent); function PersistentIsMarkedForDeletion(APersistent: TPersistent): boolean; function GetSelectedComponentClass: TRegisteredComponent; procedure NudgePosition(DiffX, DiffY: Integer); procedure NudgeSize(DiffX, DiffY: Integer); procedure SelectParentOfSelection; function DoCopySelectionToClipboard: boolean; function GetPasteParent: TWinControl; function DoPasteSelectionFromClipboard(PasteFlags: TComponentPasteSelectionFlags ): boolean; function DoInsertFromStream(s: TStream; PasteParent: TWinControl; PasteFlags: TComponentPasteSelectionFlags): Boolean; procedure DoShowTabOrderEditor; procedure DoShowChangeClassDialog; procedure DoOrderMoveSelectionToFront; procedure DoOrderMoveSelectionToBack; procedure DoOrderForwardSelectionOne; procedure DoOrderBackSelectionOne; procedure GiveComponentsNames; procedure NotifyPersistentAdded(APersistent: TPersistent); function ComponentClassAtPos(const AClass: TComponentClass; const APos: TPoint; const UseRootAsDefault, IgnoreHidden: boolean): TComponent; // popup menu procedure BuildPopupMenu; procedure DesignerPopupMenuPopup(Sender: TObject); procedure OnComponentEditorVerbMenuItemClick(Sender: TObject); procedure OnAlignPopupMenuClick(Sender: TObject); procedure OnMirrorHorizontalPopupMenuClick(Sender: TObject); procedure OnMirrorVerticalPopupMenuClick(Sender: TObject); procedure OnScalePopupMenuClick(Sender: TObject); procedure OnSizePopupMenuClick(Sender: TObject); procedure OnTabOrderMenuClick(Sender: TObject); procedure OnOrderMoveToFrontMenuClick(Sender: TObject); procedure OnOrderMoveToBackMenuClick(Sender: TObject); procedure OnOrderForwardOneMenuClick(Sender: TObject); procedure OnOrderBackOneMenuClick(Sender: TObject); procedure OnCopyMenuClick(Sender: TObject); procedure OnCutMenuClick(Sender: TObject); procedure OnPasteMenuClick(Sender: TObject); procedure OnDeleteSelectionMenuClick(Sender: TObject); procedure OnSelectAllMenuClick(Sender: TObject); procedure OnChangeClassMenuClick(Sender: TObject); procedure OnChangeParentMenuClick(Sender: TObject); procedure OnSnapToGridOptionMenuClick(Sender: TObject); procedure OnShowOptionsMenuItemClick(Sender: TObject); procedure OnSnapToGuideLinesOptionMenuClick(Sender: TObject); procedure OnViewLFMMenuClick(Sender: TObject); procedure OnSaveAsXMLMenuClick(Sender: TObject); // hook function GetPropertyEditorHook: TPropertyEditorHook; override; function OnFormActivated: boolean; function OnFormCloseQuery: boolean; public ControlSelection : TControlSelection; DDC: TDesignerDeviceContext; constructor Create(TheDesignerForm: TCustomForm; AControlSelection: TControlSelection); procedure FreeDesigner(FreeComponent: boolean); destructor Destroy; override; procedure Modified; override; procedure SelectOnlyThisComponent(AComponent:TComponent); override; function CopySelection: boolean; override; function CutSelection: boolean; override; function CanPaste: Boolean; override; function PasteSelection(PasteFlags: TComponentPasteSelectionFlags): 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; MenuIndex: integer): boolean; override; procedure DoProcessCommand(Sender: TObject; var Command: word; var Handled: boolean); 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; function UniqueName(const BaseName: string): string; override; Procedure RemovePersistentAndChilds(APersistent: TPersistent); procedure Notification(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; 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 write SetIsControl; property LookupRoot: TComponent read FLookupRoot; 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 OnPasteComponent: TOnPasteComponent read FOnPasteComponent write FOnPasteComponent; property OnPropertiesChanged: TNotifyEvent read FOnPropertiesChanged write FOnPropertiesChanged; property OnRenameComponent: TOnRenameComponent read FOnRenameComponent write FOnRenameComponent; property OnSetDesigning: TOnSetDesigning read FOnSetDesigning write FOnSetDesigning; property OnComponentAdded: TNotifyEvent 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 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 SnapToGrid: boolean read GetSnapToGrid write SetSnapToGrid; property TheFormEditor: TCustomFormEditor read FTheFormEditor write FTheFormEditor; property DefaultFormBounds: TRect read FDefaultFormBounds write SetDefaultFormBounds; property DefaultFormBoundsValid: boolean read FDefaultFormBoundsValid write FDefaultFormBoundsValid; end; const DesignerMenuRootName = 'Designer'; var DesignerMenuAlign: TIDEMenuCommand; DesignerMenuMirrorHorizontal: TIDEMenuCommand; DesignerMenuMirrorVertical: TIDEMenuCommand; DesignerMenuScale: TIDEMenuCommand; DesignerMenuSize: TIDEMenuCommand; DesignerMenuTabOrder: TIDEMenuCommand; DesignerMenuOrderMoveToFront: TIDEMenuCommand; DesignerMenuOrderMoveToBack: TIDEMenuCommand; DesignerMenuOrderForwardOne: TIDEMenuCommand; DesignerMenuOrderBackOne: TIDEMenuCommand; DesignerMenuCut: TIDEMenuCommand; DesignerMenuCopy: TIDEMenuCommand; DesignerMenuPaste: TIDEMenuCommand; DesignerMenuDeleteSelection: TIDEMenuCommand; DesignerMenuSelectAll: TIDEMenuCommand; DesignerMenuChangeClass: TIDEMenuCommand; DesignerMenuChangeParent: TIDEMenuSection; DesignerMenuViewLFM: TIDEMenuCommand; DesignerMenuSaveAsXML: TIDEMenuCommand; DesignerMenuSnapToGridOption: TIDEMenuCommand; DesignerMenuSnapToGuideLinesOption: TIDEMenuCommand; DesignerMenuShowOptions: TIDEMenuCommand; procedure RegisterStandardDesignerMenuItems; implementation type TCustomFormAccess = class(TCustomForm); 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',fdmAlignWord, 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',fdmScaleWord, nil, nil, nil, 'scale'); DesignerMenuSize:=RegisterIDEMenuCommand(DesignerMenuSectionAlign, 'Size',fdmSizeWord, nil, nil, nil, 'size'); // register tab and order section DesignerMenuSectionOrder:=RegisterIDEMenuSection(DesignerMenuRoot, 'Order section'); DesignerMenuTabOrder:=RegisterIDEMenuCommand(DesignerMenuSectionOrder, 'Tab order',fdmTabOrder); 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',lisMenuCut, nil, nil, nil, 'laz_cut'); DesignerMenuCopy:=RegisterIDEMenuCommand(DesignerMenuSectionClipboard, 'Copy',lisMenuCopy, nil, nil, nil, 'laz_copy'); DesignerMenuPaste:=RegisterIDEMenuCommand(DesignerMenuSectionClipboard, 'Paste',lisMenuPaste, 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',lisChangeClass); DesignerMenuChangeParent:=RegisterIDEMenuSection(DesignerMenuSectionMisc, 'Change parent'); DesignerMenuChangeParent.ChildsAsSubMenu:=true; DesignerMenuChangeParent.Caption:=lisChangeParent; DesignerMenuViewLFM:=RegisterIDEMenuCommand(DesignerMenuSectionMisc, 'View LFM',lisViewSourceLfm); DesignerMenuSaveAsXML:=RegisterIDEMenuCommand(DesignerMenuSectionMisc, 'Save as XML',fdmSaveFormAsXML); // register options section DesignerMenuSectionOptions:=RegisterIDEMenuSection(DesignerMenuRoot, 'Options section'); DesignerMenuSnapToGridOption:=RegisterIDEMenuCommand(DesignerMenuSectionOptions, 'Snap to grid',fdmSnapToGridOption); DesignerMenuSnapToGuideLinesOption:=RegisterIDEMenuCommand(DesignerMenuSectionOptions, 'Snap to guide lines',fdmSnapToGuideLinesOption); DesignerMenuShowOptions:=RegisterIDEMenuCommand(DesignerMenuSectionOptions, 'Show options',dlgFROpts, nil, nil, nil, 'menu_environment_options'); end; constructor TDesigner.Create(TheDesignerForm: TCustomForm; AControlSelection: TControlSelection); begin inherited Create; FForm := TheDesignerForm; if FForm is TNonControlDesignerForm then FLookupRoot := TNonControlDesignerForm(FForm).LookupRoot else if FForm is TFrameDesignerForm then FLookupRoot := TFrameDesignerForm(FForm).LookupRoot else FLookupRoot := FForm; ControlSelection := AControlSelection; FFlags := []; 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; IgnoreDeletingPersistent:=TList.Create; end; procedure TDesigner.FreeDesigner(FreeComponent: boolean); var i: Integer; begin Include(FFlags, dfDestroyingForm); if FLookupRoot is TComponent then begin // unselect if TheControlSelection.LookupRoot = FLookupRoot then begin TheControlSelection.BeginUpdate; TheControlSelection.Clear; TheControlSelection.EndUpdate; end; if GlobalDesignHook.LookupRoot = FLookupRoot then GlobalDesignHook.LookupRoot := nil; if FreeComponent then begin // tell hooks about deleting for i := FLookupRoot.ComponentCount - 1 downto 0 do GlobalDesignHook.PersistentDeleting(FLookupRoot.Components[i]); GlobalDesignHook.PersistentDeleting(FLookupRoot); end; // delete if Form <> nil then Form.Designer := nil; TheFormEditor.DeleteComponent(FLookupRoot, FreeComponent); end; Free; end; destructor TDesigner.Destroy; Begin FreeAndNil(DesignerPopupMenu); FreeAndNil(FHintWIndow); FreeAndNil(FHintTimer); FreeAndNil(DDC); FreeAndNil(DeletingPersistent); FreeAndNil(IgnoreDeletingPersistent); Inherited Destroy; end; procedure TDesigner.NudgePosition(DiffX, DiffY : Integer); begin {$IFDEF VerboseDesigner} DebugLn('[TDesigner.NudgePosition]'); {$ENDIF} if (ControlSelection.SelectionForm<>Form) or ControlSelection.LookupRootSelected then exit; ControlSelection.MoveSelection(DiffX, DiffY); Modified; end; procedure TDesigner.NudgeSize(DiffX, DiffY: Integer); begin {$IFDEF VerboseDesigner} DebugLn('[TDesigner.NudgeSize]'); {$ENDIF} if (ControlSelection.SelectionForm<>Form) or ControlSelection.LookupRootSelected then exit; ControlSelection.SizeSelection(DiffX, DiffY); Modified; end; procedure TDesigner.SelectParentOfSelection; var i: Integer; begin if ControlSelection.ActiveGrabber <> nil then begin ControlSelection.ActiveGrabber := nil; if ControlSelection.RubberbandActive then ControlSelection.RubberbandActive := False; LastMouseMovePos.X:=-1; Exclude(FFlags, dfHasSized); MouseDownComponent := nil; MouseDownSender := nil; Exit; end; if ControlSelection.OnlyInvisiblePersistentsSelected then Exit; if ControlSelection.LookupRootSelected then begin SelectOnlyThisComponent(FLookupRoot); Exit; end; i:=ControlSelection.Count-1; while (i>=0) and ( (ControlSelection[i].ParentInSelection) or (not ControlSelection[i].IsTControl) or (TControl(ControlSelection[i].Persistent).Parent=nil)) do dec(i); if i>=0 then SelectOnlyThisComponent(TControl(ControlSelection[i].Persistent).Parent); end; function TDesigner.CopySelectionToStream(AllComponentsStream: TStream): boolean; function UnselectDistinctControls: boolean; var i: Integer; AParent, CurParent: TWinControl; begin Result:=false; AParent:=nil; i:=0; while iCurParent) then begin ControlSelection.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 (ControlSelection.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 ControlSelection.Count-1 do begin if not ControlSelection[i].IsTComponent then continue; BinCompStream:=TMemoryStream.Create; TxtCompStream:=TMemoryStream.Create; try // write component binary stream try CurComponent:=TComponent(ControlSelection[i].Persistent); DestroyDriver:=false; Writer := CreateLRSWriter(BinCompStream,DestroyDriver); try {$IFNDEF DisableFakeMethods} Writer.OnWriteMethodProperty:=@BaseFormEditor1.WriteMethodPropertyEvent; {$ENDIF} Writer.Root:=FLookupRoot; Writer.WriteComponent(CurComponent); finally if DestroyDriver then Writer.Driver.Free; Writer.Destroy; end; except on E: Exception do begin MessageDlg(lisUnableToStreamSelectedComponents, Format(lisThereWasAnErrorDuringWritingTheSelectedComponent, [ CurComponent.Name, CurComponent.ClassName, #13, E.Message]), mtError,[mbCancel],0); exit; end; end; BinCompStream.Position:=0; // convert binary to text stream try LRSObjectBinaryToText(BinCompStream,TxtCompStream); except on E: Exception do begin MessageDlg(lisUnableConvertBinaryStreamToText, Format(lisThereWasAnErrorWhileConvertingTheBinaryStreamOfThe, [ CurComponent.Name, CurComponent.ClassName, #13, E.Message]), mtError,[mbCancel],0); 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 ControlSelection.Count = 0 then exit; if ControlSelection.OnlyInvisiblePersistentsSelected then exit; AllComponentsStream:=TMemoryStream.Create; try // copy components to stream if not CopySelectionToStream(AllComponentsStream) then exit; SetLength(AllComponentText,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 MessageDlg(lisUnableCopyComponentsToClipboard, Format(lisThereWasAnErrorWhileCopyingTheComponentStreamToCli, [#13, E.Message]), mtError,[mbCancel],0); exit; end; end; finally AllComponentsStream.Free; end; Result:=true; end; function TDesigner.GetPasteParent: TWinControl; var i: Integer; begin Result:=nil; for i:=0 to ControlSelection.Count-1 do begin if (ControlSelection[i].IsTWinControl) and (csAcceptsControls in TWinControl(ControlSelection[i].Persistent).ControlStyle) and (not ControlSelection[i].ParentInSelection) then begin Result:=TWinControl(ControlSelection[i].Persistent); if GetLookupRootForComponent(Result)<>FLookupRoot then Result:=nil; break; end; end; if (Result=nil) and (FLookupRoot is TWinControl) then Result:=TWinControl(FLookupRoot); 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 AllComponentText: string; StartPos: Integer; EndPos: Integer; CurTextCompStream: TStream; NewSelection: TControlSelection; l: Integer; 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 (OverlappedControl<>AComponent) 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 := DesignInfoFrom( Word(Max(0, Min(P.x, Form.ClientWidth - NonVisualCompWidth))), Word(Max(0, Min(P.y, Form.ClientHeight - NonVisualCompWidth)))); end; end; function PasteComponent(TextCompStream: TStream): boolean; var NewComponent: TComponent; begin Result:=false; TextCompStream.Position:=0; if Assigned(FOnPasteComponent) then begin NewComponent:=nil; // create component and add to LookupRoot FOnPasteComponent(Self,FLookupRoot,TextCompStream, PasteParent,NewComponent); if NewComponent=nil then exit; // add new component to new selection NewSelection.Add(NewComponent); // set new nice bounds if cpsfFindUniquePositions in PasteFlags then FindUniquePosition(NewComponent); // finish adding component NotifyPersistentAdded(NewComponent); Modified; end; Result:=true; end; 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:=TControlSelection.Create; 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; l:=s.Size-s.Position; SetLength(AllComponentText,l); s.Read(AllComponentText[1],length(AllComponentText)); StartPos:=1; EndPos:=StartPos; // read till 'end' while EndPos<=length(AllComponentText) do begin //debugln('TDesigner.DoInsertFromStream C'); if (AllComponentText[EndPos] in ['e','E']) and (EndPos>1) and (AllComponentText[EndPos-1] in [#10,#13]) and (CompareText(copy(AllComponentText,EndPos,3),'END')=0) and ((EndPos+3>length(AllComponentText)) or (AllComponentText[EndPos+3] in [#10,#13])) then begin inc(EndPos,4); while (EndPos<=length(AllComponentText)) and (AllComponentText[EndPos] in [' ',#10,#13]) do inc(EndPos); // extract text for the current component {$IFDEF VerboseDesigner} DebugLn('TDesigner.DoInsertFromStream=============================='); DebugLn(copy(AllComponentText,StartPos,EndPos-StartPos)); DebugLn('TDesigner.DoInsertFromStream=============================='); {$ENDIF} CurTextCompStream:=TMemoryStream.Create; try CurTextCompStream.Write(AllComponentText[StartPos],EndPos-StartPos); CurTextCompStream.Position:=0; // create component from stream if not PasteComponent(CurTextCompStream) then exit; finally CurTextCompStream.Free; end; StartPos:=EndPos; end else begin inc(EndPos); end; end; finally if NewSelection.Count>0 then ControlSelection.Assign(NewSelection); NewSelection.Free; end; Result:=true; end; procedure TDesigner.DoShowTabOrderEditor; begin if ShowTabOrderDialog(FLookupRoot)=mrOk then Modified; end; procedure TDesigner.DoShowChangeClassDialog; begin if (ControlSelection.Count=1) and (not ControlSelection.LookupRootSelected) then ShowChangeClassDialog(Self,ControlSelection[0].Persistent); end; procedure TDesigner.DoOrderMoveSelectionToFront; begin if ControlSelection.Count <> 1 then Exit; if not ControlSelection[0].IsTControl then Exit; TControl(ControlSelection[0].Persistent).BringToFront; Modified; end; procedure TDesigner.DoOrderMoveSelectionToBack; begin if ControlSelection.Count <> 1 then Exit; if not ControlSelection[0].IsTControl then Exit; TControl(ControlSelection[0].Persistent).SendToBack; Modified; end; procedure TDesigner.DoOrderForwardSelectionOne; var Control: TControl; Parent: TWinControl; begin if ControlSelection.Count <> 1 then Exit; if not ControlSelection[0].IsTControl then Exit; Control := TControl(ControlSelection[0].Persistent); Parent := Control.Parent; if Parent = nil then Exit; Parent.SetControlIndex(Control, Parent.GetControlIndex(Control) + 1); Modified; end; procedure TDesigner.DoOrderBackSelectionOne; var Control: TControl; Parent: TWinControl; begin if ControlSelection.Count <> 1 then Exit; if not ControlSelection[0].IsTControl then Exit; Control := TControl(ControlSelection[0].Persistent); Parent := Control.Parent; if Parent = nil then Exit; Parent.SetControlIndex(Control, Parent.GetControlIndex(Control) - 1); Modified; end; procedure TDesigner.GiveComponentsNames; var i: Integer; CurComponent: TComponent; begin if LookupRoot=nil then exit; for i:=0 to LookupRoot.ComponentCount-1 do begin CurComponent:=LookupRoot.Components[i]; if CurComponent.Name='' then CurComponent.Name:=UniqueName(CurComponent.ClassName); end; end; procedure TDesigner.NotifyPersistentAdded(APersistent: TPersistent); begin try GiveComponentsNames; GlobalDesignHook.PersistentAdded(APersistent,false); except on E: Exception do MessageDlg('Error:',E.Message,mtError,[mbOk],0); end; end; procedure TDesigner.SelectOnlyThisComponent(AComponent:TComponent); begin ControlSelection.AssignPersistent(AComponent); end; function TDesigner.CopySelection: boolean; begin Result := DoCopySelectionToClipboard; end; function TDesigner.CutSelection: boolean; begin Result := DoCopySelectionToClipboard and DoDeleteSelectedPersistents; end; function TDesigner.CanPaste: Boolean; begin Result:=(Form<>nil) and (FLookupRoot<>nil) and (not (csDestroying in FLookupRoot.ComponentState)); end; function TDesigner.PasteSelection( PasteFlags: TComponentPasteSelectionFlags): boolean; begin Result:=DoPasteSelectionFromClipboard(PasteFlags); end; function TDesigner.DeleteSelection: boolean; begin Result:=DoDeleteSelectedPersistents; end; function TDesigner.InvokeComponentEditor(AComponent: TComponent; MenuIndex: integer): boolean; var CompEditor: TBaseComponentEditor; begin Result:=false; DebugLn('TDesigner.InvokeComponentEditor A ',AComponent.Name,':',AComponent.ClassName); CompEditor:=TheFormEditor.GetComponentEditor(AComponent); if CompEditor=nil then begin DebugLn('TDesigner.InvokeComponentEditor', ' WARNING: no component editor found for ', AComponent.Name,':',AComponent.ClassName); exit; end; DebugLn('TDesigner.InvokeComponentEditor B ',CompEditor.ClassName); try CompEditor.Edit; Result:=true; except on E: Exception do begin DebugLn('TDesigner.InvokeComponentEditor ERROR: ',E.Message); MessageDlg(Format(lisErrorIn, [CompEditor.ClassName]), Format(lisTheComponentEditorOfClassHasCreatedTheError, ['"', CompEditor.ClassName, '"', #13, '"', E.Message, '"']), mtError,[mbOk],0); end; end; 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 : DoOrderMoveSelectionToFront; ecDesignerMoveToBack : DoOrderMoveSelectionToBack; ecDesignerForwardOne : DoOrderForwardSelectionOne; ecDesignerBackOne : DoOrderBackSelectionOne; else Exit; end; Handled := True; end; function TDesigner.NonVisualComponentLeftTop(AComponent: TComponent): TPoint; begin Result.X:=Max(0, Min(LongRec(AComponent.DesignInfo).Lo, Form.ClientWidth-NonVisualCompWidth)); Result.Y:=Max(0, Min(LongRec(AComponent.DesignInfo).Hi, Form.ClientHeight-NonVisualCompWidth)); end; procedure TDesigner.InvalidateWithParent(AComponent: TComponent); begin {$IFDEF VerboseDesigner} DebugLn('TDesigner.INVALIDATEWITHPARENT ',AComponent.Name,':',AComponent.ClassName); {$ENDIF} if AComponent is TControl then begin if TControl(AComponent).Parent<>nil then TControl(AComponent).Parent.Invalidate else TControl(AComponent).Invalidate; end else begin FForm.Invalidate; end; end; procedure TDesigner.SetDefaultFormBounds(const AValue: TRect); begin FDefaultFormBounds:=AValue; end; procedure TDesigner.SetGridColor(const AValue: TColor); begin if GridColor=AValue then exit; EnvironmentOptions.GridColor:=AValue; Form.Invalidate; end; procedure TDesigner.SetShowBorderSpacing(const AValue: boolean); begin if ShowBorderSpacing=AValue then exit; EnvironmentOptions.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 TWinControl then DDC.SetDC(Form, TWinControl(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 ',Sender.Name,':',Sender.ClassName, ' 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)); //RaiseException(''); end; LastPaintSender:=Sender; if IsDesignerDC(Form.Handle, TheMessage.DC) then begin DoPaintDesignerItems; end else begin // client grid if (Sender is TWinControl) and (csAcceptsControls in Sender.ControlStyle) then begin PaintClientGrid(TWinControl(Sender),DDC); end; if (WidgetSet.GetLCLCapability(lcCanDrawOutsideOnPaint) <> 0) and not EnvironmentOptions.DesignerPaintLazy then DoPaintDesignerItems; 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(TheMessage.LParam) = HTCLIENT; if Result then begin Form.SetTempCursor(LastFormCursor); TheMessage.Result := 1; 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 csOwnedChildsSelectable 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 ControlSelection.SelectionForm=Form then begin ControlSelection.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,' ',ControlSelection.SelectionForm=Form,' ',not ControlSelection.IsResizing,' ',ControlSelection.IsSelected(Sender)); if ControlSelection.SelectionForm=Form then begin if (not ControlSelection.CheckForLCLChanges(true)) and (Sender=Form) and ControlSelection.LookupRootSelected then begin // the selected form was moved (nothing else has changed) // ControlSelection 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; NonVisualComp: TComponent; ParentForm: TCustomForm; Shift: TShiftState; DesignSender: TControl; begin FHintTimer.Enabled := False; Exclude(FFLags, dfHasSized); SetCaptureControl(nil); DesignSender := GetDesignControl(Sender); ParentForm := GetParentForm(DesignSender); //DebugLn(['TDesigner.MouseDownOnControl DesignSender=',dbgsName(DesignSender),' ParentForm=',dbgsName(ParentForm)]); if (ParentForm = nil) then exit; MouseDownPos := GetFormRelativeMousePosition(Form); LastMouseMovePos := MouseDownPos; MouseDownComponent := nil; MouseDownSender := nil; NonVisualComp := NonVisualComponentAtPos(MouseDownPos.X, MouseDownPos.Y); if NonVisualComp<>nil then begin MouseDownComponent := NonVisualComp; MoveNonVisualComponentIntoForm(NonVisualComp); end; if (MouseDownComponent = nil) then begin MouseDownComponent := ComponentAtPos(MouseDownPos.X, MouseDownPos.Y, True, True); if (MouseDownComponent = nil) then exit; end; MouseDownSender := DesignSender; case TheMessage.Msg of LM_LBUTTONDOWN, LM_MBUTTONDOWN, LM_RBUTTONDOWN: MouseDownClickCount := 1; LM_LBUTTONDBLCLK,LM_MBUTTONDBLCLK,LM_RBUTTONDBLCLK: MouseDownClickCount := 2; LM_LBUTTONTRIPLECLK,LM_MBUTTONTRIPLECLK,LM_RBUTTONTRIPLECLK: MouseDownClickCount := 3; LM_LBUTTONQUADCLK,LM_MBUTTONQUADCLK,LM_RBUTTONQUADCLK: MouseDownClickCount := 4; else MouseDownClickCount := 1; end; Shift := []; if (TheMessage.keys and MK_Shift) = MK_Shift then Include(Shift, ssShift); if (TheMessage.keys and MK_Control) = MK_Control then Include(Shift, ssCtrl); {$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} SelectedCompClass := GetSelectedComponentClass; if (TheMessage.Keys and MK_LButton) > 0 then begin // left button // -> check if a grabber was activated ControlSelection.ActiveGrabber:= ControlSelection.GrabberAtPos(MouseDownPos.X, MouseDownPos.Y); SetCaptureControl(ParentForm); if SelectedCompClass = nil then begin // selection mode if ControlSelection.ActiveGrabber=nil then begin // no grabber resizing CompIndex:=ControlSelection.IndexOf(MouseDownComponent); if ssCtrl in Shift then begin // child selection end else begin if (ssShift in Shift) then begin // shift key pressed (multiselection) if CompIndex<0 then begin // not selected // add component to selection if (ControlSelection.SelectionForm<>nil) and (ControlSelection.SelectionForm<>Form) then begin MessageDlg(lisInvalidMultiselection, fdInvalidMultiselectionText, mtInformation,[mbOk],0); end else begin ControlSelection.Add(MouseDownComponent); end; end else begin // remove from multiselection ControlSelection.Delete(CompIndex); end; end else begin // no shift key (single selection or keeping multiselection) if (CompIndex<0) then begin // select only this component ControlSelection.AssignPersistent(MouseDownComponent); end else // sync with the interface ControlSelection.UpdateBounds; end; 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 (ControlSelection.SelectionForm <> Form) then ControlSelection.AssignPersistent(MouseDownComponent); end; end else begin // not left button ControlSelection.ActiveGrabber:=nil; end; if not ControlSelection.OnlyVisualComponentsSelected and ShowComponentCaptions then Form.Invalidate; {$IFDEF VerboseDesigner} DebugLn('[TDesigner.MouseDownOnControl] END'); {$ENDIF} End; procedure TDesigner.MouseUpOnControl(Sender : TControl; var TheMessage:TLMMouse); var ParentCI, NewCI: TComponentInterface; NewLeft, NewTop, NewWidth, NewHeight: Integer; Shift: TShiftState; SenderParentForm: TCustomForm; RubberBandWasActive: boolean; ParentClientOrigin, PopupPos: TPoint; SelectedCompClass: TRegisteredComponent; SelectionChanged, NewRubberbandSelection: boolean; DesignSender: TControl; procedure GetShift; begin Shift := []; if (TheMessage.keys and MK_Shift) = MK_Shift then Include(Shift,ssShift); if (TheMessage.keys and MK_Control) = MK_Control then Include(Shift,ssCtrl); case TheMessage.Msg of LM_LBUTTONUP: Include(Shift,ssLeft); LM_MBUTTONUP: Include(Shift,ssMiddle); LM_RBUTTONUP: Include(Shift,ssRight); end; if MouseDownClickCount=2 then Include(Shift,ssDouble); if MouseDownClickCount=3 then Include(Shift,ssTriple); if MouseDownClickCount=4 then Include(Shift,ssQuad); end; procedure AddComponent; var NewParent: TComponent; NewParentControl: TWinControl; NewComponent: TComponent; NewComponentClass: TComponentClass; begin if MouseDownComponent=nil then exit; // add a new component ControlSelection.RubberbandActive:=false; ControlSelection.Clear; NewComponentClass := SelectedCompClass.GetCreationClass; // find a parent for the new component if (FLookupRoot is TCustomForm) or (FLookupRoot is TCustomFrame) then begin if MouseDownComponent is TWinControl then NewParentControl := TWinControl(MouseDownComponent) else NewParentControl := WinControlAtPos(MouseDownPos.X, MouseUpPos.X, true, true); while (NewParentControl <> nil) and ((not (csAcceptsControls in NewParentControl.ControlStyle)) or (NewComponentClass.InheritsFrom(TControl) and not NewParentControl.CheckChildClassAllowed(NewComponentClass, False)) or (csInline in NewParentControl.ComponentState) or // Because of TWriter, you can not put a control onto an csInline control (e.g. on a frame). ((NewParentControl.Owner <> FLookupRoot) and (NewParentControl <> FLookupRoot))) do begin NewParentControl := NewParentControl.Parent; end; NewParent := NewParentControl; end else NewParent := FLookupRoot; ParentCI:=TComponentInterface(TheFormEditor.FindComponent(NewParent)); if not Assigned(ParentCI) then exit; if not PropertyEditorHook.BeforeAddPersistent(Self, SelectedCompClass.ComponentClass,NewParent) then begin DebugLn('TDesigner.AddComponent ', SelectedCompClass.ComponentClass.ClassName,' not possible'); exit; end; // calculate initial bounds ParentClientOrigin:=GetParentFormRelativeClientOrigin(NewParent); NewLeft:=Min(MouseDownPos.X,MouseUpPos.X); NewTop:=Min(MouseDownPos.Y,MouseUpPos.Y); if SelectedCompClass.ComponentClass.InheritsFrom(TControl) then begin // 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; // check circles if TheFormEditor.ClassDependsOnComponent(NewComponentClass, LookupRoot) then begin IDEMessageDialog(lisInvalidCircle, Format(lisIsAThisCircleDependencyIsNotAllowed, [dbgsName(LookupRoot), dbgsName(NewComponentClass), #13]), mtError,[mbCancel],''); exit; end; // create component and component interface NewCI := TComponentInterface(TheFormEditor.CreateComponent( ParentCI,NewComponentClass,'', NewLeft,NewTop,NewWidth,NewHeight)); if NewCI=nil then exit; Modified; NewComponent:=NewCI.Component; // set initial properties if NewComponent is TControl then begin TControl(NewComponent).Visible:=true; if csSetCaption in TControl(NewComponent).ControlStyle then TControl(NewComponent).Caption:=NewComponent.Name; end; if Assigned(FOnSetDesigning) then FOnSetDesigning(Self,NewComponent,True); // tell IDE about the new component (e.g. add it to the source) NotifyPersistentAdded(NewComponent); // creation completed // -> select new component SelectOnlyThisComponent(NewComponent); if Assigned(FOnComponentAdded) then // this resets the component palette to the selection tool FOnComponentAdded(Self); {$IFDEF VerboseDesigner} DebugLn('NEW COMPONENT ADDED: Form.ComponentCount=',DbgS(Form.ComponentCount), ' NewComponent.Owner.Name=',NewComponent.Owner.Name); {$ENDIF} end; procedure RubberbandSelect; var MaxParentControl: TControl; begin if (ssShift in Shift) and (ControlSelection.SelectionForm<>nil) and (ControlSelection.SelectionForm<>Form) then begin MessageDlg(lisInvalidMultiselection, fdInvalidMultiselectionText, mtInformation,[mbOk],0); exit; end; ControlSelection.BeginUpdate; // check if start new selection or add/remove: NewRubberbandSelection:= (not (ssShift in Shift)) or (ControlSelection.SelectionForm<>Form); // update non visual components MoveNonVisualComponentsIntoForm; // if user press the Control key, then component candidates are only // childs of the control, where the mouse started if (ssCtrl in shift) and (MouseDownComponent is TControl) then MaxParentControl:=TControl(MouseDownComponent) else MaxParentControl:=Form; SelectionChanged:=false; ControlSelection.SelectWithRubberBand( FLookupRoot,NewRubberbandSelection,ssShift in Shift,SelectionChanged, MaxParentControl); if ControlSelection.Count=0 then begin ControlSelection.Add(FLookupRoot); SelectionChanged:=true; end; ControlSelection.RubberbandActive:=false; ControlSelection.EndUpdate; {$IFDEF VerboseDesigner} DebugLn('RubberbandSelect ',DbgS(ControlSelection.Grabbers[0])); {$ENDIF} Form.Invalidate; end; procedure PointSelect; begin if not (ssShift in Shift) then begin // select only the mouse down component ControlSelection.AssignPersistent(MouseDownComponent); if (MouseDownClickCount = 2) and (ControlSelection.SelectionForm = Form) then begin // Double Click -> invoke 'Edit' of the component editor FShiftState := Shift; InvokeComponentEditor(MouseDownComponent, -1); FShiftState := []; end; end; end; procedure DisableRubberBand; begin if ControlSelection.RubberbandActive then begin ControlSelection.RubberbandActive:=false; end; end; Begin FHintTimer.Enabled := False; SetCaptureControl(nil); // check if the message is for the designed form // and there was a mouse down before DesignSender:=GetDesignControl(Sender); SenderParentForm:=GetParentForm(DesignSender); //DebugLn(['TDesigner.MouseUpOnControl DesignSender=',dbgsName(DesignSender),' SenderParentForm=',dbgsName(SenderParentForm),' ',TheMessage.XPos,',',TheMessage.YPos]); if (MouseDownComponent=nil) or (SenderParentForm=nil) or (SenderParentForm<>Form) or ((ControlSelection.SelectionForm<>nil) and (ControlSelection.SelectionForm<>Form)) then begin MouseDownComponent:=nil; MouseDownSender:=nil; exit; end; ControlSelection.ActiveGrabber:=nil; RubberBandWasActive:=ControlSelection.RubberBandActive; SelectedCompClass:=GetSelectedComponentClass; GetShift; 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 TheMessage.Msg=LM_LBUTTONUP then begin if SelectedCompClass = nil then begin // layout mode (selection, moving and resizing) if not (dfHasSized in FFlags) then begin // new selection if RubberBandWasActive then begin // rubberband selection RubberbandSelect; end else begin // point selection PointSelect; end; end; end else begin // create new a component on the form AddComponent; end; end else if TheMessage.Msg=LM_RBUTTONUP then begin // right click -> popup menu DisableRubberBand; if EnvironmentOptions.RightClickSelects and (not ControlSelection.IsSelected(MouseDownComponent)) and (Shift - [ssRight] = []) then PointSelect; PopupMenuComponentEditor:=GetComponentEditorForSelection; BuildPopupMenu; PopupPos := Form.ClientToScreen(MouseUpPos); DesignerPopupMenu.Popup(PopupPos.X,PopupPos.Y); end; DisableRubberBand; LastMouseMovePos.X:=-1; Exclude(FFlags,dfHasSized); MouseDownComponent:=nil; MouseDownSender:=nil; if not ControlSelection.OnlyVisualComponentsSelected and ShowComponentCaptions then Form.Invalidate; {$IFDEF VerboseDesigner} DebugLn('[TDesigner.MouseLeftUpOnControl] END'); {$ENDIF} end; procedure TDesigner.MouseMoveOnControl(Sender: TControl; var TheMessage: TLMMouse); var Shift : TShiftState; SenderParentForm:TCustomForm; OldMouseMovePos: TPoint; Grabber: TGrabber; ACursor: TCursor; SelectedCompClass: TRegisteredComponent; CurSnappedMousePos, OldSnappedMousePos: TPoint; DesignSender: TControl; begin if [dfShowEditorHints]*FFlags<>[] then begin FHintTimer.Enabled := False; // hide hint FHintTimer.Enabled := (TheMessage.keys or (MK_LButton and MK_RButton and MK_MButton) = 0); if FHintWindow.Visible then FHintWindow.Visible := False; end; DesignSender:=GetDesignControl(Sender); //DebugLn('TDesigner.MouseMoveOnControl Sender=',dbgsName(Sender),' ',dbgsName(DesignSender)); SenderParentForm:=GetParentForm(DesignSender); if (SenderParentForm = nil) or (SenderParentForm <> Form) then exit; OldMouseMovePos:= LastMouseMovePos; LastMouseMovePos:= GetFormRelativeMousePosition(Form); if (OldMouseMovePos.X=LastMouseMovePos.X) and (OldMouseMovePos.Y=LastMouseMovePos.Y) then exit; if ControlSelection.SelectionForm=Form then Grabber:=ControlSelection.GrabberAtPos( LastMouseMovePos.X, LastMouseMovePos.Y) else Grabber:=nil; if MouseDownComponent=nil then begin if Grabber = nil then ACursor:= crDefault else begin ACursor:= Grabber.Cursor; end; if ACursor<>LastFormCursor then begin LastFormCursor:=ACursor; Form.SetTempCursor(ACursor); end; exit; end; Shift := []; 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 (ControlSelection.SelectionForm=nil) or (ControlSelection.SelectionForm=Form) then begin if (TheMessage.keys and MK_LButton) = MK_LButton then begin // left button pressed if (ControlSelection.ActiveGrabber<>nil) then begin // grabber moving -> size selection if not (dfHasSized in FFlags) then begin ControlSelection.SaveBounds; Include(FFlags,dfHasSized); end; OldSnappedMousePos:= ControlSelection.SnapGrabberMousePos(OldMouseMovePos); CurSnappedMousePos:= ControlSelection.SnapGrabberMousePos(LastMouseMovePos); ControlSelection.SizeSelection( CurSnappedMousePos.X-OldSnappedMousePos.X, CurSnappedMousePos.Y-OldSnappedMousePos.Y); if Assigned(OnModified) then OnModified(Self); end else begin // no grabber active SelectedCompClass:=GetSelectedComponentClass; if (not ControlSelection.RubberBandActive) and (SelectedCompClass=nil) and (Shift=[]) and (ControlSelection.Count>=1) and (not ControlSelection.LookupRootSelected) then begin // move selection if not (dfHasSized in FFlags) then begin ControlSelection.SaveBounds; Include(FFlags,dfHasSized); end; //debugln('TDesigner.MouseMoveOnControl Move MouseDownComponent=',dbgsName(MouseDownComponent),' OldMouseMovePos=',dbgs(OldMouseMovePos),' MouseMovePos',dbgs(LastMouseMovePos),' MouseDownPos=',dbgs(MouseDownPos)); if ControlSelection.MoveSelectionWithSnapping( LastMouseMovePos.X-MouseDownPos.X,LastMouseMovePos.Y-MouseDownPos.Y) then begin if Assigned(OnModified) then OnModified(Self); end; end else begin // rubberband sizing (selection or creation) ControlSelection.RubberBandBounds:=Rect(MouseDownPos.X,MouseDownPos.Y, LastMouseMovePos.X, LastMouseMovePos.Y); if SelectedCompClass=nil then ControlSelection.RubberbandType:=rbtSelection else ControlSelection.RubberbandType:=rbtCreating; ControlSelection.RubberBandActive:=true; end; end; end else begin ControlSelection.ActiveGrabber:=nil; end; end; 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; 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); end; begin {$IFDEF VerboseDesigner} DebugLn(['TDesigner.KEYDOWN ',TheMessage.CharCode,' ',TheMessage.KeyData]); {$ENDIF} Shift := KeyDataToShiftState(TheMessage.KeyData); Handled := False; 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 then begin Handled := True; case TheMessage.CharCode of VK_DELETE: if not ControlSelection.OnlyInvisiblePersistentsSelected then DoDeleteSelectedPersistents; VK_UP: Nudge(0,-1); VK_DOWN: Nudge(0,1); VK_RIGHT: Nudge(1,0); VK_LEFT: Nudge(-1,0); VK_A: if Shift = [ssCtrl] then DoSelectAll else Handled := False; else Handled:=false; end; end; if Handled then TheMessage.CharCode := 0; end; {------------------------------------K E Y U P --------------------------------} Procedure TDesigner.KeyUp(Sender : TControl; var TheMessage:TLMKEY); Begin {$IFDEF VerboseDesigner} //Writeln('TDesigner.KEYUP ',TheMessage.CharCode,' ',TheMessage.KeyData); {$ENDIF} end; function TDesigner.DoDeleteSelectedPersistents: boolean; var i: integer; APersistent: TPersistent; AncestorRoot: TComponent; AComponent: TComponent; begin Result:=true; if (ControlSelection.Count=0) or (ControlSelection.SelectionForm<>Form) then exit; Result:=false; // check if a component is the lookup root (can not be deleted) if (ControlSelection.LookupRootSelected) then begin if ControlSelection.Count>1 then MessageDlg(lisInvalidDelete, lisTheRootComponentCanNotBeDeleted, mtInformation, [mbCancel],0); exit; end; // check if a selected component is inherited (can not be deleted) for i:=0 to ControlSelection.Count-1 do begin if not ControlSelection[i].IsTComponent then continue; AncestorRoot:=TheFormEditor.GetAncestorLookupRoot( TComponent(ControlSelection[i].Persistent)); if AncestorRoot<>nil then begin MessageDlg(lisInvalidDelete, Format(lisTheComponentIsInheritedFromToDeleteAnInheritedComp, [dbgsName( ControlSelection[i].Persistent), dbgsName(AncestorRoot), #13]), mtInformation, [mbCancel],0); exit; end; end; // check if a selected component is not owned by lookuproot (can not be deleted) for i:=0 to ControlSelection.Count-1 do begin if not ControlSelection[i].IsTComponent then continue; AComponent:=TComponent(ControlSelection[i].Persistent); if AComponent.Owner<>FLookupRoot then begin MessageDlg(lisInvalidDelete, Format(lisTheComponentCanNotBeDeletedBecauseItIsNotOwnedBy, [dbgsName( ControlSelection[i].Persistent), dbgsName(FLookupRoot)]), mtInformation, [mbCancel],0); exit; end; end; // mark selected components for deletion for i:=0 to ControlSelection.Count-1 do MarkPersistentForDeletion(ControlSelection[i].Persistent); // clear selection by selecting the LookupRoot SelectOnlyThisComponent(FLookupRoot); // delete marked components Include(FFlags,dfDeleting); 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)]); RemovePersistentAndChilds(APersistent); //writeln('TDesigner.DoDeleteSelectedComponents B ',DeletingPersistent.IndexOf(AComponent)); end; IgnoreDeletingPersistent.Clear; finally Exclude(FFlags,dfDeleting); Modified; end; Result:=true; end; procedure TDesigner.DoSelectAll; begin ControlSelection.BeginUpdate; ControlSelection.Clear; ControlSelection.SelectAll(FLookupRoot); ControlSelection.EndUpdate; Form.Invalidate; end; procedure TDesigner.DoDeletePersistent(APersistent: TPersistent; FreeIt: boolean); var Hook: TPropertyEditorHook; begin if APersistent=nil then exit; //debugln(['TDesigner.DoDeletePersistent A ',dbgsName(APersistent),' FreeIt=',FreeIt]); PopupMenuComponentEditor:=nil; // unselect component ControlSelection.Remove(APersistent); if (APersistent is TComponent) and (TheFormEditor.FindComponent(TComponent(APersistent))=nil) then begin // this component is currently in the process of deletion or the component // was not properly created // -> 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; // unmark component DeletingPersistent.Remove(APersistent); IgnoreDeletingPersistent.Remove(APersistent); exit; end; // call component deleting handlers Hook:=GetPropertyEditorHook; if Hook<>nil then Hook.PersistentDeleting(APersistent); // delete component if APersistent is TComponent then TheFormEditor.DeleteComponent(TComponent(APersistent),FreeIt) else if FreeIt then APersistent.Free; // unmark component DeletingPersistent.Remove(APersistent); IgnoreDeletingPersistent.Remove(APersistent); // call ComponentDeleted handler if Assigned(FOnPersistentDeleted) then FOnPersistentDeleted(Self,APersistent); end; procedure TDesigner.MarkPersistentForDeletion(APersistent: TPersistent); begin if (not PersistentIsMarkedForDeletion(APersistent)) then DeletingPersistent.Add(APersistent); end; function TDesigner.PersistentIsMarkedForDeletion(APersistent: TPersistent ): boolean; begin Result:=(DeletingPersistent.IndexOf(APersistent)>=0); 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; Begin Result := false; if csDesigning in Sender.ComponentState then begin Result:=true; 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: Result:=OnFormActivated; LM_CLOSEQUERY: Result:=OnFormCloseQuery; LM_SETCURSOR: Result:=HandleSetCursor(TheMessage); else Result:=false; 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.Modified; Begin ControlSelection.SaveBounds; if Assigned(FOnModified) then FOnModified(Self); end; Procedure TDesigner.RemovePersistentAndChilds(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) or (IgnoreDeletingPersistent.IndexOf(APersistent)>=0) then exit; // remove all child controls owned by the LookupRoot if (APersistent is TWinControl) then begin AWinControl:=TWinControl(APersistent); i:=AWinControl.ControlCount-1; while (i>=0) do begin ChildControl:=AWinControl.Controls[i]; // if (GetLookupRootForComponent(ChildControl)=FLookupRoot) if (ChildControl.Owner=FLookupRoot) and (IgnoreDeletingPersistent.IndexOf(ChildControl)<0) then begin //Debugln(['[TDesigner.RemoveComponentAndChilds] B ',dbgsName(APersistent),' Child=',dbgsName(ChildControl),' i=',i,' ',TheFormEditor.FindComponent(ChildControl)<>nil]); RemovePersistentAndChilds(ChildControl); // the component list of the form has changed // -> restart the search i:=AWinControl.ControlCount-1; end else dec(i); end; end; // remove component {$IFDEF VerboseDesigner} DebugLn('[TDesigner.RemovePersistentAndChilds] 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} if dfDeleting in FFlags then begin // a component has auto created a new component during deletion // -> ignore the new component IgnoreDeletingPersistent.Add(AComponent); end else begin if (TheFormEditor<>nil) then TheFormEditor.CreateComponentInterface(AComponent,false); end; end else if Operation = opRemove then begin {$IFDEF VerboseDesigner} DebugLn('[TDesigner.Notification] opRemove ',dbgsName(AComponent)); {$ENDIF} 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; procedure TDesigner.PaintClientGrid(AWinControl: TWinControl; aDDC: TDesignerDeviceContext); var Clip: integer; Count: integer; i: integer; CurControl: TControl; begin if (AWinControl=nil) or (not (csAcceptsControls in AWinControl.ControlStyle)) or ((not ShowGrid) and (not ShowBorderSpacing)) then exit; aDDC.Save; 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; DrawGrid(ADDC.Canvas.Handle, AWinControl.ClientRect, GridSizeX, GridSizeY); end; if ShowBorderSpacing then begin aDDC.Canvas.Brush.Color:=clRed; for i:=0 to Count-1 do begin CurControl:=AWinControl.Controls[i]; aDDC.Canvas.FrameRect( CurControl.Left-CurControl.BorderSpacing.GetSpace(akLeft), CurControl.Top-CurControl.BorderSpacing.GetSpace(akTop), CurControl.Left+CurControl.Width+CurControl.BorderSpacing.GetSpace(akRight)-1, CurControl.Top+CurControl.Height+CurControl.BorderSpacing.GetSpace(akBottom)-1 ); end; end; finally aDDC.Restore; 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.OnComponentEditorVerbMenuItemClick(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); MessageDlg(Format(lisErrorIn, [PopupMenuComponentEditor.ClassName]), Format(lisTheComponentEditorOfClassInvokedWithVerbHasCreated, ['"', PopupMenuComponentEditor.ClassName, '"', #13, IntToStr(Verb), '"', VerbCaption, '"', #13, #13, '"', E.Message, '"']), mtError,[mbOk],0); end; end; end; procedure TDesigner.OnDeleteSelectionMenuClick(Sender: TObject); begin DoDeleteSelectedPersistents; end; procedure TDesigner.OnSelectAllMenuClick(Sender: TObject); begin DoSelectAll; end; procedure TDesigner.OnChangeClassMenuClick(Sender: TObject); begin DoShowChangeClassDialog; end; procedure TDesigner.OnChangeParentMenuClick(Sender: TObject); var Item: TIDEMenuCommand; NewParentName: String; i: Integer; CurControl: TControl; NewParent: TWinControl; begin if not (Sender is TIDEMenuCommand) then Exit; Item := TIDEMenuCommand(Sender); NewParentName := Item.Caption; if SysUtils.CompareText(LookupRoot.Name, NewParentName) = 0 then NewParent := TWinControl(LookupRoot) else NewParent := TWinControl(LookupRoot.FindComponent(NewParentName)); if (NewParent=nil) or (not (NewParent is TWinControl)) then Exit; Form.DisableAlign; try i := ControlSelection.Count - 1; while (i >= 0) do begin if i < ControlSelection.Count then begin if ControlSelection[i].IsTControl then begin CurControl := TControl(ControlSelection[i].Persistent); CurControl.Parent := NewParent; end; end; dec(i); end; finally if Form <> nil then Form.EnableAlign; ControlSelection.DoChange(True); // request updates since control hierarchi change end; end; procedure TDesigner.OnSnapToGridOptionMenuClick(Sender: TObject); begin EnvironmentOptions.SnapToGrid:=not EnvironmentOptions.SnapToGrid; end; procedure TDesigner.OnShowOptionsMenuItemClick(Sender: TObject); begin if Assigned(OnShowOptions) then OnShowOptions(Self); end; procedure TDesigner.OnSnapToGuideLinesOptionMenuClick(Sender: TObject); begin EnvironmentOptions.SnapToGuideLines:=not EnvironmentOptions.SnapToGuideLines; end; procedure TDesigner.OnViewLFMMenuClick(Sender: TObject); begin if Assigned(OnViewLFM) then OnViewLFM(Self); end; procedure TDesigner.OnSaveAsXMLMenuClick(Sender: TObject); begin if Assigned(OnSaveAsXML) then OnSaveAsXML(Self); end; procedure TDesigner.OnCopyMenuClick(Sender: TObject); begin CopySelection; end; procedure TDesigner.OnCutMenuClick(Sender: TObject); begin CutSelection; end; procedure TDesigner.OnPasteMenuClick(Sender: TObject); begin PasteSelection([cpsfFindUniquePositions]); end; procedure TDesigner.OnTabOrderMenuClick(Sender: TObject); begin DoShowTabOrderEditor; end; function TDesigner.GetGridColor: TColor; begin Result:=EnvironmentOptions.GridColor; end; function TDesigner.GetShowBorderSpacing: boolean; begin Result:=EnvironmentOptions.ShowBorderSpacing; end; function TDesigner.GetShowComponentCaptions: boolean; begin Result:=dfShowComponentCaptions in FFlags; end; function TDesigner.GetShowGrid: boolean; begin Result:=EnvironmentOptions.ShowGrid; end; function TDesigner.GetGridSizeX: integer; begin Result:=EnvironmentOptions.GridSizeX; if Result<2 then Result:=2; end; function TDesigner.GetGridSizeY: integer; begin Result:=EnvironmentOptions.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:=EnvironmentOptions.SnapToGrid; end; procedure TDesigner.SetShowGrid(const AValue: boolean); begin if ShowGrid=AValue then exit; EnvironmentOptions.ShowGrid:=AValue; Form.Invalidate; end; procedure TDesigner.SetGridSizeX(const AValue: integer); begin if GridSizeX=AValue then exit; EnvironmentOptions.GridSizeX:=AValue; end; procedure TDesigner.SetGridSizeY(const AValue: integer); begin if GridSizeY=AValue then exit; EnvironmentOptions.GridSizeY:=AValue; end; procedure TDesigner.SetIsControl(Value: Boolean); begin 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.DrawNonVisualComponents(aDDC: TDesignerDeviceContext); var AComponent: TComponent; Icon: TBitmap; i, ItemLeft, ItemTop, ItemRight, ItemBottom: integer; Diff, ItemLeftTop: TPoint; IconRect, TextRect: TRect; TextSize: TSize; IsSelected: Boolean; begin for i := 0 to FLookupRoot.ComponentCount - 1 do begin AComponent := FLookupRoot.Components[i]; if ComponentIsNonVisual(AComponent) then begin Diff := aDDC.FormOrigin; //DebugLn(['aDDC.FormOrigin - ', Diff.X, ' : ' ,Diff.Y]); // non-visual component ItemLeftTop := NonVisualComponentLeftTop(AComponent); ItemLeft := ItemLeftTop.X - Diff.X; ItemTop := ItemLeftTop.Y - Diff.Y; ItemRight := ItemLeft + NonVisualCompWidth; ItemBottom := ItemTop + NonVisualCompWidth; if not aDDC.RectVisible(ItemLeft, ItemTop, ItemRight, ItemBottom) then Continue; IsSelected := ControlSelection.IsSelected(AComponent); aDDC.Save; with aDDC.Canvas do begin // draw component frame Pen.Width := 1; IconRect := Rect(ItemLeft, ItemTop, ItemRight, ItemBottom); Frame3D(IconRect, 1, bvRaised); Brush.Color := clBtnFace; FillRect(IconRect); if NonVisualCompBorder > 1 then InflateRect(IconRect, -NonVisualCompBorder + 1, -NonVisualCompBorder + 1); end; // draw component Name if ShowComponentCaptions and (((GetKeyState(VK_LBUTTON) and $80) = 0) or not IsSelected) then begin TextSize := aDDC.Canvas.TextExtent(AComponent.Name); TextRect.Left := (IconRect.Left + IconRect.Right - TextSize.cx) div 2; TextRect.Top := IconRect.Bottom + NonVisualCompBorder + 2; TextRect.Right := TextRect.Left + TextSize.cx; TextRect.Bottom := TextRect.Top + TextSize.cy; aDDC.Canvas.FillRect(TextRect); DrawText(aDDC.Canvas.Handle, PChar(AComponent.Name), -1, TextRect, DT_CENTER or DT_VCENTER or DT_SINGLELINE or DT_NOCLIP); end; // draw component icon if Assigned(FOnGetNonVisualCompIcon) then begin Icon := nil; FOnGetNonVisualCompIcon(Self, AComponent, Icon); if Icon <> nil then begin inc(IconRect.Left, (NonVisualCompIconWidth - Icon.Width) div 2); inc(IconRect.Top, (NonVisualCompIconWidth - Icon.Height) div 2); IconRect.Right := IconRect.Left + Icon.Width; IconRect.Bottom := IconRect.Top + Icon.Height; aDDC.Canvas.StretchDraw(IconRect, Icon); end; end; if (ControlSelection.Count > 1) and IsSelected then ControlSelection.DrawMarkerAt(aDDC, ItemLeft, ItemTop, NonVisualCompWidth, NonVisualCompWidth); aDDC.Restore; end; end; 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); DoPaintDesignerItems; 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 CompareRect(@NewFormBounds,@FLastFormBounds)) and (not CompareRect(@NewFormBounds,@FDefaultFormBounds)) then begin //debugln('TDesigner.CheckFormBounds'); Modified; if ControlSelection.SelectionForm=Form then begin ControlSelection.CheckForLCLChanges(true); end; end; end else begin FDefaultFormBoundsValid:=true; FDefaultFormBounds:=NewFormBounds; end; FLastFormBounds:=NewFormBounds; end; procedure TDesigner.DoPaintDesignerItems; begin // marker (multi selection markers) if (ControlSelection.SelectionForm = Form) and (ControlSelection.Count > 1) then begin ControlSelection.DrawMarkers(DDC); end; // non visual component icons DrawNonVisualComponents(DDC); // guidelines and grabbers if (ControlSelection.SelectionForm=Form) then begin if EnvironmentOptions.ShowGuideLines then ControlSelection.DrawGuideLines(DDC); ControlSelection.DrawGrabbers(DDC); end; // rubberband if ControlSelection.RubberBandActive and ((ControlSelection.SelectionForm = Form) or (ControlSelection.SelectionForm = nil)) then begin ControlSelection.DrawRubberBand(DDC); 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 (ControlSelection.Count<>1) or (ControlSelection.SelectionForm<>Form) or (not ControlSelection[0].IsTComponent) then exit; Result:= TheFormEditor.GetComponentEditor(TComponent(ControlSelection[0].Persistent)); end; procedure TDesigner.AddComponentEditorMenuItems( AComponentEditor: TBaseComponentEditor; ClearOldOnes: boolean); var VerbCount, i: integer; NewMenuCmd: TIDEMenuCommand; begin if (AComponentEditor=nil) or (DesignerMenuSectionComponentEditor=nil) then exit; if ClearOldOnes then DesignerMenuSectionComponentEditor.Clear; VerbCount:=AComponentEditor.GetVerbCount; for i:=0 to VerbCount-1 do begin NewMenuCmd:=RegisterIDEMenuCommand(DesignerMenuSectionComponentEditor, 'ComponentEditorVerMenuItem'+IntToStr(i), AComponentEditor.GetVerb(i), @OnComponentEditorVerbMenuItemClick); if NewMenuCmd.MenuItem<>nil then AComponentEditor.PrepareItem(i,NewMenuCmd.MenuItem); end; end; function TDesigner.NonVisualComponentAtPos(x,y: integer): TComponent; var i: integer; LeftTop: TPoint; begin for i:=FLookupRoot.ComponentCount-1 downto 0 do begin Result:=FLookupRoot.Components[i]; if (not (Result is TControl)) and (not ComponentIsInvisible(Result)) then begin with Result do begin LeftTop:=NonVisualComponentLeftTop(Result); if (LeftTop.x<=x) and (LeftTop.y<=y) and (LeftTop.x+NonVisualCompWidth>x) and (LeftTop.y+NonVisualCompWidth>y) then exit; end; end; end; Result:=nil; end; procedure TDesigner.MoveNonVisualComponentIntoForm(AComponent: TComponent); begin with NonVisualComponentLeftTop(AComponent) do AComponent.DesignInfo := DesignInfoFrom(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 (not (AComponent is TControl)) and (not ComponentIsInvisible(AComponent)) then begin MoveNonVisualComponentIntoForm(AComponent); end; end; end; function TDesigner.ComponentClassAtPos(const AClass: TComponentClass; const APos: TPoint; const UseRootAsDefault, IgnoreHidden: boolean): TComponent; function DoComponent: TComponent; var i: integer; Bounds: TRect; begin for i := FLookupRoot.ComponentCount - 1 downto 0 do begin Result := FLookupRoot.Components[i]; // bit tricky, but we set it to nil anyhow if not Result.InheritsFrom(AClass) then Continue; if Result is TControl then begin if IgnoreHidden and (not ControlIsInDesignerVisible(TControl(Result))) then Continue; if csNoDesignSelectable in TControl(Result).ControlStyle then continue; end; Bounds := GetParentFormRelativeBounds(Result); if PtInRect(Bounds, APos) then Exit; end; Result := nil; end; function DoWinControl: TComponent; var i: integer; Bounds: TRect; Control: TControl; WinControl: TWinControl; begin Result := nil; if not (FLookupRoot is TWinControl) then exit; WinControl := TWinControl(FLookupRoot); i := WinControl.ControlCount; while i > 0 do begin Dec(i); Control := WinControl.Controls[i]; if IgnoreHidden and (csNoDesignVisible in Control.ControlStyle) then Continue; if csNoDesignSelectable in Control.ControlStyle then continue; Bounds := GetParentFormRelativeBounds(Control); if not PtInRect(Bounds, APos) then Continue; if Control.InheritsFrom(AClass) then Result := Control; // at least this is a match, now look if a child matches if Control is TWinControl then begin Wincontrol := TWinControl(Control); i := WinControl.ControlCount; Continue; // next loop end; // Control has no children and a result found, no need to look further if Result <> nil then Exit; end; end; begin // If LookupRoot is TWincontol, use the control list. It is ordered by zorder // We cannot use the components in that case since they are at place order if FLookupRoot is TWinControl then Result := DoWinControl else Result := DoComponent; if (Result = nil) and UseRootAsDefault and (FLookupRoot.InheritsFrom(AClass)) then Result := LookupRoot; 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 DesignerPopupMenu = nil then begin DesignerPopupMenu:=TPopupMenu.Create(nil); with DesignerPopupMenu 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} DesignerPopupMenu.Items.WriteDebugReport('TSourceNotebook.BuildPopupMenu '); DesignerMenuRoot.ConsistencyCheck; {$ENDIF} DesignerMenuRoot.MenuItem := DesignerPopupMenu.Items; DesignerMenuAlign.OnClick := @OnAlignPopupMenuClick; DesignerMenuMirrorHorizontal.OnClick := @OnMirrorHorizontalPopupMenuClick; DesignerMenuMirrorVertical.OnClick := @OnMirrorVerticalPopupMenuClick; DesignerMenuScale.OnClick := @OnScalePopupMenuClick; DesignerMenuSize.OnClick := @OnSizePopupMenuClick; DesignerMenuTabOrder.OnClick:=@OnTabOrderMenuClick; DesignerMenuOrderMoveToFront.OnClick := @OnOrderMoveToFrontMenuClick; DesignerMenuOrderMoveToFront.MenuItem.ShortCut := EditorOpts.KeyMap.CommandToShortCut(ecDesignerMoveToFront); DesignerMenuOrderMoveToBack.OnClick := @OnOrderMoveToBackMenuClick; DesignerMenuOrderMoveToBack.MenuItem.ShortCut := EditorOpts.KeyMap.CommandToShortCut(ecDesignerMoveToBack); DesignerMenuOrderForwardOne.OnClick := @OnOrderForwardOneMenuClick; DesignerMenuOrderForwardOne.MenuItem.ShortCut := EditorOpts.KeyMap.CommandToShortCut(ecDesignerForwardOne); DesignerMenuOrderBackOne.OnClick := @OnOrderBackOneMenuClick; DesignerMenuOrderBackOne.MenuItem.ShortCut := EditorOpts.KeyMap.CommandToShortCut(ecDesignerBackOne); DesignerMenuCut.OnClick:=@OnCutMenuClick; DesignerMenuCopy.OnClick:=@OnCopyMenuClick; DesignerMenuPaste.OnClick:=@OnPasteMenuClick; DesignerMenuDeleteSelection.OnClick:=@OnDeleteSelectionMenuClick; DesignerMenuSelectAll.OnClick:=@OnSelectAllMenuClick; DesignerMenuChangeClass.OnClick:=@OnChangeClassMenuClick; DesignerMenuViewLFM.OnClick:=@OnViewLFMMenuClick; DesignerMenuSaveAsXML.OnClick:=@OnSaveAsXMLMenuClick; DesignerMenuSnapToGridOption.OnClick:=@OnSnapToGridOptionMenuClick; DesignerMenuSnapToGridOption.ShowAlwaysCheckable:=true; DesignerMenuSnapToGuideLinesOption.OnClick:=@OnSnapToGuideLinesOptionMenuClick; DesignerMenuSnapToGuideLinesOption.ShowAlwaysCheckable:=true; DesignerMenuShowOptions.OnClick:=@OnShowOptionsMenuItemClick; end; procedure TDesigner.DesignerPopupMenuPopup(Sender: TObject); var ControlSelIsNotEmpty, LookupRootIsSelected, OnlyNonVisualsAreSelected, CompsAreSelected: boolean; MultiCompsAreSelected: boolean; OneControlSelected: Boolean; SelectionVisible: Boolean; procedure UpdateChangeParentMenu; var Candidates: TFPList; i: Integer; Candidate: TWinControl; j: Integer; CurSelected: TSelectedControl; Item: TIDEMenuItem; begin Candidates:=TFPList.Create; if ControlSelIsNotEmpty and (not OnlyNonVisualsAreSelected) and (not LookupRootIsSelected) and (LookupRoot is TWinControl) then begin for i := 0 to LookupRoot.ComponentCount - 1 do begin if not (LookupRoot.Components[i] is TWinControl) then continue; Candidate:=TWinControl(LookupRoot.Components[i]); if not (csAcceptsControls in Candidate.ControlStyle) then continue; j:=ControlSelection.Count-1; while j>=0 do begin CurSelected:=ControlSelection[j]; if CurSelected.IsTControl then begin if CurSelected.Persistent=Candidate then break; if CurSelected.IsTWinControl and TWinControl(CurSelected.Persistent).IsParentOf(Candidate) then break; end; dec(j); end; if j<0 then Candidates.Add(Candidate); end; Candidates.Add(LookupRoot); end; DesignerMenuChangeParent.Visible:=Candidates.Count>0; DesignerMenuChangeParent.Clear; for i:=0 to Candidates.Count-1 do begin Item:=TIDEMenuCommand.Create(DesignerMenuChangeParent.Name+'_'+IntToStr(i)); DesignerMenuChangeParent.AddLast(Item); Item.Caption:=TWinControl(Candidates[i]).Name; Item.OnClick:=@OnChangeParentMenuClick; end; Candidates.Free; end; begin ControlSelIsNotEmpty:=(ControlSelection.Count>0) and (ControlSelection.SelectionForm=Form); LookupRootIsSelected:=ControlSelection.LookupRootSelected; OnlyNonVisualsAreSelected := ControlSelection.OnlyNonVisualPersistentsSelected; SelectionVisible:=not ControlSelection.OnlyInvisiblePersistentsSelected; CompsAreSelected:=ControlSelIsNotEmpty and SelectionVisible and not LookupRootIsSelected; OneControlSelected := ControlSelIsNotEmpty and ControlSelection[0].IsTControl; MultiCompsAreSelected := CompsAreSelected and (ControlSelection.Count>1); 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; DesignerMenuTabOrder.Enabled := (FLookupRoot is TWinControl) and (TWinControl(FLookupRoot).ControlCount > 0); 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; DesignerMenuCut.Enabled := CompsAreSelected; DesignerMenuCopy.Enabled := CompsAreSelected; DesignerMenuPaste.Enabled := CanPaste; DesignerMenuDeleteSelection.Enabled := CompsAreSelected; DesignerMenuChangeClass.Enabled := CompsAreSelected and (ControlSelection.Count = 1); UpdateChangeParentMenu; DesignerMenuSnapToGridOption.Checked := EnvironmentOptions.SnapToGrid; DesignerMenuSnapToGuideLinesOption.Checked := EnvironmentOptions.SnapToGuideLines; end; procedure TDesigner.OnAlignPopupMenuClick(Sender: TObject); var HorizAlignment, VertAlignment: TComponentAlignment; HorizAlignID, VertAlignID: integer; begin if ShowAlignComponentsDialog(HorizAlignID,VertAlignID)=mrOk then begin case HorizAlignID of 0: HorizAlignment:=csaNone; 1: HorizAlignment:=csaSides1; 2: HorizAlignment:=csaCenters; 3: HorizAlignment:=csaSides2; 4: HorizAlignment:=csaCenterInWindow; 5: HorizAlignment:=csaSpaceEqually; 6: HorizAlignment:=csaSide1SpaceEqually; 7: HorizAlignment:=csaSide2SpaceEqually; end; case VertAlignID of 0: VertAlignment:=csaNone; 1: VertAlignment:=csaSides1; 2: VertAlignment:=csaCenters; 3: VertAlignment:=csaSides2; 4: VertAlignment:=csaCenterInWindow; 5: VertAlignment:=csaSpaceEqually; 6: VertAlignment:=csaSide1SpaceEqually; 7: VertAlignment:=csaSide2SpaceEqually; end; ControlSelection.AlignComponents(HorizAlignment,VertAlignment); Modified; end; end; procedure TDesigner.OnMirrorHorizontalPopupMenuClick(Sender: TObject); begin ControlSelection.MirrorHorizontal; Modified; end; procedure TDesigner.OnMirrorVerticalPopupMenuClick(Sender: TObject); begin ControlSelection.MirrorVertical; Modified; end; procedure TDesigner.OnScalePopupMenuClick(Sender: TObject); var ScaleInPercent: integer; begin if ShowScaleComponentsDialog(ScaleInPercent)=mrOk then begin ControlSelection.ScaleComponents(ScaleInPercent); Modified; end; end; procedure TDesigner.OnSizePopupMenuClick(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 0: HorizSizing:=cssNone; 1: HorizSizing:=cssShrinkToSmallest; 2: HorizSizing:=cssGrowToLargest; 3: HorizSizing:=cssFixed; end; case VertSizingID of 0: VertSizing:=cssNone; 1: VertSizing:=cssShrinkToSmallest; 2: VertSizing:=cssGrowToLargest; 3: VertSizing:=cssFixed; end; ControlSelection.SizeComponents(HorizSizing,AWidth,VertSizing,AHeight); Modified; end; end; procedure TDesigner.OnOrderMoveToFrontMenuClick(Sender: TObject); begin DoOrderMoveSelectionToFront; end; procedure TDesigner.OnOrderMoveToBackMenuClick(Sender: TObject); begin DoOrderMoveSelectionToBack; end; procedure TDesigner.OnOrderForwardOneMenuClick(Sender: TObject); begin DoOrderForwardSelectionOne; end; procedure TDesigner.OnOrderBackOneMenuClick(Sender: TObject); begin DoOrderBackSelectionOne; end; Procedure TDesigner.HintTimer(Sender: TObject); var Rect : TRect; AHint : String; AControl : TControl; Position, ClientPos : TPoint; AWinControl: TWinControl; AComponent: TComponent; begin FHintTimer.Enabled := False; if [dfShowEditorHints]*FFlags=[] then exit; Position := Mouse.CursorPos; AWinControl := FindLCLWindow(Position); if not (Assigned(AWinControl)) then Exit; if GetDesignerForm(AWinControl)<>Form then exit; // first search a non visual component at the position ClientPos:=Form.ScreenToClient(Position); AComponent:=NonVisualComponentAtPos(ClientPos.X,ClientPos.Y); if AComponent=nil then begin // then search a control at the position AComponent := ComponentAtPos(ClientPos.X,ClientPos.Y,true,true); if not Assigned(AComponent) then AComponent := AWinControl; end; AComponent:=GetDesignedComponent(AComponent); if AComponent=nil then exit; // create a nice hint: // component position if (dfShowEditorHints in FFlags) then begin // component name and classname AHint := AComponent.Name+': '+AComponent.ClassName+#10; if AComponent is TControl then begin AControl:=TControl(AComponent); AHint := AHint + 'Left: '+IntToStr(AControl.Left) + ' Top: '+IntToStr(AControl.Top) + #10+ 'Width: '+IntToStr(AControl.Width) + ' Height: '+IntToStr(AControl.Height); end else begin AHint := AHint + 'Left: '+IntToStr(GetComponentLeft(AComponent)) + ' Top: '+IntToStr(GetComponentTop(AComponent)); end; end; Rect := FHintWindow.CalcHintRect(0,AHint,nil); //no maxwidth Rect.Left := Position.X+10; Rect.Top := Position.Y+5; 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; EnvironmentOptions.SnapToGrid:=AValue; end; function TDesigner.OnFormActivated: boolean; begin //the form was activated. if Assigned(FOnActivated) then FOnActivated(Self); Result:=true; end; function TDesigner.OnFormCloseQuery: boolean; begin if Assigned(FOnCloseQuery) then FOnCloseQuery(Self); Result:=true; end; function TDesigner.GetPropertyEditorHook: TPropertyEditorHook; begin Result:=TheFormEditor.PropertyEditorHook; end; end.