View Issue Details

IDProjectCategoryView StatusLast Update
0017203LazarusIDEpublic2010-11-23 19:39
ReporterFabio Luis GirardiAssigned ToPaul Ishenin 
PrioritynormalSeverityfeatureReproducibilityN/A
Status closedResolutionfixed 
Platformx64OSLinuxOS Version2.6
Product VersionProduct Build0.9.29 rev 27083 
Target Version0.9.30Fixed in Version0.9.29 (SVN) 
Summary0017203: Patch to customize hints at design time
DescriptionHere is a small patch to customize component hints at design time.

Copied (and modified) from the list:

On my project, I link windows controls (edits, labels and others) with
variables stored in others devices (like temperature, pressure and others sensors). So I want add in hint the device variable that is linked with the control. The developer will only move the mouse over the control to see the linked variable (and others informations) and not select it to see in object inspector what's the variable. I think that the process "click to see" is a little disagreeable when you have a lot of controls and components
TagsNo tags attached.
Fixed in Revision28336
LazTarget0.9.30
WidgetsetGTK, GTK 2, Win32/Win64, WinCE, Carbon, QT, fpGUI
Attached Files
  • ComponentEditors.pas (38,295 bytes)
    {
     *****************************************************************************
     *                                                                           *
     *  See the file COPYING.modifiedLGPL.txt, included in this distribution,    *
     *  for details about the copyright.                                         *
     *                                                                           *
     *  This program 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.                     *
     *                                                                           *
     *****************************************************************************
    
      Author: Mattias Gaertner
    
      Abstract:
        This units defines the component editors used by the designer.
        A Component Editor is a plugin used by the designer to add special
        functions for component classes.
        For more information see the big comment part below.
    }
    unit ComponentEditors;
    
    {$mode objfpc}{$H+}
    
    interface
    
    uses
      Classes, SysUtils, LResources, TypInfo, LCLProc, Forms, Controls, Menus,
      ExtCtrls, CustomTimer, StdCtrls, Graphics, Grids, CheckLst, Buttons, ComCtrls, Dialogs,
      LazStringGridEdit, CheckListboxEditorDlg, CheckGroupEditorDlg, GraphType,
      PropEdits, PropEditUtils,
      ObjInspStrConsts;
    
    type
      { TComponentEditorDesigner }
      
      TComponentPasteSelectionFlag = (
        cpsfReplace,
        cpsfFindUniquePositions
        );
      TComponentPasteSelectionFlags = set of TComponentPasteSelectionFlag;
      TComponentEditorDesignerHookType = (
        cedhtModified
        );
    
      TComponentEditorDesigner = class(TIDesigner)
      private
        FChangeStamp: int64;
      protected
        FForm: TCustomForm;
        FHandlers: array[TComponentEditorDesignerHookType] of TMethodList;
        function GetPropertyEditorHook: TPropertyEditorHook; virtual; abstract;
        function GetHandlerCount(HookType: TComponentEditorDesignerHookType): integer;
        procedure AddHandler(HookType: TComponentEditorDesignerHookType; const Handler: TMethod);
        procedure RemoveHandler(HookType: TComponentEditorDesignerHookType; const Handler: TMethod);
      public
        destructor Destroy; override;
        procedure Modified; override;
        function CopySelection: boolean; virtual; abstract;
        function CutSelection: boolean; virtual; abstract;
        function CanPaste: boolean; virtual; abstract;
        function PasteSelection(Flags: TComponentPasteSelectionFlags): boolean; virtual; abstract;
        function DeleteSelection: boolean; virtual; abstract;
        function CopySelectionToStream(s: TStream): boolean; virtual; abstract;
        function InsertFromStream(s: TStream; Parent: TWinControl;
                                  Flags: TComponentPasteSelectionFlags
                                  ): Boolean; virtual; abstract;
        function InvokeComponentEditor(AComponent: TComponent;
                                       MenuIndex: integer): boolean; virtual; abstract;
    
        procedure DrawDesignerItems(OnlyIfNeeded: boolean); virtual; abstract;
        function CreateUniqueComponentName(const AClassName: string
                                           ): string; virtual; abstract;
        property PropertyEditorHook: TPropertyEditorHook read GetPropertyEditorHook;
        property Form: TCustomForm read FForm;
        property ChangeStamp: int64 read FChangeStamp;// increased on calling Modified
      public
        // Handlers
        procedure RemoveAllHandlersForObject(const HandlerObject: TObject);
        procedure AddHandlerModified(const OnModified: TNotifyEvent);
        procedure RemoveHandlerModified(const OnModified: TNotifyEvent);
      end;
    
    
    { Component Editor Types }
    
    type
    
    { TComponentEditor
      A component editor is created for each component that is selected in the
      form designer based on the component's type (see GetComponentEditor and
      RegisterComponentEditor). When the component is double-clicked the Edit
      method is called. When the context menu for the component is invoked the
      GetVerbCount and GetVerb methods are called to build the menu. If one
      of the verbs are selected, ExecuteVerb is called. Paste is called whenever
      the component is pasted to the clipboard. You only need to create a
      component editor if you wish to add verbs to the context menu, change
      the default double-click behavior, or paste an additional clipboard format.
      The default component editor (TDefaultEditor) implements Edit to searches the
      properties of the component and generates (or navigates to) the OnCreate,
      OnChanged, or OnClick event (whichever it finds first). Whenever the
      component editor modifies the component, it *must* call Designer.Modified to
      inform the designer that the form has been modified. (Or else the user can not
      save the changes).
    
        Edit
          Called when the user double-clicks the component. The component editor can
          bring up a dialog in response to this method, for example, or some kind
          of design expert. If GetVerbCount is greater than zero, edit will execute
          the first verb in the list (ExecuteVerb(0)).
    
        ExecuteVerb(Index)
          The Index'ed verb was selected by the use off the context menu. The
          meaning of this is determined by component editor.
    
        GetVerb
          The component editor should return a string that will be displayed in the
          context menu. It is the responsibility of the component editor to place
          the & character and the '...' characters as appropriate.
    
        GetVerbCount
          The number of valid indices to GetVerb and Execute verb. The index is
          assumed to be zero based (i.e. 0..GetVerbCount - 1).
    
        PrepareItem
          While constructing the context menu PrepareItem will be called for
          each verb. It will be passed the menu item that will be used to represent
          the verb. The component editor can customize the menu item as it sees fit,
          including adding subitems. If you don't want that particular menu item
          to be shown, don't free it, simply set its Visible property to False.
    
        Copy
          Called when the component is being copied to the clipboard. The
          component's filed image is already on the clipboard. This gives the
          component editor a chance to paste a different type of format which is
          ignored by the designer but might be recognized by another application.
    
        IsInInlined
          Determines whether Component is in the Designer which owns it.
          Essentially, Components should not be able to be added to a Frame
          instance (collections are fine though) so this function checks to
          determine whether the currently selected component is within a Frame
          instance or not.
    
        GetComponent
          Returns the edited component.
    
        GetDesigner
          Returns the current Designer for the form owning the component.
        }
    
    { TComponentEditor
      All component editors are assumed derived from TBaseComponentEditor.
    
        Create(AComponent, ADesigner)
          Called to create the component editor. AComponent is the component to
          be edited by the editor. ADesigner is an interface to the designer to
          find controls and create methods (this is not used often). If a component
          editor modifies the component in any way it *must* call
          ADesigner.Modified. }
    
      TBaseComponentEditor = class
      protected
      public
        constructor Create(AComponent: TComponent;
          ADesigner: TComponentEditorDesigner); virtual;
        procedure Edit; virtual; abstract;
        procedure ExecuteVerb(Index: Integer); virtual; abstract;
        function GetVerb(Index: Integer): string; virtual; abstract;
        function GetVerbCount: Integer; virtual; abstract;
        procedure PrepareItem(Index: Integer; const AnItem: TMenuItem); virtual; abstract;
        procedure Copy; virtual; abstract;
        function IsInInlined: Boolean; virtual; abstract;
        function GetComponent: TComponent; virtual; abstract;
        function GetDesigner: TComponentEditorDesigner; virtual; abstract;
        function GetHook(out Hook: TPropertyEditorHook): boolean; virtual; abstract;
        function GetCustomHint:String; virtual; abstract;
        procedure Modified; virtual; abstract;
      end;
    
      TComponentEditorClass = class of TBaseComponentEditor;
    
    
    { TComponentEditor
      This class provides a default implementation for the IComponentEditor
      interface. There is no assumption by the designer that you use this class
      only that your class derive from TBaseComponentEditor and implement
      IComponentEditor. This class is provided to help you implement a class
      that meets those requirements. }
      TComponentEditor = class(TBaseComponentEditor)
      private
        FComponent: TComponent;
        FDesigner: TComponentEditorDesigner;
      public
        constructor Create(AComponent: TComponent;
          ADesigner: TComponentEditorDesigner); override;
        procedure Edit; override;
        procedure ExecuteVerb(Index: Integer); override;
        function GetComponent: TComponent; override;
        function GetDesigner: TComponentEditorDesigner; override;
        function GetVerb(Index: Integer): string; override;
        function GetVerbCount: Integer; override;
        function IsInInlined: Boolean; override;
        procedure Copy; override;
        procedure PrepareItem(Index: Integer; const AnItem: TMenuItem); override;
        property Component: TComponent read FComponent;
        property Designer: TComponentEditorDesigner read GetDesigner;
        function GetHook(out Hook: TPropertyEditorHook): boolean; override;
        function GetCustomHint: String; override;
        function HasHook: boolean;
        procedure Modified; override;
      end;
    
    
    { TDefaultComponentEditor
      An editor that provides default behavior for the double-click that will
      iterate through the properties looking for the most appropriate method
      property to edit }
      TDefaultComponentEditor = class(TComponentEditor)
      private
        FBestEditEvent: string;
        FFirst: TPropertyEditor;
        FBest: TPropertyEditor;
        FContinue: Boolean;
        FPropEditCandidates: TList; // list of TPropertyEditor
        procedure CheckEdit(Prop: TPropertyEditor);
      protected
        procedure EditProperty(const Prop: TPropertyEditor;
          var Continue: Boolean); virtual;
        procedure ClearPropEditorCandidates;
      public
        constructor Create(AComponent: TComponent;
          ADesigner: TComponentEditorDesigner); override;
        destructor Destroy; override;
        procedure Edit; override;
        function GetVerbCount: Integer; override;
        function GetVerb(Index: Integer): string; override;
        procedure ExecuteVerb(Index: Integer); override;
        property BestEditEvent: string read FBestEditEvent write FBestEditEvent;
      end;
               
      // to be "compatible" with delphi i've added the next line.
      // we're not 100% the same, but it might help some ppl.
      TDefaultEditor = TDefaultComponentEditor;
      
    { TNotebookComponentEditor
      The default component editor for TCustomNotebook. }
      TNotebookComponentEditor = class(TDefaultComponentEditor)
      protected
        procedure AddNewPageToDesigner(Index: integer); virtual;
        procedure DoAddPage; virtual;
        procedure DoInsertPage; virtual;
        procedure DoDeletePage; virtual;
        procedure DoMoveActivePageLeft; virtual;
        procedure DoMoveActivePageRight; virtual;
        procedure DoMovePage(CurIndex, NewIndex: Integer); virtual;
        procedure AddMenuItemsForPages(ParentMenuItem: TMenuItem); virtual;
        procedure ShowPageMenuItemClick(Sender: TObject);
      public
        procedure ExecuteVerb(Index: Integer); override;
        function GetVerb(Index: Integer): string; override;
        function GetVerbCount: Integer; override;
        procedure PrepareItem(Index: Integer; const AnItem: TMenuItem); override;
        function Notebook: TCustomNotebook; virtual;
      end;
      
      
    { TPageComponentEditor
      The default component editor for TCustomPage. }
      TPageComponentEditor = class(TNotebookComponentEditor)
      protected
      public
        function Notebook: TCustomNotebook; override;
        function Page: TCustomPage; virtual;
      end;
    
    
    { TTabControlComponentEditor
      The default component editor for TCustomTabControl. }
      TTabControlComponentEditor = class(TDefaultComponentEditor)
      protected
        procedure DoAddTab; virtual;
        procedure DoInsertTab; virtual;
        procedure DoDeleteTab; virtual;
        procedure DoMoveActiveTabLeft; virtual;
        procedure DoMoveActiveTabRight; virtual;
        procedure DoMoveTab(CurIndex, NewIndex: Integer); virtual;
        procedure AddMenuItemsForTabs(ParentMenuItem: TMenuItem); virtual;
        procedure ShowTabMenuItemClick(Sender: TObject);
        function CreateNewTabCaption: string;
      public
        procedure ExecuteVerb(Index: Integer); override;
        function GetVerb(Index: Integer): string; override;
        function GetVerbCount: Integer; override;
        procedure PrepareItem(Index: Integer; const AnItem: TMenuItem); override;
        function TabControl: TCustomTabControl; virtual;
      end;
    
    
    { TStringGridComponentEditor
      The default componenteditor for TStringGrid }
    
      TStringGridComponentEditor = class(TComponentEditor)
      public
        procedure ExecuteVerb(Index: Integer); override;
        function GetVerb(Index: Integer): string; override;
        function GetVerbCount: Integer; override;
      end;
    
    { TCheckListBoxComponentEditor
      The default componenteditor for TCheckListBox }
    
      TCheckListBoxComponentEditor = class(TComponentEditor)
      protected
        procedure DoShowEditor;
      public
        procedure ExecuteVerb(Index: Integer); override;
        function GetVerb(Index: Integer): string; override;
        function GetVerbCount: Integer; override;
      end;
    
    
    { TCheckGroupComponentEditor
      The default componenteditor for TCheckGroup }
    
      TCheckGroupComponentEditor = class(TDefaultComponentEditor)
      protected
        procedure DoShowEditor;
      public
        procedure ExecuteVerb(Index: Integer); override;
        function GetVerb(Index: Integer): string; override;
        function GetVerbCount: Integer; override;
      end;
    
    
    { TToolBarComponentEditor
      The default componenteditor for TToolBar }
    
      TToolBarComponentEditor = class(TDefaultComponentEditor)
      protected
      public
        procedure ExecuteVerb(Index: Integer); override;
        function GetVerb(Index: Integer): string; override;
        function GetVerbCount: Integer; override;
        function ToolBar: TToolBar; virtual;
      end;
    
    
    { TFileDialogComponentEditor
      The default componenteditor for TFileDialog }
    
      TCommonDialogComponentEditor = class(TComponentEditor)
      private
        procedure TestDialog;
      public
        function GetVerbCount:integer;override;
        function GetVerb(Index:integer):string;override;
        procedure ExecuteVerb(Index:integer);override;
      end;
    
      { TTimerComponentEditor }
    
      TTimerComponentEditor = class(TDefaultComponentEditor)
      public
        constructor Create(AComponent: TComponent;
          ADesigner: TComponentEditorDesigner); override;
      end;
      
    
    { Register a component editor }
    type
      TRegisterComponentEditorProc =
        procedure (ComponentClass: TComponentClass;
                   ComponentEditor: TComponentEditorClass);
    
    var
      RegisterComponentEditorProc: TRegisterComponentEditorProc;
    
    
    procedure RegisterComponentEditor(ComponentClass: TComponentClass;
      ComponentEditor: TComponentEditorClass);
    function GetComponentEditor(Component: TComponent;
      const Designer: TComponentEditorDesigner): TBaseComponentEditor;
    
    type
      TPropertyEditorFilterFunc =
        function(const ATestEditor: TPropertyEditor): Boolean of object;
    
    
    implementation
    
    { RegisterComponentEditor }
    type
      PComponentClassRec = ^TComponentClassRec;
      TComponentClassRec = record
        Group: Integer;
        ComponentClass: TComponentClass;
        EditorClass: TComponentEditorClass;
      end;
    
    const
      ComponentClassList: TList = nil;
    
    procedure DefaultRegisterComponentEditorProc(ComponentClass: TComponentClass;
      ComponentEditor: TComponentEditorClass);
    var
      P: PComponentClassRec;
    begin
      if ComponentClassList = nil then
        ComponentClassList := TList.Create;
      New(P);
      P^.Group := -1;//CurrentGroup;
      P^.ComponentClass := ComponentClass;
      P^.EditorClass := ComponentEditor;
      ComponentClassList.Insert(0, P);
    end;
    
    procedure RegisterComponentEditor(ComponentClass: TComponentClass;
      ComponentEditor: TComponentEditorClass);
    begin
      if Assigned(RegisterComponentEditorProc) then
        RegisterComponentEditorProc(ComponentClass, ComponentEditor);
    end;
    
    function GetComponentEditor(Component: TComponent;
      const Designer: TComponentEditorDesigner): TBaseComponentEditor;
    var
      P: PComponentClassRec;
      I: Integer;
      ComponentClass: TComponentClass;
      EditorClass: TComponentEditorClass;
    begin
      ComponentClass := TComponentClass(TPersistent);
      EditorClass := TDefaultComponentEditor;
      if ComponentClassList <> nil then
        for I := 0 to ComponentClassList.Count-1 do
        begin
          P := PComponentClassRec(ComponentClassList[I]);
          //DebugLn('GetComponentEditor Component=',dbgsName(Component),' ',dbgsName(P^.ComponentClass),' ',dbgsName(P^.EditorClass));
          if (Component is P^.ComponentClass) and
            (P^.ComponentClass <> ComponentClass) and
            (P^.ComponentClass.InheritsFrom(ComponentClass)) then
          begin
            EditorClass := P^.EditorClass;
            ComponentClass := P^.ComponentClass;
          end;
        end;
      Result := EditorClass.Create(Component, Designer);
    end;
    
    { Component Editors -----------------------------------------------------------}
    
    
    { TBaseComponentEditor }
    
    constructor TBaseComponentEditor.Create(AComponent: TComponent;
      ADesigner: TComponentEditorDesigner);
    begin
      inherited Create;
    end;
    
    { TComponentEditor }
    
    constructor TComponentEditor.Create(AComponent: TComponent;
      ADesigner: TComponentEditorDesigner);
    begin
      inherited Create(AComponent, ADesigner);
      FComponent := AComponent;
      FDesigner := ADesigner;
    end;
    
    procedure TComponentEditor.Edit;
    begin
      if GetVerbCount > 0 then ExecuteVerb(0);
    end;
    
    function TComponentEditor.GetComponent: TComponent;
    begin
      Result := FComponent;
    end;
    
    function TComponentEditor.GetDesigner: TComponentEditorDesigner;
    begin
      Result := FDesigner;
    end;
    
    function TComponentEditor.GetVerbCount: Integer;
    begin
      // Intended for descendents to implement
      Result := 0;
    end;
    
    function TComponentEditor.GetVerb(Index: Integer): string;
    begin
      // Intended for descendents to implement
      Result:=ClassName+IntToStr(Index);
    end;
    
    procedure TComponentEditor.ExecuteVerb(Index: Integer);
    begin
      // Intended for descendents to implement
      DebugLn(Classname+'.ExecuteVerb: ',IntToStr(Index));
    end;
    
    procedure TComponentEditor.Copy;
    begin
      // Intended for descendents to implement
    end;
    
    function TComponentEditor.IsInInlined: Boolean;
    begin
      Result := csInline in Component.Owner.ComponentState;
    end;
    
    procedure TComponentEditor.PrepareItem(Index: Integer;
      const AnItem: TMenuItem);
    begin
      // Intended for descendents to implement
    end;
    
    function TComponentEditor.GetHook(out Hook: TPropertyEditorHook): boolean;
    begin
      Result:=false;
      Hook:=nil;
      if GetDesigner=nil then exit;
      Hook:=GetDesigner.PropertyEditorHook;
      Result:=Hook<>nil;
    end;
    
    function TComponentEditor.GetCustomHint: String;
    begin
      Result:=LineEnding;
    end;
    
    function TComponentEditor.HasHook: boolean;
    var
      Hook: TPropertyEditorHook;
    begin
      Result:=GetHook(Hook) and (Hook<>nil);
    end;
    
    procedure TComponentEditor.Modified;
    begin
      GetDesigner.Modified;
    end;
    
    { TDefaultComponentEditor }
    
    procedure TDefaultComponentEditor.CheckEdit(Prop: TPropertyEditor);
    begin
      if FContinue then
        EditProperty(Prop, FContinue);
      if FPropEditCandidates=nil then
        FPropEditCandidates:=TList.Create;
      FPropEditCandidates.Add(Prop);
    end;
    
    procedure TDefaultComponentEditor.EditProperty(const Prop: TPropertyEditor;
      var Continue: Boolean);
    var
      PropName: string;
      BestName: string;
    
      procedure ReplaceBest;
      begin
        FBest := Prop;
        if FFirst = FBest then
          FFirst := nil;
      end;
    
    begin
      if not Assigned(FFirst) and (Prop is TMethodPropertyEditor) then
        FFirst := Prop;
      PropName := Prop.GetName;
      BestName := '';
      if Assigned(FBest) then
        BestName := FBest.GetName;
      // event priority is hardcoded:
      // first priority has OnCreate, then OnClick and OnChange is the last
      if CompareText(PropName, FBestEditEvent) = 0 then
        ReplaceBest
      else
      if CompareText(BestName, FBestEditEvent) <> 0 then
        if CompareText(PropName, 'ONCHANGE') = 0 then
          ReplaceBest
        else
        if CompareText(BestName, 'ONCHANGE') <> 0 then
          if CompareText(PropName, 'ONCLICK') = 0 then
            ReplaceBest;
    end;
    
    procedure TDefaultComponentEditor.ClearPropEditorCandidates;
    var
      i: Integer;
    begin
      if FPropEditCandidates=nil then exit;
      for i:=0 to FPropEditCandidates.Count-1 do
        TObject(FPropEditCandidates[i]).Free;
      FPropEditCandidates.Free;
      FPropEditCandidates:=nil;
    end;
    
    constructor TDefaultComponentEditor.Create(AComponent: TComponent;
      ADesigner: TComponentEditorDesigner);
    begin
      inherited Create(AComponent, ADesigner);
      FBestEditEvent:='OnCreate';
    end;
    
    destructor TDefaultComponentEditor.Destroy;
    begin
      ClearPropEditorCandidates;
      inherited Destroy;
    end;
    
    procedure TDefaultComponentEditor.Edit;
    var
      PropertyEditorHook: TPropertyEditorHook;
      NewLookupRoot: TPersistent;
    begin
      PropertyEditorHook:=nil;
      if not GetHook(PropertyEditorHook) then exit;
      NewLookupRoot:=GetLookupRootForComponent(Component);
      if not (NewLookupRoot is TComponent) then exit;
      if NewLookupRoot<>PropertyEditorHook.LookupRoot then
        GetDesigner.SelectOnlyThisComponent(Component);
      FContinue := True;
      FFirst := nil;
      FBest := nil;
      try
        GetPersistentProperties(Component,tkAny,PropertyEditorHook,@CheckEdit,nil);
        if FContinue
        then begin
          if Assigned(FBest) then
            FBest.Edit
          else if Assigned(FFirst) then
            FFirst.Edit;
        end;
      finally
        FFirst := nil;
        FBest := nil;
        ClearPropEditorCandidates;
      end;
    end;
    
    function TDefaultComponentEditor.GetVerbCount: Integer;
    begin
      Result:=1;
    end;
    
    function TDefaultComponentEditor.GetVerb(Index: Integer): string;
    begin
      Result:=oisCreateDefaultEvent;
    end;
    
    procedure TDefaultComponentEditor.ExecuteVerb(Index: Integer);
    begin
      Edit;
    end;
    
    
    { TNotebookComponentEditor }
    
    const
      nbvAddPage       = 0;
      nbvInsertPage    = 1;
      nbvDeletePage    = 2;
      nbvMovePageLeft  = 3;
      nbvMovePageRight = 4;
      nbvShowPage      = 5;
    
    procedure TNotebookComponentEditor.ShowPageMenuItemClick(Sender: TObject);
    var
      AMenuItem: TMenuItem;
      NewPageIndex: integer;
    begin
      AMenuItem:=TMenuItem(Sender);
      if (AMenuItem=nil) or (not (AMenuItem is TMenuItem)) then exit;
      NewPageIndex:=AMenuItem.MenuIndex;
      if (NewPageIndex<0) or (NewPageIndex>=Notebook.PageCount) then exit;
      NoteBook.PageIndex:=NewPageIndex;
      GetDesigner.SelectOnlyThisComponent(NoteBook.CustomPage(NoteBook.PageIndex));
    end;
    
    procedure TNotebookComponentEditor.AddNewPageToDesigner(Index: integer);
    var
      Hook: TPropertyEditorHook;
      NewPage: TCustomPage;
      NewName: string;
    begin
      Hook:=nil;
      if not GetHook(Hook) then exit;
      NewPage:=NoteBook.CustomPage(Index);
      NewName:=GetDesigner.CreateUniqueComponentName(NewPage.ClassName);
      NewPage.Caption:=NewName;
      NewPage.Name:=NewName;
      NoteBook.PageIndex:=Index;
      Hook.PersistentAdded(NewPage,true);
      Modified;
    end;
    
    procedure TNotebookComponentEditor.DoAddPage;
    begin
      if not HasHook then exit;
      NoteBook.Pages.Add('');
      AddNewPageToDesigner(NoteBook.PageCount-1);
    end;
    
    procedure TNotebookComponentEditor.DoInsertPage;
    var
      NewIndex: integer;
    begin
      if not HasHook then exit;
      NewIndex:=Notebook.PageIndex;
      if NewIndex<0 then NewIndex:=0;
      Notebook.Pages.Insert(NewIndex,'');
      AddNewPageToDesigner(NewIndex);
    end;
    
    procedure TNotebookComponentEditor.DoDeletePage;
    var
      Hook: TPropertyEditorHook;
      OldIndex: integer;
      PageComponent: TPersistent;
    begin
      OldIndex:=Notebook.PageIndex;
      if (OldIndex>=0) and (OldIndex<Notebook.PageCount) then begin
        if not GetHook(Hook) then exit;
        PageComponent := TPersistent(NoteBook.Pages.Objects[OldIndex]);
        Hook.DeletePersistent(PageComponent);
      end;
    end;
    
    procedure TNotebookComponentEditor.DoMoveActivePageLeft;
    var
      Index: integer;
    begin
      Index:=NoteBook.PageIndex;
      if (Index<0) then exit;
      DoMovePage(Index,Index-1);
    end;
    
    procedure TNotebookComponentEditor.DoMoveActivePageRight;
    var
      Index: integer;
    begin
      Index:=NoteBook.PageIndex;
      if (Index>=0)
      and (Index>=NoteBook.PageCount-1) then exit;
      DoMovePage(Index,Index+1);
    end;
    
    procedure TNotebookComponentEditor.DoMovePage(
      CurIndex, NewIndex: Integer);
    begin
      NoteBook.Pages.Move(CurIndex,NewIndex);
      Modified;
    end;
    
    procedure TNotebookComponentEditor.AddMenuItemsForPages(
      ParentMenuItem: TMenuItem);
    var
      i: integer;
      NewMenuItem: TMenuItem;
    begin
      ParentMenuItem.Enabled:=NoteBook.PageCount>0;
      for i:=0 to NoteBook.PageCount-1 do begin
        NewMenuItem:=TMenuItem.Create(ParentMenuItem);
        NewMenuItem.Name:='ShowPage'+IntToStr(i);
        NewMenuItem.Caption:=Notebook.CustomPage(i).Name+' "'+Notebook.Pages[i]+'"';
        NewMenuItem.OnClick:=@ShowPageMenuItemClick;
        ParentMenuItem.Add(NewMenuItem);
      end;
    end;
    
    procedure TNotebookComponentEditor.ExecuteVerb(Index: Integer);
    begin
      case Index of
        nbvAddPage:       DoAddPage;
        nbvInsertPage:    DoInsertPage;
        nbvDeletePage:    DoDeletePage; // beware: this can free the editor itself
        nbvMovePageLeft:  DoMoveActivePageLeft;
        nbvMovePageRight: DoMoveActivePageRight;
      end;
    end;
    
    function TNotebookComponentEditor.GetVerb(Index: Integer): string;
    begin
      case Index of
        nbvAddPage:       Result:=nbcesAddPage;
        nbvInsertPage:    Result:=nbcesInsertPage;
        nbvDeletePage:    Result:=nbcesDeletePage;
        nbvMovePageLeft:  Result:=nbcesMovePageLeft;
        nbvMovePageRight: Result:=nbcesMovePageRight;
        nbvShowPage:      Result:=nbcesShowPage;
      else
        Result:='';
      end;
    end;
    
    function TNotebookComponentEditor.GetVerbCount: Integer;
    begin
      Result:=6;
    end;
    
    procedure TNotebookComponentEditor.PrepareItem(Index: Integer;
      const AnItem: TMenuItem);
    begin
      inherited PrepareItem(Index, AnItem);
      case Index of
        nbvAddPage:       ;
        nbvInsertPage:    AnItem.Enabled:=Notebook.PageIndex>=0;
        nbvDeletePage:    AnItem.Enabled:=Notebook.PageIndex>=0;
        nbvMovePageLeft:  AnItem.Enabled:=Notebook.PageIndex>0;
        nbvMovePageRight: AnItem.Enabled:=Notebook.PageIndex<Notebook.PageCount-1;
        nbvShowPage:      AddMenuItemsForPages(AnItem);
      end;
    end;
    
    function TNotebookComponentEditor.Notebook: TCustomNotebook;
    begin
      Result:=TCustomNotebook(GetComponent);
    end;
    
    { TPageComponentEditor }
    
    function TPageComponentEditor.Notebook: TCustomNotebook;
    var
      APage: TCustomPage;
    begin
      APage:=Page;
      if (APage.Parent<>nil) and (APage.Parent is TCustomNoteBook) then
        Result:=TCustomNoteBook(APage.Parent);
    end;
    
    function TPageComponentEditor.Page: TCustomPage;
    begin
      Result:=TCustomPage(GetComponent);
    end;
    
    
    function EditStringGrid(AStringGrid: TStringGrid): Boolean;
    var
      StringGridEditorDlg: TStringGridEditorDlg;
    begin
      StringGridEditorDlg := TStringGridEditorDlg.Create(Application);
      try
        StringGridEditorDlg.LoadFromGrid(AStringGrid);
        if StringGridEditorDlg.ShowModal = mrOk then
        begin
          StringGridEditorDlg.SaveToGrid;
        end;
        Result := StringGridEditorDlg.Modified;
      finally
        StringGridEditorDlg.Free;
      end;
    end;
    
    { TStringGridComponentEditor }
    
    procedure TStringGridComponentEditor.ExecuteVerb(Index: Integer);
    var
      Hook: TPropertyEditorHook;
    begin
      if Index = 0 then
      begin
        GetHook(Hook);
        if EditStringGrid(GetComponent as TStringGrid) then
          if Assigned(Hook) then
            Hook.Modified(Self);
      end;
    end;
    
    function TStringGridComponentEditor.GetVerb(Index: Integer): string;
    begin
      if Index = 0 then Result := sccsSGEdt
      else Result := '';
    end;
    
    function TStringGridComponentEditor.GetVerbCount: Integer;
    begin
      Result := 1;
    end;
    
    { TCheckListBoxComponentEditor }
    
    procedure TCheckListBoxComponentEditor.DoShowEditor;
    var 
      Dlg: TCheckListBoxEditorDlg;
    begin
      Dlg := TCheckListBoxEditorDlg.Create(nil);
      try
        if GetComponent is TCheckListBox then 
        begin
          Dlg.aCheck := TCheckListBox(GetComponent);
          if not HasHook then exit;
    
          AssignCheckList(Dlg.FCheck, Dlg.aCheck);
    
          //ShowEditor
          if Dlg.ShowModal=mrOK then 
          begin
            AssignCheckList(Dlg.aCheck, Dlg.FCheck);
            Modified;
          end;
          if Dlg.Modified then
            Modified;
        end;
      finally
        Dlg.Free;
      end;
    end;
    
    procedure TCheckListBoxComponentEditor.ExecuteVerb(Index: Integer);
    begin
      DoShowEditor;
    end;
    
    function TCheckListBoxComponentEditor.GetVerb(Index: Integer): string;
    begin
      Result:=clbCheckListBoxEditor+'...';
    end;
    
    function TCheckListBoxComponentEditor.GetVerbCount: Integer;
    begin
      Result:=1;
    end;
    
    { TCheckGroupEditorDlg }
    
    procedure TCheckGroupComponentEditor.DoShowEditor;
    var 
      Dlg: TCheckGroupEditorDlg;
    begin
      Dlg := TCheckGroupEditorDlg.Create(nil);
      try
        if GetComponent is TCheckGroup then 
        begin
          Dlg.aCheck := TCheckGroup(GetComponent);
          if not HasHook then exit;
    
          AssignCheckGroup(Dlg.FCheck, Dlg.aCheck);
          Dlg.ColumnsUpDown.Position := Dlg.aCheck.Columns;
          //ShowEditor
          if Dlg.ShowModal = mrOK then 
          begin
            AssignCheckGroup(Dlg.aCheck, Dlg.FCheck);
            Modified;
          end;
          if Dlg.Modified then
            Modified;
        end;
      finally
        Dlg.Free;
      end;
    end;
    
    procedure TCheckGroupComponentEditor.ExecuteVerb(Index: Integer);
    begin
      DoShowEditor;
    end;
    
    function TCheckGroupComponentEditor.GetVerb(Index: Integer): string;
    begin
      Result:=cgCheckGroupEditor+'...';
    end;
    
    function TCheckGroupComponentEditor.GetVerbCount: Integer;
    begin
      Result:=1;
    end;
    
    { TToolBarComponentEditor }
    
    procedure TToolBarComponentEditor.ExecuteVerb(Index: Integer);
    var
      NewStyle: TToolButtonStyle;
      Hook: TPropertyEditorHook;
      NewToolButton: TToolButton;
      NewName: string;
      CurToolBar: TToolBar;
      SiblingButton: TToolButton;
    begin
      Hook:=nil;
      if not GetHook(Hook) then exit;
      case Index of
        0: NewStyle := tbsButton;
        1: NewStyle := tbsCheck;
        2: NewStyle := tbsSeparator;
        3: NewStyle := tbsDivider;
      else
        exit;
      end;
      CurToolBar := ToolBar;
      NewToolButton := TToolButton.Create(CurToolBar.Owner);
      NewName := GetDesigner.CreateUniqueComponentName(NewToolButton.ClassName);
      NewToolButton.Caption := NewName;
      NewToolButton.Name := NewName;
      NewToolButton.Style := NewStyle;
      if NewStyle = tbsDivider then
        NewToolButton.Width := 3;
      // position the button next to the last button
      if CurToolBar.ButtonCount > 0 then
      begin
        SiblingButton := CurToolBar.Buttons[CurToolBar.ButtonCount - 1];
        NewToolButton.SetBounds(SiblingButton.Left + SiblingButton.Width,
          SiblingButton.Top, NewToolButton.Width, NewToolButton.Height);
      end;
      NewToolButton.Parent := CurToolBar;
      Hook.PersistentAdded(NewToolButton, True);
      Modified;
    end;
    
    function TToolBarComponentEditor.GetVerb(Index: Integer): string;
    begin
      case Index of
        0: Result := 'New Button';
        1: Result := 'New Checkbutton';
        2: Result := 'New Separator';
        3: Result := 'New Divider';
      else
        Result := '';
      end;
    end;
    
    function TToolBarComponentEditor.GetVerbCount: Integer;
    begin
      Result := 4;
    end;
    
    function TToolBarComponentEditor.ToolBar: TToolBar;
    begin
      Result := TToolBar(GetComponent);
    end;
    
    { TCommonDialogComponentEditor }
    
    procedure TCommonDialogComponentEditor.TestDialog;
    begin
      with Component as TCommonDialog do Execute;
    end;
    
    function TCommonDialogComponentEditor.GetVerbCount: integer;
    begin
      Result:=1;
    end;
    
    function TCommonDialogComponentEditor.GetVerb(Index: integer): string;
    begin
      case Index of
        0:Result:=oisTestDialog;
      else
        Result:=inherited GetVerb(Index);
      end;
    end;
    
    procedure TCommonDialogComponentEditor.ExecuteVerb(Index: integer);
    begin
      case Index of
        0:TestDialog;
      else
        inherited ExecuteVerb(Index);
      end;
    end;
    
    //------------------------------------------------------------------------------
    
    procedure InternalFinal;
    var
      p: PComponentClassRec;
      i: integer;
    begin
      if ComponentClassList<>nil then begin
        for i:=0 to ComponentClassList.Count-1 do begin
          p:=PComponentClassRec(ComponentClassList[i]);
          Dispose(p);
        end;
        ComponentClassList.Free;
      end;
    end;
    
    { TTabControlComponentEditor }
    
    const
      tcvAddTab       = 0;
      tcvInsertTab    = 1;
      tcvDeleteTab    = 2;
      tcvMoveTabLeft  = 3;
      tcvMoveTabRight = 4;
    
    procedure TTabControlComponentEditor.DoAddTab;
    begin
      TabControl.Tabs.Add(CreateNewTabCaption);
      Modified;
    end;
    
    procedure TTabControlComponentEditor.DoInsertTab;
    begin
      TabControl.Tabs.Insert(TabControl.TabIndex,CreateNewTabCaption);
      Modified;
    end;
    
    procedure TTabControlComponentEditor.DoDeleteTab;
    begin
      if (TabControl.Tabs.Count=0) then exit;
      TabControl.Tabs.Delete(TabControl.TabIndex);
      Modified;
    end;
    
    procedure TTabControlComponentEditor.DoMoveActiveTabLeft;
    var
      Index: integer;
    begin
      Index:=TabControl.TabIndex;
      if (Index<0) then exit;
      DoMoveTab(Index,Index-1);
    end;
    
    procedure TTabControlComponentEditor.DoMoveActiveTabRight;
    var
      Index: integer;
    begin
      Index:=TabControl.TabIndex;
      if (Index>=TabControl.Tabs.Count-1) then exit;
      DoMoveTab(Index,Index+1);
    end;
    
    procedure TTabControlComponentEditor.DoMoveTab(CurIndex, NewIndex: Integer);
    begin
      TabControl.Tabs.Move(CurIndex,NewIndex);
      Modified;
    end;
    
    procedure TTabControlComponentEditor.AddMenuItemsForTabs(
      ParentMenuItem: TMenuItem);
    var
      i: integer;
      NewMenuItem: TMenuItem;
    begin
      ParentMenuItem.Enabled:=TabControl.Tabs.Count>0;
      for i:=0 to TabControl.Tabs.Count-1 do begin
        NewMenuItem:=TMenuItem.Create(ParentMenuItem);
        NewMenuItem.Name:='ShowTab'+IntToStr(i);
        NewMenuItem.Caption:='"'+TabControl.Tabs[i]+'"';
        NewMenuItem.OnClick:=@ShowTabMenuItemClick;
        ParentMenuItem.Add(NewMenuItem);
      end;
    end;
    
    procedure TTabControlComponentEditor.ShowTabMenuItemClick(Sender: TObject);
    var
      AMenuItem: TMenuItem;
      NewTabIndex: LongInt;
    begin
      AMenuItem:=TMenuItem(Sender);
      if (AMenuItem=nil) or (not (AMenuItem is TMenuItem)) then exit;
      NewTabIndex:=AMenuItem.MenuIndex;
      if (NewTabIndex<0) or (NewTabIndex>=TabControl.Tabs.Count) then exit;
      TabControl.TabIndex:=NewTabIndex;
      Modified;
    end;
    
    function TTabControlComponentEditor.CreateNewTabCaption: string;
    begin
      Result:='New Tab';
      while TabControl.IndexOfTabWithCaption(Result)>=0 do
        Result:=CreateNextIdentifier(Result);
    end;
    
    procedure TTabControlComponentEditor.ExecuteVerb(Index: Integer);
    begin
      case Index of
        tcvAddTab:       DoAddTab;
        tcvInsertTab:    DoInsertTab;
        tcvDeleteTab:    DoDeleteTab; // beware: this can free the editor itself
        tcvMoveTabLeft:  DoMoveActiveTabLeft;
        tcvMoveTabRight: DoMoveActiveTabRight;
      end;
    end;
    
    function TTabControlComponentEditor.GetVerb(Index: Integer): string;
    begin
      case Index of
        tcvAddTab:       Result:=tccesAddTab;
        tcvInsertTab:    Result:=tccesInsertTab;
        tcvDeleteTab:    Result:=tccesDeleteTab;
        tcvMoveTabLeft:  Result:=tccesMoveTabLeft;
        tcvMoveTabRight: Result:=tccesMoveTabRight;
      else
        Result:='';
      end;
    end;
    
    function TTabControlComponentEditor.GetVerbCount: Integer;
    begin
      Result:=5;
    end;
    
    procedure TTabControlComponentEditor.PrepareItem(Index: Integer;
      const AnItem: TMenuItem);
    begin
      inherited PrepareItem(Index, AnItem);
      case Index of
        tcvAddTab:       ;
        tcvInsertTab:    AnItem.Enabled:=TabControl.TabIndex>=0;
        tcvDeleteTab:    AnItem.Enabled:=TabControl.TabIndex>=0;
        tcvMoveTabLeft:  AnItem.Enabled:=TabControl.TabIndex>0;
        tcvMoveTabRight: AnItem.Enabled:=TabControl.TabIndex<TabControl.Tabs.Count-1;
      end;
    end;
    
    function TTabControlComponentEditor.TabControl: TCustomTabControl;
    begin
      Result:=TCustomTabControl(GetComponent);
    end;
    
    { TTimerComponentEditor }
    
    constructor TTimerComponentEditor.Create(AComponent: TComponent;
      ADesigner: TComponentEditorDesigner);
    begin
      inherited Create(AComponent, ADesigner);
      BestEditEvent := 'ONTIMER';
    end;
    
    { TComponentEditorDesigner }
    
    function TComponentEditorDesigner.GetHandlerCount(
      HookType: TComponentEditorDesignerHookType): integer;
    begin
      Result:=FHandlers[HookType].Count;
    end;
    
    procedure TComponentEditorDesigner.AddHandler(
      HookType: TComponentEditorDesignerHookType; const Handler: TMethod);
    begin
      if Handler.Code=nil then RaiseGDBException('TComponentEditorDesigner.AddHandler');
      if FHandlers[HookType]=nil then
        FHandlers[HookType]:=TMethodList.Create;
      FHandlers[HookType].Add(Handler);
    end;
    
    procedure TComponentEditorDesigner.RemoveHandler(
      HookType: TComponentEditorDesignerHookType; const Handler: TMethod);
    begin
      FHandlers[HookType].Remove(Handler);
    end;
    
    destructor TComponentEditorDesigner.Destroy;
    var
      HookType: TComponentEditorDesignerHookType;
    begin
      for HookType:=Low(FHandlers) to High(FHandlers) do
        FreeThenNil(FHandlers[HookType]);
      inherited Destroy;
    end;
    
    procedure TComponentEditorDesigner.Modified;
    begin
      if FChangeStamp<High(FChangeStamp) then
        inc(FChangeStamp)
      else
        FChangeStamp:=Low(FChangeStamp);
      FHandlers[cedhtModified].CallNotifyEvents(Self);
    end;
    
    procedure TComponentEditorDesigner.RemoveAllHandlersForObject(
      const HandlerObject: TObject);
    var
      HookType: TComponentEditorDesignerHookType;
    begin
      for HookType:=Low(FHandlers) to High(FHandlers) do
        if FHandlers[HookType]<>nil then
          FHandlers[HookType].RemoveAllMethodsOfObject(HandlerObject);
    end;
    
    procedure TComponentEditorDesigner.AddHandlerModified(
      const OnModified: TNotifyEvent);
    begin
      AddHandler(cedhtModified,TMethod(OnModified));
    end;
    
    procedure TComponentEditorDesigner.RemoveHandlerModified(
      const OnModified: TNotifyEvent);
    begin
      RemoveHandler(cedhtModified,TMethod(OnModified));
    end;
    
    initialization
      RegisterComponentEditorProc := @DefaultRegisterComponentEditorProc;
      RegisterComponentEditor(TCustomNotebook, TNotebookComponentEditor);
      RegisterComponentEditor(TCustomPage, TPageComponentEditor);
      RegisterComponentEditor(TCustomTabControl, TTabControlComponentEditor);
      RegisterComponentEditor(TStringGrid, TStringGridComponentEditor);
      RegisterComponentEditor(TCheckListBox, TCheckListBoxComponentEditor);
      RegisterComponentEditor(TCheckGroup, TCheckGroupComponentEditor);
      RegisterComponentEditor(TToolBar, TToolBarComponentEditor);
      RegisterComponentEditor(TCommonDialog, TCommonDialogComponentEditor);
      RegisterComponentEditor(TCustomTimer, TTimerComponentEditor);
    
    finalization
      InternalFinal;
    
    end.
    
    
    ComponentEditors.pas (38,295 bytes)
  • Designer.pp (127,322 bytes)
    { /***************************************************************************
                       designer.pp  -  Lazarus IDE unit
                       --------------------------------
    
                  Initial Revision  : Sat May 10 23:15:32 CST 1999
    
    
     ***************************************************************************/
    
     ***************************************************************************
     *                                                                         *
     *   This source is free software; you can redistribute it and/or modify   *
     *   it under the terms of the GNU General Public License as published by  *
     *   the Free Software Foundation; either version 2 of the License, or     *
     *   (at your option) any later version.                                   *
     *                                                                         *
     *   This code is distributed in the hope that it will be useful, but      *
     *   WITHOUT ANY WARRANTY; without even the implied warranty of            *
     *   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU     *
     *   General Public License for more details.                              *
     *                                                                         *
     *   A copy of the GNU General Public License is available on the World    *
     *   Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also      *
     *   obtain it by writing to the Free Software Foundation,                 *
     *   Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.        *
     *                                                                         *
     ***************************************************************************
    }
    unit Designer;
    
    {$mode objfpc}{$H+}
    
    interface
    
    {off $DEFINE VerboseDesigner}
    {off $DEFINE VerboseDesignerDraw}
    {off $DEFINE VerboseDesignerSelect}
    
    uses
      // FCL + LCL
      Types, Classes, SysUtils, Math, LCLProc, LCLType, LResources, LCLIntf, LMessages,
      InterfaceBase, Forms, Controls, GraphType, Graphics, Dialogs, ExtCtrls, Menus,
      ClipBrd, TypInfo,
      // IDEIntf
      IDEDialogs, PropEdits, PropEditUtils, ComponentEditors, MenuIntf, IDEImagesIntf,
      FormEditingIntf,
      // IDE
      LazarusIDEStrConsts, EnvironmentOpts, IDECommands, ComponentReg,
      NonControlDesigner, FrameDesigner, AlignCompsDlg, SizeCompsDlg, ScaleCompsDlg,
      TabOrderDlg, DesignerProcs, CustomFormEditor,  AskCompNameDlg,
      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
        FDesignerPopupMenu: TPopupMenu;
        FDefaultFormBounds: TRect;
        FLastFormBounds: TRect;
        FDefaultFormBoundsValid: boolean;
        FFlags: TDesignerFlags;
        FGridColor: TColor;
        FLookupRoot: TComponent;
        FMediator: TDesignerMediator;
        FOnActivated: TNotifyEvent;
        FOnCloseQuery: TNotifyEvent;
        FOnShowObjectInspector: 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;
        FPopupMenuComponentEditor: TBaseComponentEditor;
    
        //hint stuff
        FHintTimer: TTimer;
        FHintWIndow: THintWindow;
    
        // component drawing
        FDDC: TDesignerDeviceContext;
        FSurface: TBitmap;
    
        procedure DrawNonVisualComponent(AComponent: TComponent);
        function GetGridColor: TColor;
        function GetGridSizeX: integer;
        function GetGridSizeY: integer;
        function GetIsControl: Boolean;
        function GetShowBorderSpacing: boolean;
        function GetShowComponentCaptions: boolean;
        function GetShowEditorHints: boolean;
        function GetShowGrid: boolean;
        function GetSnapToGrid: boolean;
        procedure HintTimer(Sender : TObject);
        procedure InvalidateWithParent(AComponent: TComponent);
        procedure SetDefaultFormBounds(const AValue: TRect);
        procedure SetGridColor(const AValue: TColor);
        procedure SetGridSizeX(const AValue: integer);
        procedure SetGridSizeY(const AValue: integer);
        procedure SetIsControl(Value: Boolean);
        procedure SetMediator(const AValue: TDesignerMediator);
        procedure SetPopupMenuComponentEditor(const AValue: TBaseComponentEditor);
        procedure SetShowBorderSpacing(const AValue: boolean);
        procedure SetShowComponentCaptions(const AValue: boolean);
        procedure SetShowEditorHints(const AValue: boolean);
        procedure SetShowGrid(const AValue: boolean);
        procedure SetSnapToGrid(const AValue: boolean);
      protected
        MouseDownComponent: TComponent;
        MouseDownSender: TComponent;
        MouseDownPos: TPoint;
        MouseDownShift: TShiftState;
        MouseUpPos: TPoint;
        LastMouseMovePos: TPoint;
        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;
        procedure HandlePopupMenu(Sender: TControl; var Message: TLMContextMenu);
        procedure GetMouseMsgShift(TheMessage: TLMMouse; var Shift: TShiftState;
                                   var Button: TMouseButton);
    
        // 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 NudgeSelection(DiffX, DiffY: Integer); overload;
        procedure NudgeSelection(SelectNext: Boolean); overload;
        procedure SelectParentOfSelection;
        function DoCopySelectionToClipboard: boolean;
        function GetPasteParent: TWinControl;
        procedure DoModified;
        function DoPasteSelectionFromClipboard(PasteFlags: TComponentPasteSelectionFlags
                                               ): boolean;
        function DoInsertFromStream(s: TStream; PasteParent: TWinControl;
                                    PasteFlags: TComponentPasteSelectionFlags): Boolean;
        procedure DoShowTabOrderEditor;
        procedure DoShowChangeClassDialog;
        procedure DoShowObjectInspector;
        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;
        procedure SetTempCursor(ARoot: TWinControl; ACursor: TCursor);
    
        // 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);
        procedure OnCenterFormMenuClick(Sender: TObject);
    
        // hook
        function GetPropertyEditorHook: TPropertyEditorHook; override;
        function OnFormActivated: boolean;
        function OnFormCloseQuery: boolean;
    
        property PopupMenuComponentEditor: TBaseComponentEditor read FPopupMenuComponentEditor write SetPopupMenuComponentEditor;
      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;
        function ComponentIsIcon(AComponent: TComponent): boolean;
        function GetParentFormRelativeClientOrigin(AComponent: TComponent): TPoint;
      public
        property Flags: TDesignerFlags read FFlags;
        property GridSizeX: integer read GetGridSizeX write SetGridSizeX;
        property GridSizeY: integer read GetGridSizeY write SetGridSizeY;
        property GridColor: TColor read GetGridColor write SetGridColor;
        property IsControl: Boolean read GetIsControl write SetIsControl;
        property LookupRoot: TComponent read FLookupRoot;
        property Mediator: TDesignerMediator read FMediator write SetMediator;
        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 OnShowObjectInspector: TNotifyEvent read FOnShowObjectInspector write FOnShowObjectInspector;
        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;
      DesignerMenuCenterForm: TIDEMenuCommand;
    
      DesignerMenuSnapToGridOption: TIDEMenuCommand;
      DesignerMenuSnapToGuideLinesOption: TIDEMenuCommand;
      DesignerMenuShowOptions: TIDEMenuCommand;
    
    
    procedure RegisterStandardDesignerMenuItems;
    
    
    implementation
    
    type
      TCustomFormAccess = class(TCustomForm);
      TControlAccess = class(TControl);
      TComponentAccess = class(TComponent);
    
      { TComponentSearch }
    
      TComponentSearch = class(TComponent)
      public
        Best: TComponent;
        BestLevel: integer;
        BestIsNonVisual: boolean;
        Level: integer;
        AtPos: TPoint;
        MinClass: TComponentClass;
        IgnoreHidden: boolean;
        OnlyNonVisual: boolean;
        Mediator: TDesignerMediator;
        Root: TComponent;
        procedure Gather(Child: TComponent);
        procedure Search(ARoot: TComponent);
      end;
    
    { TComponentSearch }
    
    procedure TComponentSearch.Gather(Child: TComponent);
    var
      Control: TControl;
      ChildBounds: TRect;
      OldRoot: TComponent;
      IsNonVisual: Boolean;
    begin
      if Assigned(Best) and BestIsNonVisual and (BestLevel < Level) then exit;
      {$IFDEF VerboseDesignerSelect}
      DebugLn(['TComponentSearch.Gather ',DbgSName(Child),' ',dbgs(AtPos),' MinClass=',DbgSName(MinClass)]);
      {$ENDIF}
      // check if child is at position
      if Child is TControl then
      begin
        Control := TControl(Child);
        if IgnoreHidden and (csNoDesignVisible in Control.ControlStyle) then
          exit;
        if csNoDesignSelectable in Control.ControlStyle then
          exit;
      end
      else
        Control := nil;
      ChildBounds := GetParentFormRelativeBounds(Child);
      {$IFDEF VerboseDesignerSelect}
      DebugLn(['TComponentSearch.Gather PtInRect=',PtInRect(ChildBounds, AtPos),' ChildBounds=',dbgs(ChildBounds)]);
      {$ENDIF}
      if not PtInRect(ChildBounds, AtPos) then Exit;
    
      if Assigned(Mediator) then
        IsNonVisual := Mediator.ComponentIsIcon(Child)
      else
        IsNonVisual := DesignerProcs.ComponentIsNonVisual(Child);
    
      if Child.InheritsFrom(MinClass) and (IsNonVisual or not OnlyNonVisual) then
      begin
        Best := Child;
        BestIsNonVisual := IsNonVisual;
        BestLevel := Level;
        {$IFDEF VerboseDesignerSelect}
        DebugLn(['TComponentSearch.Gather Best=',DbgSName(Best)]);
        {$ENDIF}
      end;
    
      // search in children
      if (csInline in Child.ComponentState) or
         (Assigned(Control) and not (csOwnedChildrenNotSelectable in Control.ControlStyle)) then
      begin
        {$IFDEF VerboseDesignerSelect}
        DebugLn(['TComponentSearch.Gather search in children of ',DbgSName(Child)]);
        {$ENDIF}
        OldRoot := Root;
        try
          inc(Level);
          if csInline in Child.ComponentState then
            Root := Child;
          {$IFDEF VerboseDesignerSelect}
          DebugLn(['TComponentSearch.Gather Root=',DbgSName(Root)]);
          {$ENDIF}
          TComponentAccess(Child).GetChildren(@Gather, Root);
        finally
          dec(Level);
          Root := OldRoot;
        end;
        {$IFDEF VerboseDesignerSelect}
        DebugLn(['TComponentSearch.Gather searched in children of ',DbgSName(Child)]);
        {$ENDIF}
      end;
    end;
    
    procedure TComponentSearch.Search(ARoot: TComponent);
    begin
      Root := ARoot;
      Level := 1;
      TComponentAccess(Root).GetChildren(@Gather, Root);
      Level := 0;
    end;
    
    const
      mk_lbutton =   1;
      mk_rbutton =   2;
      mk_shift   =   4;
      mk_control =   8;
      mk_mbutton = $10;
    
    procedure RegisterStandardDesignerMenuItems;
    begin
      DesignerMenuRoot:=RegisterIDEMenuRoot(DesignerMenuRootName);
    
      // register the dynamic section for the component editor
      DesignerMenuSectionComponentEditor:=RegisterIDEMenuSection(DesignerMenuRoot,
                                                        'Component editor section');
    
      // register the custom dynamic section
      DesignerMenuSectionCustomDynamic:=RegisterIDEMenuSection(DesignerMenuRoot,
                                                          'Custom dynamic section');
    
      // register align section
      DesignerMenuSectionAlign:=RegisterIDEMenuSection(DesignerMenuRoot,
                                                                   'Align section');
        DesignerMenuAlign:=RegisterIDEMenuCommand(DesignerMenuSectionAlign,
                                             'Align',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 z-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);
        DesignerMenuCenterForm:=RegisterIDEMenuCommand(DesignerMenuSectionMisc,
                                                    'Center form', lisCenterForm);
    
      // 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 begin
        FLookupRoot := TNonControlDesignerForm(FForm).LookupRoot;
        Mediator:=TNonControlDesignerForm(FForm).Mediator;
      end
      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;
      FPopupMenuComponentEditor := nil;
    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;
        if Mediator<>nil then
          Mediator.Designer:=nil;
        // free or hide the form
        TheFormEditor.DeleteComponent(FLookupRoot,FreeComponent);
        FMediator:=nil;
      end;
      Free;
    end;
    
    destructor TDesigner.Destroy;
    begin
      PopupMenuComponentEditor := nil;
      FreeAndNil(FDesignerPopupMenu);
      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, False);
      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;
    
    function ComponentsSortByLeft(Item1, Item2: Pointer): Integer;
    var
      Comp1: TComponent absolute Item1;
      Comp2: TComponent absolute Item2;
      L1, L2: Integer;
    begin
      L1 := GetComponentLeft(Comp1);
      L2 := GetComponentLeft(Comp2);
      if L1 < L2 then
        Result := -1
      else
      if L1 > L2 then
        Result := 1
      else
        Result := 0;
    end;
    
    function ComponentsSortByTop(Item1, Item2: Pointer): Integer;
    var
      Comp1: TComponent absolute Item1;
      Comp2: TComponent absolute Item2;
      T1, T2: Integer;
    begin
      T1 := GetComponentTop(Comp1);
      T2 := GetComponentTop(Comp2);
      if T1 < T2 then
        Result := -1
      else
      if T1 > T2 then
        Result := 1
      else
        Result := 0;
    end;
    
    procedure TDesigner.NudgeSelection(DiffX, DiffY: Integer);
    const
      Delta = 50; // radius for searching components
    var
      List: TFPList;
      Coord, Test: TPoint;
      Current, AComponent: TComponent;
      i: integer;
    begin
      if (ControlSelection.SelectionForm <> Form) or
         (ControlSelection.SelectionForm.ComponentCount = 0) or
         ControlSelection.LookupRootSelected or
         (ControlSelection.Count <> 1) then Exit;
      if not ControlSelection[0].IsTComponent then Exit;
    
      // create a list of components at the similar top/left
      Current := TComponent(ControlSelection[0].Persistent);
      AComponent := nil;
      List := TFPList.Create;
      try
        Coord := GetParentFormRelativeClientOrigin(Current);
        if DiffX <> 0 then
        begin
          for i := 0 to ControlSelection.SelectionForm.ComponentCount - 1 do
          begin
            AComponent := ControlSelection.SelectionForm.Components[i];
            if (AComponent = Current) or ComponentIsInvisible(AComponent) then
              Continue;
            Test := GetParentFormRelativeClientOrigin(AComponent);
            if (Abs(Test.Y - Coord.Y) <= Delta) and
               (Sign(Test.X - Coord.X) = Sign(DiffX)) then
              List.Add(AComponent);
          end;
          if List.Count > 0 then
          begin
            List.Sort(@ComponentsSortByLeft);
            if DiffX > 0 then
              AComponent := TComponent(List[0])
            else
              AComponent := TComponent(List[List.Count - 1]);
          end
          else
            AComponent := nil;
        end
        else
        if DiffY <> 0 then
        begin
          for i := 0 to ControlSelection.SelectionForm.ComponentCount - 1 do
          begin
            AComponent := ControlSelection.SelectionForm.Components[i];
            if (AComponent = Current) or ComponentIsInvisible(AComponent) then
              Continue;
            Test := GetParentFormRelativeClientOrigin(AComponent);
            if (Abs(Test.X - Coord.X) <= Delta) and
               (Sign(Test.Y - Coord.Y) = Sign(DiffY)) then
              List.Add(AComponent);
          end;
          if List.Count > 0 then
          begin
            List.Sort(@ComponentsSortByTop);
            if DiffY > 0 then
              AComponent := TComponent(List[0])
            else
              AComponent := TComponent(List[List.Count - 1]);
          end
          else
            AComponent := nil;
        end;
      finally
        List.Free;
      end;
      if AComponent <> nil then
      begin
        ControlSelection.AssignPersistent(AComponent);
        Modified;
      end;
    end;
    
    procedure TDesigner.NudgeSelection(SelectNext: Boolean);
    
      function StepIndex(Index: Integer): Integer;
      begin
        Result := Index;
        if SelectNext then
          Inc(Result)
        else
          Dec(Result);
    
        if Result >= ControlSelection.SelectionForm.ComponentCount then
          Result := 0
        else
        if Result < 0 then
          Result := ControlSelection.SelectionForm.ComponentCount - 1;
      end;
    
    var
      Index, StartIndex: Integer;
      AComponent: TComponent;
    begin
      if (ControlSelection.SelectionForm <> Form) or
         (ControlSelection.SelectionForm.ComponentCount = 0) then Exit;
      if (ControlSelection.Count = 1) and ControlSelection[0].IsTComponent then
        Index := TComponent(ControlSelection[0].Persistent).ComponentIndex
      else
        Index := -1;
    
      Index := StepIndex(Index);
      StartIndex := Index;
    
      AComponent := nil;
      while AComponent = nil do
      begin
        AComponent := ControlSelection.SelectionForm.Components[Index];
        if ComponentIsInvisible(AComponent) then
        begin
          AComponent := nil;
          Index := StepIndex(Index);
          if Index = StartIndex then
            break;
        end;
      end;
    
      if AComponent <> nil then
      begin
        ControlSelection.AssignPersistent(AComponent);
        Modified;
      end;
    end;
    
    procedure TDesigner.SelectParentOfSelection;
    
      function ParentComponent(AComponent: TComponent): TComponent;
      begin
        Result := AComponent.GetParentComponent;
        if (Result = nil) and ComponentIsIcon(AComponent) then
          Result := AComponent.Owner;
      end;
    
    var
      i: Integer;
    begin
      // resizing or moving
      if dfHasSized in FFlags then
      begin
        ControlSelection.RestoreBounds;
        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;
    
      // if not component moving then select parent
      i := ControlSelection.Count - 1;
      while (i >= 0) and
            (ControlSelection[i].ParentInSelection or
             not ControlSelection[i].IsTComponent or
             (ParentComponent(TComponent(ControlSelection[i].Persistent)) = nil)) do
        Dec(i);
      if i >= 0 then
        SelectOnlyThisComponent(ParentComponent(TComponent(ControlSelection[i].Persistent)));
    end;
    
    function TDesigner.CopySelectionToStream(AllComponentsStream: TStream): boolean;
    
      function UnselectDistinctControls: boolean;
      var
        i: Integer;
        AParent, CurParent: TWinControl;
      begin
        Result:=false;
        AParent:=nil;
        i:=0;
        while i<ControlSelection.Count do begin
          if ControlSelection[i].IsTControl then begin
            // unselect controls from which the parent is selected too
            if ControlSelection[i].ParentInSelection then begin
              ControlSelection.Delete(i);
              continue;
            end;
    
            // check if not the top level component is selected
            CurParent:=TControl(ControlSelection[i].Persistent).Parent;
            if CurParent=nil then begin
              MessageDlg(lisCanNotCopyTopLevelComponent,
                lisCopyingAWholeFormIsNotImplemented,
                mtError,[mbOk],0);
              exit;
            end;
    
            // unselect all controls, that do not have the same parent
            if (AParent=nil) then
              AParent:=CurParent
            else if (AParent<>CurParent) 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
              Writer.OnWriteMethodProperty:=@BaseFormEditor1.WriteMethodPropertyEvent;
              Writer.Root:=FLookupRoot;
              Writer.WriteComponent(CurComponent);
            finally
              if DestroyDriver then Writer.Driver.Free;
              Writer.Destroy;
            end;
          except
            on E: Exception do begin
              MessageDlg(lisUnableToStreamSelectedComponents,
                Format(lisThereWasAnErrorDuringWritingTheSelectedComponent, [
                  CurComponent.Name, CurComponent.ClassName, #13, E.Message]),
                mtError,[mbOk],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,[mbOk],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,[mbOk],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;
    
    procedure TDesigner.DoModified;
    begin
      if Assigned(OnModified) then
        OnModified(Self)
    end;
    
    function TDesigner.DoPasteSelectionFromClipboard(
      PasteFlags: TComponentPasteSelectionFlags): boolean;
    var
      AllComponentText: string;
      CurTextCompStream: TMemoryStream;
    begin
      Result:=false;
      if not CanPaste then exit;
      // read component stream from clipboard
      AllComponentText:=ClipBoard.AsText;
      if AllComponentText='' then exit;
      CurTextCompStream:=TMemoryStream.Create;
      try
        CurTextCompStream.Write(AllComponentText[1],length(AllComponentText));
        CurTextCompStream.Position:=0;
        if not DoInsertFromStream(CurTextCompStream,nil,PasteFlags) then
          exit;
      finally
        CurTextCompStream.Free;
      end;
      Result:=true;
    end;
    
    function TDesigner.DoInsertFromStream(s: TStream;
      PasteParent: TWinControl; PasteFlags: TComponentPasteSelectionFlags): Boolean;
    var
      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 := LeftTopToDesignInfo(
            SmallInt(Max(0, Min(P.x, Form.ClientWidth - NonVisualCompWidth))),
            SmallInt(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
        Form.DisableAutoSizing;
        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
          Form.EnableAutoSizing;
        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.DoShowObjectInspector;
    begin
      if Assigned(FOnShowObjectInspector) then
        OnShowObjectInspector(Self);
    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;
      try
        CompEditor.Free;
      except
        on E: Exception do begin
          DebugLn('TDesigner.InvokeComponentEditor ERROR freeing component editor: ',E.Message);
        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;
    var
      ParentForm: TPoint;
    begin
      Result.X := LeftFromDesignInfo(AComponent.DesignInfo);
      Result.Y := TopFromDesignInfo(AComponent.DesignInfo);
      // convert to lookuproot coords
      if (AComponent.Owner <> FLookupRoot) then
      begin
        ParentForm:=GetParentFormRelativeClientOrigin(AComponent.Owner);
        inc(Result.X,ParentForm.X);
        inc(Result.Y,ParentForm.Y);
      end;
    end;
    
    procedure TDesigner.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
          DoPaintDesignerItems
        else
        begin
          // client grid
          if (Sender is TWinControl) and (csAcceptsControls in Sender.ControlStyle) then
            PaintClientGrid(TWinControl(Sender),DDC);
    
          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
        SetTempCursor(Form, LastFormCursor);
        TheMessage.Result := 1;
      end;
    end;
    
    procedure TDesigner.HandlePopupMenu(Sender: TControl; var Message: TLMContextMenu);
    var
      PopupPos: TPoint;
    begin
      if Message.XPos = -1 then
      begin
        PopupMenuComponentEditor := GetComponentEditorForSelection;
        BuildPopupMenu;
        with ControlSelection do
          PopupPos := Point(Left + Width, Top);
        with Form.ClientToScreen(PopupPos) do
          FDesignerPopupMenu.Popup(X, Y);
      end;
      Message.Result := 1;
    end;
    
    procedure TDesigner.GetMouseMsgShift(TheMessage: TLMMouse;
      var Shift: TShiftState; var Button: TMouseButton);
    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);
    
      if GetKeyState(VK_MENU) < 0 then Include(Shift, ssAlt);
      if (GetKeyState(VK_LWIN) < 0) or (GetKeyState(VK_RWIN) < 0) then Include(Shift, ssMeta);
    
      case TheMessage.Msg of
      LM_LBUTTONUP,LM_LBUTTONDBLCLK,LM_LBUTTONTRIPLECLK,LM_LBUTTONQUADCLK:
        begin
          Include(Shift, ssLeft);
          Button := mbLeft;
        end;
      LM_MBUTTONUP,LM_MBUTTONDBLCLK,LM_MBUTTONTRIPLECLK,LM_MBUTTONQUADCLK:
        begin
          Include(Shift, ssMiddle);
          Button := mbMiddle;
        end;
      LM_RBUTTONUP,LM_RBUTTONDBLCLK,LM_RBUTTONTRIPLECLK,LM_RBUTTONQUADCLK:
        begin
          Include(Shift, ssRight);
          Button := mbRight;
        end;
      else
        if (TheMessage.Keys and MK_MButton) <> 0 then
        begin
          Include(Shift, ssMiddle);
          Button := mbMiddle;
        end;
        if (TheMessage.Keys and MK_RButton) <> 0 then
        begin
          Include(Shift, ssRight);
          Button := mbRight;
        end;
        if (TheMessage.Keys and MK_LButton) <> 0 then
        begin
          Include(Shift, ssLeft);
          Button := mbLeft;
        end;
        if (TheMessage.Keys and MK_XBUTTON1) <> 0 then
        begin
          Include(Shift, ssExtra1);
          Button := mbExtra1;
        end;
        if (TheMessage.Keys and MK_XBUTTON2) <> 0 then
        begin
          Include(Shift, ssExtra2);
          Button := mbExtra2;
        end;
      end;
    
      case TheMessage.Msg of
      LM_LBUTTONDBLCLK,LM_MBUTTONDBLCLK,LM_RBUTTONDBLCLK,LM_XBUTTONDBLCLK:
        Include(Shift, ssDouble);
      LM_LBUTTONTRIPLECLK,LM_MBUTTONTRIPLECLK,LM_RBUTTONTRIPLECLK,LM_XBUTTONTRIPLECLK:
        Include(Shift, ssTriple);
      LM_LBUTTONQUADCLK,LM_MBUTTONQUADCLK,LM_RBUTTONQUADCLK,LM_XBUTTONQUADCLK:
        Include(Shift, ssQuad);
      end;
    end;
    
    function TDesigner.GetDesignControl(AControl: TControl): TControl;
    // checks if AControl is designable.
    // if not check Owner.
    // AControl can be a TNonControlDesignerForm
    var
      OwnerControl: TControl;
      AComponent: TComponent;
    begin
      Result:=AControl;
      if (Result=nil) or (Result=LookupRoot) or (Result.Owner=LookupRoot) then exit;
      if Result=Form then exit;
      if (Result.Owner is TControl) then begin
        OwnerControl:=TControl(Result.Owner);
        if (not (csOwnedChildrenNotSelectable in OwnerControl.ControlStyle)) then
          exit;
        Result:=GetDesignControl(OwnerControl);
      end else begin
        AComponent:=GetDesignedComponent(AControl);
        if AComponent is TControl then
          Result:=TControl(AComponent)
        else
          Result:=nil;
      end;
    end;
    
    function TDesigner.SizeControl(Sender: TControl; TheMessage: TLMSize): Boolean;
    begin
      Result := True;
      Sender.Dispatch(TheMessage);
      if 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;
      Button: TMouseButton;
      Handled: Boolean;
    begin
      FHintTimer.Enabled := False;
      FHintWindow.Visible := 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;
    
      MouseDownComponent := ComponentAtPos(MouseDownPos.X, MouseDownPos.Y, True, True);
      if (MouseDownComponent = nil) then exit;
    
      if ComponentIsIcon(MouseDownComponent) then
      begin
        NonVisualComp := MouseDownComponent;
        MoveNonVisualComponentIntoForm(NonVisualComp);
      end;
    
      MouseDownSender := DesignSender;
    
      GetMouseMsgShift(TheMessage,Shift,Button);
      MouseDownShift:=Shift;
    
      {$IFDEF VerboseDesigner}
      DebugLn('************************************************************');
      DbgOut('MouseDownOnControl');
      DbgOut(' Sender=',dbgsName(Sender),' DesignSender=',dbgsName(DesignSender));
      //write(' Msg=',TheMessage.Pos.X,',',TheMessage.Pos.Y);
      //write(' Mouse=',MouseDownPos.X,',',MouseDownPos.Y);
      //writeln('');
    
      if (TheMessage.Keys and MK_Shift) = MK_Shift then
        DbgOut(' Shift down')
      else
        DbgOut(' No Shift down');
    
      if (TheMessage.Keys and MK_Control) = MK_Control then
        DebugLn(', CTRL down')
      else
        DebugLn(', No CTRL down');
      {$ENDIF}
    
      if (MouseDownComponent <> nil) and (MouseDownComponent is TControl) then
      begin
        if TControl(MouseDownComponent).Perform(CM_DESIGNHITTEST, 0, Longint(SmallPoint(MouseDownPos.X, MouseDownPos.Y))) > 0 then
        begin
          TControlAccess(MouseDownComponent).MouseDown(Button, Shift, MouseDownPos.X, MouseDownPos.Y);
          Exit;
        end;
      end;
    
      if Mediator<>nil then begin
        Handled:=false;
        Mediator.MouseDown(Button,Shift,MouseDownPos,Handled);
        if Handled then exit;
      end;
    
      SelectedCompClass := GetSelectedComponentClass;
    
      if Button=mbLeft then begin
        // left button
        // -> check if a grabber was activated
        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;
        if (Button = mbRight) and EnvironmentOptions.RightClickSelects and
           (ControlSelection.SelectionForm <> Form) then
          ControlSelection.AssignPersistent(MouseDownComponent);
      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
      NewLeft, NewTop, NewWidth, NewHeight: Integer;
      Button: TMouseButton;
      Shift: TShiftState;
      SenderParentForm: TCustomForm;
      RubberBandWasActive: boolean;
      ParentClientOrigin, PopupPos: TPoint;
      SelectedCompClass: TRegisteredComponent;
      SelectionChanged, NewRubberbandSelection: boolean;
      DesignSender: TControl;
    
      procedure AddComponent;
      var
        NewParent: TComponent;
        NewParentControl: TWinControl;
        NewComponent: TComponent;
        NewComponentClass: TComponentClass;
        NewName: String;
        DisableAutoSize: Boolean;
        NewControl: TControl;
      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
        NewParent := FLookupRoot;
        if Mediator<>nil then begin
          NewParent:=MouseDownComponent;
          while (NewParent<>nil)
          and (not Mediator.ParentAcceptsChild(NewParent,NewComponentClass)) do
            NewParent:=NewParent.GetParentComponent;
          if NewParent=nil then
            NewParent:=FLookupRoot;
        end else if (FLookupRoot is TCustomForm) or (FLookupRoot is TCustomFrame)
        then begin
          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;
        if not Assigned(NewParent) 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
        NewLeft:=Min(MouseDownPos.X,MouseUpPos.X);
        NewTop:=Min(MouseDownPos.Y,MouseUpPos.Y);
        if (Mediator<>nil) then begin
          ParentClientOrigin:=Mediator.GetComponentOriginOnForm(NewParent);
          DebugLn(['AddComponent ParentClientOrigin=',dbgs(ParentClientOrigin)]);
          // adjust left,top to parent origin
          dec(NewLeft,ParentClientOrigin.X);
          dec(NewTop,ParentClientOrigin.Y);
        end else if SelectedCompClass.ComponentClass.InheritsFrom(TControl) then
        begin
          ParentClientOrigin:=GetParentFormRelativeClientOrigin(NewParent);
          // adjust left,top to parent origin
          dec(NewLeft,ParentClientOrigin.X);
          dec(NewTop,ParentClientOrigin.Y);
        end;
        NewWidth:=Abs(MouseUpPos.X-MouseDownPos.X);
        NewHeight:=Abs(MouseUpPos.Y-MouseDownPos.Y);
        if Abs(NewWidth+NewHeight)<7 then begin
          // this very small component is probably only a wag, take default size
          NewWidth:=0;
          NewHeight:=0;
        end;
    
        //DebugLn(['AddComponent ',dbgsName(NewComponentClass)]);
        if NewComponentClass = nil then exit;
    
        // check circles
        if TheFormEditor.ClassDependsOnComponent(NewComponentClass, LookupRoot) then
        begin
          IDEMessageDialog(lisInvalidCircle,
            Format(lisIsAThisCircleDependencyIsNotAllowed, [dbgsName(LookupRoot),
              dbgsName(NewComponentClass), #13]),
            mtError,[mbOk],'');
          exit;
        end;
        
        // create component and component interface
        DebugLn(['AddComponent ',DbgSName(NewComponentClass),' Parent=',DbgSName(NewParent),' ',NewLeft,',',NewTop,',',NewWidth,',',NewHeight]);
        DisableAutoSize:=true;
        NewComponent := TheFormEditor.CreateComponent(
           NewParent,NewComponentClass,'',
           NewLeft,NewTop,NewWidth,NewHeight,DisableAutoSize);
        if NewComponent=nil then exit;
        if DisableAutoSize and (NewComponent is TControl) then
          TControl(NewComponent).EnableAutoSizing;
        TheFormEditor.FixupReferences(NewComponent); // e.g. frame references a datamodule
    
        // modified
        Modified;
    
    
        // set initial properties
        if NewComponent is TControl then begin
          NewControl:=TControl(NewComponent);
          //debugln(['AddComponent ',DbgSName(Self),' Bounds=',dbgs(NewControl.BoundsRect),' BaseBounds=',dbgs(NewControl.BaseBounds),' BaseParentClientSize=',dbgs(NewControl.BaseParentClientSize)]);
          NewControl.Visible:=true;
          if csSetCaption in NewControl.ControlStyle then
            NewControl.Caption:=NewComponent.Name;
        end;
        if Assigned(FOnSetDesigning) then
          FOnSetDesigning(Self,NewComponent,True);
    
        if EnvironmentOptions.CreateComponentFocusNameProperty then begin
          // ask user for name
          NewName:=NewComponent.Name;
          ShowComponentNameDialog(LookupRoot,NewComponent,NewName);
          NewComponent.Name:=NewName;
        end;
    
        // 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
        MaxParentComponent: TComponent;
      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) then begin
          if MouseDownComponent=Form then
            MaxParentComponent:=FLookupRoot
          else
            MaxParentComponent:=MouseDownComponent;
        end else
          MaxParentComponent:=FLookupRoot;
        SelectionChanged:=false;
        ControlSelection.SelectWithRubberBand(
          FLookupRoot,Mediator,NewRubberbandSelection,ssShift in Shift,
          SelectionChanged,MaxParentComponent);
        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 (ssDouble in MouseDownShift) 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
          ControlSelection.RubberbandActive := False;
      end;
    
    var
      Handled: Boolean;
    begin
      FHintTimer.Enabled := False;
      FHintWindow.Visible := False;
    
      SetCaptureControl(nil);
    
      // check if the message is for the designed form
      // and there was a mouse down before
      DesignSender:=GetDesignControl(Sender);
      SenderParentForm:=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;
    
      GetMouseMsgShift(TheMessage,Shift,Button);
      MouseUpPos:=GetFormRelativeMousePosition(Form);
    
      {$IFDEF VerboseDesigner}
      DebugLn('************************************************************');
      DbgOut('MouseUpOnControl');
      DbgOut(' Sender=',dbgsName(Sender),' DesignSender=',dbgsName(DesignSender));
      //write(' Msg=',TheMessage.Pos.X,',',TheMessage.Pos.Y);
      DebugLn('');
      {$ENDIF}
    
      if (MouseDownComponent <> nil) and (MouseDownComponent is TControl) then
      begin
        if TControl(MouseDownComponent).Perform(CM_DESIGNHITTEST, 0, Longint(SmallPoint(MouseUpPos.X, MouseUpPos.Y))) > 0 then
        begin
          TControlAccess(MouseDownComponent).MouseUp(Button, Shift, MouseUpPos.X, MouseUpPos.Y);
          Exit;
        end;
      end;
    
      if Mediator<>nil then
      begin
        Handled:=false;
        Mediator.MouseUp(Button,Shift,MouseUpPos,Handled);
        if Handled then exit;
      end;
    
      if Button=mbLeft 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
          else
            ControlSelection.UpdateBounds;
        end else
        begin
          // create new a component on the form
          AddComponent;
        end;
      end
      else
      if Button=mbRight 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);
        FDesignerPopupMenu.Popup(PopupPos.X, PopupPos.Y);
      end;
    
      DisableRubberBand;
    
      LastMouseMovePos.X:=-1;
      if (not ControlSelection.OnlyVisualComponentsSelected and ShowComponentCaptions) or
         (dfHasSized in FFlags) then
        Form.Invalidate;
      Exclude(FFlags,dfHasSized);
    
      MouseDownComponent:=nil;
      MouseDownSender:=nil;
      {$IFDEF VerboseDesigner}
      DebugLn('[TDesigner.MouseLeftUpOnControl] END');
      {$ENDIF}
    end;
    
    procedure TDesigner.MouseMoveOnControl(Sender: TControl;
      var TheMessage: TLMMouse);
    var
      Button: TMouseButton;
      Shift : TShiftState;
      SenderParentForm:TCustomForm;
      OldMouseMovePos: TPoint;
      Grabber: TGrabber;
      ACursor: TCursor;
      SelectedCompClass: TRegisteredComponent;
      CurSnappedMousePos, OldSnappedMousePos: TPoint;
      DesignSender: TControl;
      Handled: Boolean;
    begin
      GetMouseMsgShift(TheMessage, Shift, Button);
    
      if [dfShowEditorHints] * FFlags <> [] then
      begin
        FHintTimer.Enabled := False;
        // hide hint
        FHintTimer.Enabled := Shift * [ssLeft, ssRight, ssMiddle] = [];
        if not (dfHasSized in FFlags) then
          FHintWindow.Visible := False;
      end;
    
      DesignSender := GetDesignControl(Sender);
      //DebugLn('TDesigner.MouseMoveOnControl Sender=',dbgsName(Sender),' ',dbgsName(DesignSender));
      SenderParentForm := 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 (MouseDownComponent <> nil) and (MouseDownComponent is TControl) then
      begin
        if TControl(MouseDownComponent).Perform(CM_DESIGNHITTEST, 0, Longint(SmallPoint(LastMouseMovePos.X, LastMouseMovePos.Y))) > 0 then
        begin
          TControlAccess(MouseDownComponent).MouseMove(Shift, LastMouseMovePos.X, LastMouseMovePos.Y);
          Exit;
        end;
      end;
    
      if Mediator <> nil then
      begin
        Handled := False;
        Mediator.MouseMove(Shift, LastMouseMovePos, Handled);
        if Handled then Exit;
      end;
    
      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
          ACursor := Grabber.Cursor;
    
        if ACursor <> LastFormCursor then
        begin
          LastFormCursor := ACursor;
          SetTempCursor(Form, ACursor);
        end;
        Exit;
      end;
    
      if (ControlSelection.SelectionForm = nil) or (ControlSelection.SelectionForm = Form) then
      begin
        if Button = mbLeft then // left button pressed
        begin
          if (ControlSelection.ActiveGrabber <> nil) then // grabber active => resizing
          begin
            // grabber moving -> size selection
            if not ControlSelection.LookupRootSelected then // if not current form is selected then resize selection
            begin
              if not (dfHasSized in FFlags) then
              begin
                ControlSelection.SaveBounds;
                Include(FFlags, dfHasSized);
              end;
              // skip snapping when Alt is pressed
              if not (ssAlt in Shift) then
              begin
                OldSnappedMousePos := ControlSelection.SnapGrabberMousePos(OldMouseMovePos);
                CurSnappedMousePos := ControlSelection.SnapGrabberMousePos(LastMouseMovePos);
              end
              else
              begin
                OldSnappedMousePos := OldMouseMovePos;
                CurSnappedMousePos := LastMouseMovePos;
              end;
              ControlSelection.SizeSelection(
                CurSnappedMousePos.X - OldSnappedMousePos.X,
                CurSnappedMousePos.Y - OldSnappedMousePos.Y);
              DoModified;
            end;
          end
          else
          begin // no grabber active => moving
            SelectedCompClass := GetSelectedComponentClass;
            if (not ControlSelection.RubberBandActive) and
               (SelectedCompClass=nil) and
               ((Shift=[ssLeft]) or (Shift=[ssAlt, ssLeft])) 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 ((ssAlt in Shift) and ControlSelection.MoveSelection(LastMouseMovePos.X - MouseDownPos.X, LastMouseMovePos.Y - MouseDownPos.Y, True)) or
                 ControlSelection.MoveSelectionWithSnapping(LastMouseMovePos.X - MouseDownPos.X, LastMouseMovePos.Y - MouseDownPos.Y) then
                DoModified;
            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
          ControlSelection.ActiveGrabber:=nil;
      end;
      if [dfShowEditorHints, dfHasSized] * FFlags = [dfShowEditorHints, dfHasSized] then
        HintTimer(Self);
    end;
    
    
    {
    -----------------------------K E Y D O W N -------------------------------
    }
    {
      Handles the keydown messages.  DEL deletes the selected controls, CTRL-ARROR
      moves the selection up one, SHIFT-ARROW resizes, etc.
    }
    Procedure TDesigner.KeyDown(Sender : TControl; var TheMessage: TLMKEY);
    var
      Shift: TShiftState;
      Command: word;
      Handled: boolean;
      
      procedure Nudge(x, y: integer);
      begin
        if (ssCtrl in Shift) then
        begin
          if ssShift in Shift then
          begin
            x := x * GetGridSizeX;
            y := y * GetGridSizeY;
          end;
          NudgePosition(x, y)
        end
        else
        if (ssShift in Shift) then
          NudgeSize(x, y)
        else
        if (Shift = []) then
          NudgeSelection(x, y);
      end;
    
    begin
      {$IFDEF VerboseDesigner}
      DebugLn(['TDesigner.KEYDOWN ',TheMessage.CharCode,' ',TheMessage.KeyData]);
      {$ENDIF}
    
      Shift := KeyDataToShiftState(TheMessage.KeyData);
    
      Handled := False;
    
      if Mediator<>nil then
        Mediator.KeyDown(Sender,TheMessage.CharCode,Shift);
    
      Command := FTheFormEditor.TranslateKeyToDesignerCommand(
                                                        TheMessage.CharCode, Shift);
      //DebugLn(['TDesigner.KEYDOWN Command=',dbgs(Command),' ',TheMessage.CharCode,' ',dbgs(Shift)]);
      DoProcessCommand(Self, Command, Handled);
      //DebugLn(['TDesigner.KeyDown Command=',Command,' Handled=',Handled,' TheMessage.CharCode=',TheMessage.CharCode]);
    
      if not Handled 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_TAB:
            if Shift = [ssShift] then
              NudgeSelection(False)
            else
            if Shift = [] then
              NudgeSelection(True)
            else
              Handled := False;
    
          VK_RETURN:
            if Shift = [] then
              DoShowObjectInspector
            else
              Handled := False;
    
          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);
    var
      Shift: TShiftState;
    Begin
      {$IFDEF VerboseDesigner}
      //Writeln('TDesigner.KEYUP ',TheMessage.CharCode,' ',TheMessage.KeyData);
      {$ENDIF}
      if Mediator<>nil then begin
        Shift := KeyDataToShiftState(TheMessage.KeyData);
        Mediator.KeyUp(Sender,TheMessage.CharCode,Shift);
      end;
    end;
    
    function TDesigner.DoDeleteSelectedPersistents: boolean;
    var
      i: integer;
      APersistent: TPersistent;
      AncestorRoot: TComponent;
      AComponent: TComponent;
    begin
      Result:=true;
      if (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,
           [mbOk],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, [mbOk],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, [mbOk],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;
      AComponent: TComponent;
      AForm: TCustomForm;
    begin
      if APersistent=nil then exit;
      try
        //debugln(['TDesigner.DoDeletePersistent A ',dbgsName(APersistent),' FreeIt=',FreeIt]);
        PopupMenuComponentEditor:=nil;
        // unselect component
        ControlSelection.Remove(APersistent);
        if (APersistent is TComponent) then begin
          AComponent:=TComponent(APersistent);
          if csDestroying in AComponent.ComponentState then
            FreeIt:=false;
        end;
        AForm:=GetDesignerForm(APersistent);
        if AForm=nil then begin
          // has no designer
          // -> do not call handlers and simply get rid of the rubbish
          if FreeIt then begin
            //debugln('TDesigner.DoDeletePersistent UNKNOWN in formeditor: ',dbgsName(APersistent));
            APersistent.Free;
          end;
          exit;
        end;
        // call component deleting handlers
        Hook:=GetPropertyEditorHook;
        if Hook<>nil then
          Hook.PersistentDeleting(APersistent);
        // delete component
        if APersistent is TComponent then
          TheFormEditor.DeleteComponent(TComponent(APersistent),FreeIt)
        else if FreeIt then
          APersistent.Free;
      finally
        // unmark component
        DeletingPersistent.Remove(APersistent);
        IgnoreDeletingPersistent.Remove(APersistent);
      end;
      // 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);
          LM_CONTEXTMENU: HandlePopupMenu(Sender, TLMContextMenu(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;
      DoModified;
      inherited Modified;
    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;
      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.BeginPainting;
      try
        // exclude all child control areas
        Count:=AWinControl.ControlCount;
        for i := 0 to Count - 1 do begin
          with AWinControl.Controls[I] do begin
            if (Visible or ((csDesigning in ComponentState)
              and not (csNoDesignVisible in ControlStyle)))
            then begin
              Clip := ExcludeClipRect(aDDC.DC, Left, Top, Left + Width, Top + Height);
              if Clip = NullRegion then exit;
            end;
          end;
        end;
    
        // paint points
        if ShowGrid then
        begin
          ADDC.Canvas.Pen.Color := GridColor;
          ADDC.Canvas.Pen.Width := 1;
          ADDC.Canvas.Pen.Style := psSolid;
          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];
            if csNoDesignSelectable in CurControl.ControlStyle then
              Continue;
            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.EndPainting;
      end;
    end;
    
    procedure TDesigner.ValidateRename(AComponent: TComponent;
      const CurName, NewName: string);
    begin
      // check if component is initialized
      if (CurName='') or (NewName='')
      or ((AComponent<>nil) and (csDestroying in AComponent.ComponentState)) then
        exit;
    
      // check if component is the LookupRoot
      if AComponent=nil then AComponent:=FLookupRoot;
    
      // consistency check
      if CurName<>AComponent.Name then
        DebugLn('WARNING: TDesigner.ValidateRename: OldComponentName="',CurName,'" <> AComponent=',dbgsName(AComponent));
      if Assigned(OnRenameComponent) then
        OnRenameComponent(Self,AComponent,NewName);
    end;
    
    function TDesigner.GetShiftState: TShiftState;
    begin
      Result:=FShiftState;
    end;
    
    function TDesigner.CreateUniqueComponentName(const AClassName: string): string;
    begin
      Result:=TheFormEditor.CreateUniqueComponentName(AClassName,FLookupRoot);
    end;
    
    procedure TDesigner.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.OnCenterFormMenuClick(Sender: TObject);
    var
      NewLeft: Integer;
      NewTop: Integer;
    begin
      if Form=nil then exit;
      NewLeft:=Max(30,(Screen.Width-Form.Width) div 2);
      NewTop:=Max(30,(Screen.Height-Form.Height) div 2);
      Form.SetBounds(NewLeft,NewTop,Form.Width,Form.Height);
    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.SetMediator(const AValue: TDesignerMediator);
    begin
      if Mediator=AValue then exit;
      if Mediator<>nil then Mediator.Designer:=nil;
      FMediator:=AValue;
      if Mediator<>nil then Mediator.Designer:=Self;
    end;
    
    procedure TDesigner.SetPopupMenuComponentEditor(const AValue: TBaseComponentEditor);
    begin
       if FPopupMenuComponentEditor <> AValue then
       begin
         FPopupMenuComponentEditor.Free;
         FPopupMenuComponentEditor := AValue;
       end;
    end;
    
    procedure TDesigner.SetShowEditorHints(const AValue: boolean);
    begin
      if AValue = ShowEditorHints then Exit;
      if AValue then
        Include(FFlags, dfShowEditorHints)
      else
        Exclude(FFlags, dfShowEditorHints);
    end;
    
    procedure TDesigner.DrawNonVisualComponent(AComponent: TComponent);
    var
      Icon: TBitmap;
      ItemLeft, ItemTop, ItemRight, ItemBottom: integer;
      Diff, ItemLeftTop: TPoint;
      OwnerRect, IconRect, TextRect: TRect;
      TextSize: TSize;
      IsSelected: Boolean;
      RGN: HRGN;
    begin
      if (AComponent is TControl)
      and (csNoDesignVisible in TControl(AComponent).ControlStyle) then
        exit;
    
      // draw children
      if (AComponent.Owner=nil) then
      begin
        FDDC.BeginPainting;
        TComponentAccess(AComponent).GetChildren(@DrawNonVisualComponent, AComponent);
        FDDC.EndPainting;
      end
      else if (csInline in AComponent.ComponentState) then
      begin
        if AComponent is TControl then
        begin
          // clip to client area
          FDDC.BeginPainting;
          FDDC.Canvas.SaveHandleState;
          OwnerRect := TControl(AComponent).ClientRect;
          Diff := GetParentFormRelativeClientOrigin(AComponent);
          OffsetRect(OwnerRect, Diff.X, Diff.Y);
          with OwnerRect do
            RGN := CreateRectRGN(Left, Top, Right, Bottom);
          SelectClipRGN(FDDC.DC, RGN);
          DeleteObject(RGN);
        end;
        TComponentAccess(AComponent).GetChildren(@DrawNonVisualComponent, AComponent);
        if AComponent is TControl then
        begin
          FDDC.Canvas.RestoreHandleState;
          FDDC.EndPainting;
        end;
      end
      else
        TComponentAccess(AComponent).GetChildren(@DrawNonVisualComponent, AComponent.Owner);
    
      if not ComponentIsIcon(AComponent) or (AComponent.Owner = nil) then
        Exit;
      // actual draw
      Diff := FDDC.FormOrigin;
      //DebugLn(['FDDC.FormOrigin - ', Diff.X, ' : ' ,Diff.Y]);
      // non-visual component
      ItemLeftTop := NonVisualComponentLeftTop(AComponent);
      ItemLeft := ItemLeftTop.X - Diff.X;
      ItemTop := ItemLeftTop.Y - Diff.Y;
      ItemRight := ItemLeft + NonVisualCompWidth;
      ItemBottom := ItemTop + NonVisualCompWidth;
      if not FDDC.RectVisible(ItemLeft, ItemTop, ItemRight, ItemBottom) then
        Exit;
    
      IsSelected := ControlSelection.IsSelected(AComponent);
    
      if FSurface = nil then
      begin
        FSurface := TBitmap.Create;
        FSurface.SetSize(NonVisualCompWidth, NonVisualCompWidth);
        FSurface.Canvas.Brush.Color := clBtnFace;
        FSurface.Canvas.Pen.Width := 1;
      end;
    
      IconRect := Rect(0, 0, NonVisualCompWidth, NonVisualCompWidth);
      FSurface.Canvas.Frame3D(IconRect, 1, bvRaised);
      FSurface.Canvas.FillRect(IconRect);
      if NonVisualCompBorder > 1 then
        InflateRect(IconRect, -NonVisualCompBorder + 1, -NonVisualCompBorder + 1);
    
      // draw component Name
      if ShowComponentCaptions
      and (((GetKeyState(VK_LBUTTON) and $80) = 0) or not IsSelected) then
      begin
        // workarounds gtk2 problem with DrawText on gc with GDK_INCLUDE_INFERIORS
        // it uses pango drawing and this for some reason does not take subwindow_mode
        // into account
        Icon := TBitmap.Create;
        try
          TextSize := FDDC.Canvas.TextExtent(AComponent.Name);
          Icon.SetSize(TextSize.cx, TextSize.cy);
          TextRect := Rect(0, 0, TextSize.cx, TextSize.cy);
          if FDDC.Form <> nil then
            Icon.Canvas.Brush.Color := FDDC.Form.Canvas.Brush.Color
          else
            Icon.Canvas.Brush.Color := clBtnFace;
          Icon.Canvas.FillRect(TextRect);
          DrawText(Icon.Canvas.Handle, PChar(AComponent.Name), -1, TextRect,
            DT_CENTER or DT_VCENTER or DT_SINGLELINE or DT_NOCLIP);
          FDDC.Canvas.Draw(
            (ItemLeft + ItemRight - TextSize.cx) div 2,
            ItemBottom + NonVisualCompBorder + 2, Icon);
        finally
          Icon.Free;
        end;
      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;
          FSurface.Canvas.StretchDraw(IconRect, Icon);
        end;
      end;
      FDDC.Canvas.Draw(ItemLeft, ItemTop, FSurface);
      if (ControlSelection.Count > 1) and IsSelected then
        ControlSelection.DrawMarkerAt(FDDC,
          ItemLeft, ItemTop, NonVisualCompWidth, NonVisualCompWidth);
    end;
    
    procedure TDesigner.DrawNonVisualComponents(aDDC: TDesignerDeviceContext);
    begin
      FSurface := nil;
      FDDC := aDDC;
      DrawNonVisualComponent(FLookupRoot);
      FDDC := nil;
      if FSurface <> nil then
        FSurface.Free;
    end;
    
    procedure TDesigner.DrawDesignerItems(OnlyIfNeeded: boolean);
    var
      DesignerDC: HDC;
    begin
      if WidgetSet.GetLCLCapability(lcCanDrawOutsideOnPaint) = 0 then Exit;
      if OnlyIfNeeded and (not (dfNeedPainting in FFlags)) then exit;
      Exclude(FFlags,dfNeedPainting);
    
      if (Form=nil) or (not Form.HandleAllocated) then exit;
    
      //writeln('TDesigner.DrawDesignerItems B painting');
      DesignerDC := GetDesignerDC(Form.Handle);
      DDC.SetDC(Form, Form, DesignerDC);
      DDC.BeginPainting;
      DoPaintDesignerItems;
      DDC.EndPainting;
      DDC.Clear;
      ReleaseDesignerDC(Form.Handle, DesignerDC);
    end;
    
    procedure TDesigner.CheckFormBounds;
    // check if the Form was moved or resized
    // Note: During form loading the window manager can resize and position
    //       the Form. Such initial changes are ignored, by waiting and comparing
    //       not before the IDE becomes idle. When the IDE becomes the first time
    //       idle, the form bounds are stored and used as default.
    //       After that any change of the Form Bounds is treated as a user move
    //       and thus calls Modified.
    var
      NewFormBounds: TRect;
    begin
      NewFormBounds:=Form.BoundsRect;
      if FDefaultFormBoundsValid then begin
        if (not 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.ComponentIsIcon(AComponent: TComponent): boolean;
    begin
      Result:=DesignerProcs.ComponentIsNonVisual(AComponent);
      if Result and (Mediator<>nil) then
        Result:=Mediator.ComponentIsIcon(AComponent);
    end;
    
    function TDesigner.GetParentFormRelativeClientOrigin(AComponent: TComponent): TPoint;
    var
      CurClientArea: TRect;
      ScrollOffset: TPoint;
    begin
      if Mediator<>nil then begin
        Result:=Mediator.GetComponentOriginOnForm(AComponent);
        Mediator.GetClientArea(AComponent,CurClientArea,ScrollOffset);
        inc(Result.X,CurClientArea.Left+ScrollOffset.X);
        inc(Result.Y,CurClientArea.Top+ScrollOffset.Y);
      end else begin
        Result:=DesignerProcs.GetParentFormRelativeClientOrigin(AComponent);
      end;
    end;
    
    function TDesigner.GetDesignedComponent(AComponent: TComponent): TComponent;
    begin
      Result:=AComponent;
      if AComponent=Form then begin
        Result:=FLookupRoot;
      end else begin
        while (Result<>nil)
        and (Result<>FLookupRoot)
        and (Result.Owner<>FLookupRoot)
        and (Result is TControl) do
          Result:=TControl(Result).Parent;
      end;
    end;
    
    function TDesigner.GetComponentEditorForSelection: TBaseComponentEditor;
    begin
      Result := nil;
      if (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 ClearOldOnes then
        DesignerMenuSectionComponentEditor.Clear;
    
      if (AComponentEditor = nil) or (DesignerMenuSectionComponentEditor = nil) then
        Exit;
    
      VerbCount := AComponentEditor.GetVerbCount;
      for i := 0 to VerbCount - 1 do
      begin
        NewMenuCmd:=RegisterIDEMenuCommand(DesignerMenuSectionComponentEditor,
          'ComponentEditorVerMenuItem' + IntToStr(i),
          AComponentEditor.GetVerb(i),
          @OnComponentEditorVerbMenuItemClick);
        if NewMenuCmd.MenuItem<>nil then
          AComponentEditor.PrepareItem(i, NewMenuCmd.MenuItem);
      end;
    end;
    
    function TDesigner.NonVisualComponentAtPos(X, Y: integer): TComponent;
    var
      s: TComponentSearch;
    begin
      s := TComponentSearch.Create(nil);
      try
        s.MinClass := TComponent;
        s.AtPos := Point(X,Y);
        s.IgnoreHidden := true;
        s.OnlyNonVisual := true;
        s.Search(FLookupRoot);
        s.Mediator := Mediator;
        Result := s.Best;
      finally
        s.Free;
      end;
    end;
    
    procedure TDesigner.MoveNonVisualComponentIntoForm(AComponent: TComponent);
    var
      X, Y: SmallInt;
    begin
      DesignInfoToLeftTop(AComponent.DesignInfo, X, Y);
      AComponent.DesignInfo := LeftTopToDesignInfo(X, Y);
    end;
    
    procedure TDesigner.MoveNonVisualComponentsIntoForm;
    var
      i: Integer;
      AComponent: TComponent;
    begin
      for i:=0 to FLookupRoot.ComponentCount-1 do begin
        AComponent:=FLookupRoot.Components[i];
        if ComponentIsIcon(AComponent) then begin
          MoveNonVisualComponentIntoForm(AComponent);
        end;
      end;
    end;
    
    function TDesigner.ComponentClassAtPos(const AClass: TComponentClass;
      const APos: TPoint; const UseRootAsDefault, IgnoreHidden: boolean): TComponent;
    var
      s: TComponentSearch;
      MediatorFlags: TDMCompAtPosFlags;
    begin
      if Mediator <> nil then
      begin
        MediatorFlags := [];
        if IgnoreHidden then
          Include(MediatorFlags, dmcapfOnlyVisible);
        Result := Mediator.ComponentAtPos(APos,AClass,MediatorFlags);
      end
      else
      begin
        s := TComponentSearch.Create(nil);
        try
          s.AtPos := APos;
          s.MinClass := AClass;
          s.IgnoreHidden := IgnoreHidden;
          s.Search(FLookupRoot);
          s.Mediator := Mediator;
          Result := s.Best;
        finally
          s.Free;
        end;
      end;
    
      if (Result = nil) and UseRootAsDefault and (FLookupRoot.InheritsFrom(AClass)) then
        Result := LookupRoot;
    end;
    
    procedure TDesigner.SetTempCursor(ARoot: TWinControl; ACursor: TCursor);
    
      procedure Traverse(ARoot: TWinControl);
      var
        i: integer;
      begin
        for i := 0 to ARoot.ControlCount - 1 do
        begin
          ARoot.Controls[i].SetTempCursor(ACursor);
          if ARoot.Controls[i] is TWinControl then
            Traverse(TWinControl(ARoot.Controls[i]));
        end;
      end;
    
    begin
      Traverse(ARoot);
      ARoot.SetTempCursor(ACursor);
    end;
    
    function TDesigner.WinControlAtPos(x, y: integer; UseRootAsDefault,
      IgnoreHidden: boolean): TWinControl;
    begin
      Result := TWinControl(ComponentClassAtPos(TWinControl, Point(x,y),
                                                UseRootAsDefault, IgnoreHidden));
    end;
    
    function TDesigner.ControlAtPos(x, y: integer; UseRootAsDefault,
      IgnoreHidden: boolean): TControl;
    begin
      Result := TControl(ComponentClassAtPos(TControl, Point(x,y), UseRootAsDefault,
                                    IgnoreHidden));
    end;
    
    function TDesigner.ComponentAtPos(x, y: integer; UseRootAsDefault,
      IgnoreHidden: boolean): TComponent;
    begin
      Result := ComponentClassAtPos(TComponent, Point(x,y), UseRootAsDefault,
                                    IgnoreHidden);
    end;
    
    procedure TDesigner.BuildPopupMenu;
    begin
      if FDesignerPopupMenu = nil then
      begin
        FDesignerPopupMenu:=TPopupMenu.Create(nil);
        with FDesignerPopupMenu do
        begin
          Name := 'DesignerPopupmenu';
          OnPopup := @DesignerPopupMenuPopup;
          Images := IDEImages.Images_16;
        end;
      end;
      
    
      // assign the root TMenuItem to the registered menu root.
      // This will automatically create all registered items
      {$IFDEF VerboseMenuIntf}
      DesignerPopupMenu.Items.WriteDebugReport('TSourceNotebook.BuildPopupMenu ');
      DesignerMenuRoot.ConsistencyCheck;
      {$ENDIF}
      DesignerMenuRoot.MenuItem := FDesignerPopupMenu.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;
      DesignerMenuCenterForm.OnClick:=@OnCenterFormMenuClick;
    
      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);
    
      function GetComponentHintText(AComponent: TComponent): String;
      const
        HintNameStr = '%s: %s';
        HintPositionStr = 'Position: %d, %d';
        HintSizeStr = 'Size: %d x %d';
        HintTabStr = 'TabStop: %s; TabOrder: %d';
      var
        AControl: TControl absolute AComponent;
        AWinControl: TWinControl absolute AComponent;
        AComponentEditor:TBaseComponentEditor;
      begin
        // component name and classname
        Result := Format(HintNameStr, [AComponent.Name, AComponent.ClassName]);
        // component position
        Result := Result + LineEnding + Format(HintPositionStr, [GetComponentLeft(AComponent), GetComponentTop(AComponent)]);
        if AComponent is TControl then // more info for controls
        begin
          // size
          Result := Result + '; ' + Format(HintSizeStr, [AControl.Width, AControl.Height]);
          // and TabStop, TabOrder for TWinControl
          if (AComponent is TWinControl) and not (AComponent = Form) then
            Result := Result + LineEnding + Format(HintTabStr, [BoolToStr(AWinControl.TabStop, True), AWinControl.TabOrder]);
        end;
        AComponentEditor:=TheFormEditor.GetComponentEditor(AComponent);
        if AComponentEditor<>nil then
          Result := Result + AComponentEditor.GetCustomHint;
      end;
    
      function GetSelectionSizeHintText: String;
      begin
        Result := Format('%d x %d', [ControlSelection.Width, ControlSelection.Height]);
      end;
    
      function GetSelectionPosHintText: String;
    
        function ParentComponent(AComponent: TComponent): TComponent;
        begin
          Result := AComponent.GetParentComponent;
          if (Result = nil) and ComponentIsIcon(AComponent) then
            Result := AComponent.Owner;
        end;
    
      var
        BaseParent, TestParent: TComponent;
        BaseFound: Boolean;
        i: integer;
        P: TPoint;
      begin
        BaseFound := ControlSelection[0].IsTComponent;
        // search for one parent of our selection
        if BaseFound then
        begin
          BaseParent := ParentComponent(TComponent(ControlSelection[0].Persistent));
          BaseFound := BaseParent is TWinControl;
          if BaseFound then
          begin
            for i := 1 to ControlSelection.Count - 1 do
            begin
              if ControlSelection[0].IsTComponent then
                TestParent := ParentComponent(TComponent(ControlSelection[0].Persistent))
              else
                TestParent := nil;
              if TestParent <> BaseParent then
              begin
                BaseFound := False;
                Break;
              end;
            end;
          end;
        end;
        P := Point(ControlSelection.Left, ControlSelection.Top);
        if BaseFound then
          P := TWinControl(BaseParent).ScreenToClient(Form.ClientToScreen(P));
        Result := Format('%d, %d', [P.X, P.Y]);
      end;
    
    var
      Rect: TRect;
      AHint: String;
      Position, ClientPos: TPoint;
      AWinControl: TWinControl;
      AComponent: TComponent;
    begin
      FHintTimer.Enabled := False;
      if [dfShowEditorHints]*FFlags=[] then exit;
    
      Position := Mouse.CursorPos;
      if not (dfHasSized in FFlags) then
      begin
        AWinControl := FindLCLWindow(Position);
        if not (Assigned(AWinControl)) then Exit;
        if GetDesignerForm(AWinControl) <> Form then exit;
    
        // search a component at the position
        ClientPos := Form.ScreenToClient(Position);
        AComponent := ComponentAtPos(ClientPos.X,ClientPos.Y,true,true);
        if not Assigned(AComponent) then
          AComponent := AWinControl;
        AComponent := GetDesignedComponent(AComponent);
        if AComponent = nil then exit;
        AHint := GetComponentHintText(AComponent);
      end
      else
      begin
        // components are either resize or move
        if (ControlSelection.LookupRoot <> Form) or (ControlSelection.Count = 0) then
          Exit;
    
        if ControlSelection.ActiveGrabber <> nil then
          AHint := GetSelectionSizeHintText
        else
          AHint := GetSelectionPosHintText;
      end;
    
      Rect := FHintWindow.CalcHintRect(0, AHint, nil);  //no maxwidth
      Rect.Left := Position.X + 15;
      Rect.Top := Position.Y + 15;
      Rect.Right := Rect.Left + Rect.Right;
      Rect.Bottom := Rect.Top + Rect.Bottom;
    
      FHintWindow.ActivateHint(Rect, AHint);
    end;
    
    procedure TDesigner.SetSnapToGrid(const AValue: boolean);
    begin
      if SnapToGrid=AValue then exit;
      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.
    
    
    Designer.pp (127,322 bytes)
  • componenteditors.patch (1,023 bytes)
    --- lazarus/ideintf/componenteditors.pas 
    +++ lazarus.old/ideintf/componenteditors.pas 
    @@ -174,6 +174,7 @@
         function GetComponent: TComponent; virtual; abstract;
         function GetDesigner: TComponentEditorDesigner; virtual; abstract;
         function GetHook(out Hook: TPropertyEditorHook): boolean; virtual; abstract;
    +    function GetCustomHint:String; virtual; abstract;
         procedure Modified; virtual; abstract;
       end;
     
    @@ -205,6 +206,7 @@
         property Component: TComponent read FComponent;
         property Designer: TComponentEditorDesigner read GetDesigner;
         function GetHook(out Hook: TPropertyEditorHook): boolean; override;
    +    function GetCustomHint: String; override;
         function HasHook: boolean;
         procedure Modified; override;
       end;
    @@ -546,6 +548,11 @@
       if GetDesigner=nil then exit;
       Hook:=GetDesigner.PropertyEditorHook;
       Result:=Hook<>nil;
    +end;
    +
    +function TComponentEditor.GetCustomHint: String;
    +begin
    +  Result:=LineEnding;
     end;
     
     function TComponentEditor.HasHook: boolean;
    
    componenteditors.patch (1,023 bytes)
  • designer.patch (808 bytes)
    --- lazarus/designer/designer.pp 
    +++ lazarus.old/designer/designer.pp 
    @@ -3697,6 +3697,7 @@
       var
         AControl: TControl absolute AComponent;
         AWinControl: TWinControl absolute AComponent;
    +    AComponentEditor:TBaseComponentEditor;
       begin
         // component name and classname
         Result := Format(HintNameStr, [AComponent.Name, AComponent.ClassName]);
    @@ -3710,6 +3711,9 @@
           if (AComponent is TWinControl) and not (AComponent = Form) then
             Result := Result + LineEnding + Format(HintTabStr, [BoolToStr(AWinControl.TabStop, True), AWinControl.TabOrder]);
         end;
    +    AComponentEditor:=TheFormEditor.GetComponentEditor(AComponent);
    +    if AComponentEditor<>nil then
    +      Result := Result + AComponentEditor.GetCustomHint;
       end;
     
       function GetSelectionSizeHintText: String;
    
    designer.patch (808 bytes)

Activities

2010-08-19 19:09

 

ComponentEditors.pas (38,295 bytes)
{
 *****************************************************************************
 *                                                                           *
 *  See the file COPYING.modifiedLGPL.txt, included in this distribution,    *
 *  for details about the copyright.                                         *
 *                                                                           *
 *  This program 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.                     *
 *                                                                           *
 *****************************************************************************

  Author: Mattias Gaertner

  Abstract:
    This units defines the component editors used by the designer.
    A Component Editor is a plugin used by the designer to add special
    functions for component classes.
    For more information see the big comment part below.
}
unit ComponentEditors;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, LResources, TypInfo, LCLProc, Forms, Controls, Menus,
  ExtCtrls, CustomTimer, StdCtrls, Graphics, Grids, CheckLst, Buttons, ComCtrls, Dialogs,
  LazStringGridEdit, CheckListboxEditorDlg, CheckGroupEditorDlg, GraphType,
  PropEdits, PropEditUtils,
  ObjInspStrConsts;

type
  { TComponentEditorDesigner }
  
  TComponentPasteSelectionFlag = (
    cpsfReplace,
    cpsfFindUniquePositions
    );
  TComponentPasteSelectionFlags = set of TComponentPasteSelectionFlag;
  TComponentEditorDesignerHookType = (
    cedhtModified
    );

  TComponentEditorDesigner = class(TIDesigner)
  private
    FChangeStamp: int64;
  protected
    FForm: TCustomForm;
    FHandlers: array[TComponentEditorDesignerHookType] of TMethodList;
    function GetPropertyEditorHook: TPropertyEditorHook; virtual; abstract;
    function GetHandlerCount(HookType: TComponentEditorDesignerHookType): integer;
    procedure AddHandler(HookType: TComponentEditorDesignerHookType; const Handler: TMethod);
    procedure RemoveHandler(HookType: TComponentEditorDesignerHookType; const Handler: TMethod);
  public
    destructor Destroy; override;
    procedure Modified; override;
    function CopySelection: boolean; virtual; abstract;
    function CutSelection: boolean; virtual; abstract;
    function CanPaste: boolean; virtual; abstract;
    function PasteSelection(Flags: TComponentPasteSelectionFlags): boolean; virtual; abstract;
    function DeleteSelection: boolean; virtual; abstract;
    function CopySelectionToStream(s: TStream): boolean; virtual; abstract;
    function InsertFromStream(s: TStream; Parent: TWinControl;
                              Flags: TComponentPasteSelectionFlags
                              ): Boolean; virtual; abstract;
    function InvokeComponentEditor(AComponent: TComponent;
                                   MenuIndex: integer): boolean; virtual; abstract;

    procedure DrawDesignerItems(OnlyIfNeeded: boolean); virtual; abstract;
    function CreateUniqueComponentName(const AClassName: string
                                       ): string; virtual; abstract;
    property PropertyEditorHook: TPropertyEditorHook read GetPropertyEditorHook;
    property Form: TCustomForm read FForm;
    property ChangeStamp: int64 read FChangeStamp;// increased on calling Modified
  public
    // Handlers
    procedure RemoveAllHandlersForObject(const HandlerObject: TObject);
    procedure AddHandlerModified(const OnModified: TNotifyEvent);
    procedure RemoveHandlerModified(const OnModified: TNotifyEvent);
  end;


{ Component Editor Types }

type

{ TComponentEditor
  A component editor is created for each component that is selected in the
  form designer based on the component's type (see GetComponentEditor and
  RegisterComponentEditor). When the component is double-clicked the Edit
  method is called. When the context menu for the component is invoked the
  GetVerbCount and GetVerb methods are called to build the menu. If one
  of the verbs are selected, ExecuteVerb is called. Paste is called whenever
  the component is pasted to the clipboard. You only need to create a
  component editor if you wish to add verbs to the context menu, change
  the default double-click behavior, or paste an additional clipboard format.
  The default component editor (TDefaultEditor) implements Edit to searches the
  properties of the component and generates (or navigates to) the OnCreate,
  OnChanged, or OnClick event (whichever it finds first). Whenever the
  component editor modifies the component, it *must* call Designer.Modified to
  inform the designer that the form has been modified. (Or else the user can not
  save the changes).

    Edit
      Called when the user double-clicks the component. The component editor can
      bring up a dialog in response to this method, for example, or some kind
      of design expert. If GetVerbCount is greater than zero, edit will execute
      the first verb in the list (ExecuteVerb(0)).

    ExecuteVerb(Index)
      The Index'ed verb was selected by the use off the context menu. The
      meaning of this is determined by component editor.

    GetVerb
      The component editor should return a string that will be displayed in the
      context menu. It is the responsibility of the component editor to place
      the & character and the '...' characters as appropriate.

    GetVerbCount
      The number of valid indices to GetVerb and Execute verb. The index is
      assumed to be zero based (i.e. 0..GetVerbCount - 1).

    PrepareItem
      While constructing the context menu PrepareItem will be called for
      each verb. It will be passed the menu item that will be used to represent
      the verb. The component editor can customize the menu item as it sees fit,
      including adding subitems. If you don't want that particular menu item
      to be shown, don't free it, simply set its Visible property to False.

    Copy
      Called when the component is being copied to the clipboard. The
      component's filed image is already on the clipboard. This gives the
      component editor a chance to paste a different type of format which is
      ignored by the designer but might be recognized by another application.

    IsInInlined
      Determines whether Component is in the Designer which owns it.
      Essentially, Components should not be able to be added to a Frame
      instance (collections are fine though) so this function checks to
      determine whether the currently selected component is within a Frame
      instance or not.

    GetComponent
      Returns the edited component.

    GetDesigner
      Returns the current Designer for the form owning the component.
    }

{ TComponentEditor
  All component editors are assumed derived from TBaseComponentEditor.

    Create(AComponent, ADesigner)
      Called to create the component editor. AComponent is the component to
      be edited by the editor. ADesigner is an interface to the designer to
      find controls and create methods (this is not used often). If a component
      editor modifies the component in any way it *must* call
      ADesigner.Modified. }

  TBaseComponentEditor = class
  protected
  public
    constructor Create(AComponent: TComponent;
      ADesigner: TComponentEditorDesigner); virtual;
    procedure Edit; virtual; abstract;
    procedure ExecuteVerb(Index: Integer); virtual; abstract;
    function GetVerb(Index: Integer): string; virtual; abstract;
    function GetVerbCount: Integer; virtual; abstract;
    procedure PrepareItem(Index: Integer; const AnItem: TMenuItem); virtual; abstract;
    procedure Copy; virtual; abstract;
    function IsInInlined: Boolean; virtual; abstract;
    function GetComponent: TComponent; virtual; abstract;
    function GetDesigner: TComponentEditorDesigner; virtual; abstract;
    function GetHook(out Hook: TPropertyEditorHook): boolean; virtual; abstract;
    function GetCustomHint:String; virtual; abstract;
    procedure Modified; virtual; abstract;
  end;

  TComponentEditorClass = class of TBaseComponentEditor;


{ TComponentEditor
  This class provides a default implementation for the IComponentEditor
  interface. There is no assumption by the designer that you use this class
  only that your class derive from TBaseComponentEditor and implement
  IComponentEditor. This class is provided to help you implement a class
  that meets those requirements. }
  TComponentEditor = class(TBaseComponentEditor)
  private
    FComponent: TComponent;
    FDesigner: TComponentEditorDesigner;
  public
    constructor Create(AComponent: TComponent;
      ADesigner: TComponentEditorDesigner); override;
    procedure Edit; override;
    procedure ExecuteVerb(Index: Integer); override;
    function GetComponent: TComponent; override;
    function GetDesigner: TComponentEditorDesigner; override;
    function GetVerb(Index: Integer): string; override;
    function GetVerbCount: Integer; override;
    function IsInInlined: Boolean; override;
    procedure Copy; override;
    procedure PrepareItem(Index: Integer; const AnItem: TMenuItem); override;
    property Component: TComponent read FComponent;
    property Designer: TComponentEditorDesigner read GetDesigner;
    function GetHook(out Hook: TPropertyEditorHook): boolean; override;
    function GetCustomHint: String; override;
    function HasHook: boolean;
    procedure Modified; override;
  end;


{ TDefaultComponentEditor
  An editor that provides default behavior for the double-click that will
  iterate through the properties looking for the most appropriate method
  property to edit }
  TDefaultComponentEditor = class(TComponentEditor)
  private
    FBestEditEvent: string;
    FFirst: TPropertyEditor;
    FBest: TPropertyEditor;
    FContinue: Boolean;
    FPropEditCandidates: TList; // list of TPropertyEditor
    procedure CheckEdit(Prop: TPropertyEditor);
  protected
    procedure EditProperty(const Prop: TPropertyEditor;
      var Continue: Boolean); virtual;
    procedure ClearPropEditorCandidates;
  public
    constructor Create(AComponent: TComponent;
      ADesigner: TComponentEditorDesigner); override;
    destructor Destroy; override;
    procedure Edit; override;
    function GetVerbCount: Integer; override;
    function GetVerb(Index: Integer): string; override;
    procedure ExecuteVerb(Index: Integer); override;
    property BestEditEvent: string read FBestEditEvent write FBestEditEvent;
  end;
           
  // to be "compatible" with delphi i've added the next line.
  // we're not 100% the same, but it might help some ppl.
  TDefaultEditor = TDefaultComponentEditor;
  
{ TNotebookComponentEditor
  The default component editor for TCustomNotebook. }
  TNotebookComponentEditor = class(TDefaultComponentEditor)
  protected
    procedure AddNewPageToDesigner(Index: integer); virtual;
    procedure DoAddPage; virtual;
    procedure DoInsertPage; virtual;
    procedure DoDeletePage; virtual;
    procedure DoMoveActivePageLeft; virtual;
    procedure DoMoveActivePageRight; virtual;
    procedure DoMovePage(CurIndex, NewIndex: Integer); virtual;
    procedure AddMenuItemsForPages(ParentMenuItem: TMenuItem); virtual;
    procedure ShowPageMenuItemClick(Sender: TObject);
  public
    procedure ExecuteVerb(Index: Integer); override;
    function GetVerb(Index: Integer): string; override;
    function GetVerbCount: Integer; override;
    procedure PrepareItem(Index: Integer; const AnItem: TMenuItem); override;
    function Notebook: TCustomNotebook; virtual;
  end;
  
  
{ TPageComponentEditor
  The default component editor for TCustomPage. }
  TPageComponentEditor = class(TNotebookComponentEditor)
  protected
  public
    function Notebook: TCustomNotebook; override;
    function Page: TCustomPage; virtual;
  end;


{ TTabControlComponentEditor
  The default component editor for TCustomTabControl. }
  TTabControlComponentEditor = class(TDefaultComponentEditor)
  protected
    procedure DoAddTab; virtual;
    procedure DoInsertTab; virtual;
    procedure DoDeleteTab; virtual;
    procedure DoMoveActiveTabLeft; virtual;
    procedure DoMoveActiveTabRight; virtual;
    procedure DoMoveTab(CurIndex, NewIndex: Integer); virtual;
    procedure AddMenuItemsForTabs(ParentMenuItem: TMenuItem); virtual;
    procedure ShowTabMenuItemClick(Sender: TObject);
    function CreateNewTabCaption: string;
  public
    procedure ExecuteVerb(Index: Integer); override;
    function GetVerb(Index: Integer): string; override;
    function GetVerbCount: Integer; override;
    procedure PrepareItem(Index: Integer; const AnItem: TMenuItem); override;
    function TabControl: TCustomTabControl; virtual;
  end;


{ TStringGridComponentEditor
  The default componenteditor for TStringGrid }

  TStringGridComponentEditor = class(TComponentEditor)
  public
    procedure ExecuteVerb(Index: Integer); override;
    function GetVerb(Index: Integer): string; override;
    function GetVerbCount: Integer; override;
  end;

{ TCheckListBoxComponentEditor
  The default componenteditor for TCheckListBox }

  TCheckListBoxComponentEditor = class(TComponentEditor)
  protected
    procedure DoShowEditor;
  public
    procedure ExecuteVerb(Index: Integer); override;
    function GetVerb(Index: Integer): string; override;
    function GetVerbCount: Integer; override;
  end;


{ TCheckGroupComponentEditor
  The default componenteditor for TCheckGroup }

  TCheckGroupComponentEditor = class(TDefaultComponentEditor)
  protected
    procedure DoShowEditor;
  public
    procedure ExecuteVerb(Index: Integer); override;
    function GetVerb(Index: Integer): string; override;
    function GetVerbCount: Integer; override;
  end;


{ TToolBarComponentEditor
  The default componenteditor for TToolBar }

  TToolBarComponentEditor = class(TDefaultComponentEditor)
  protected
  public
    procedure ExecuteVerb(Index: Integer); override;
    function GetVerb(Index: Integer): string; override;
    function GetVerbCount: Integer; override;
    function ToolBar: TToolBar; virtual;
  end;


{ TFileDialogComponentEditor
  The default componenteditor for TFileDialog }

  TCommonDialogComponentEditor = class(TComponentEditor)
  private
    procedure TestDialog;
  public
    function GetVerbCount:integer;override;
    function GetVerb(Index:integer):string;override;
    procedure ExecuteVerb(Index:integer);override;
  end;

  { TTimerComponentEditor }

  TTimerComponentEditor = class(TDefaultComponentEditor)
  public
    constructor Create(AComponent: TComponent;
      ADesigner: TComponentEditorDesigner); override;
  end;
  

{ Register a component editor }
type
  TRegisterComponentEditorProc =
    procedure (ComponentClass: TComponentClass;
               ComponentEditor: TComponentEditorClass);

var
  RegisterComponentEditorProc: TRegisterComponentEditorProc;


procedure RegisterComponentEditor(ComponentClass: TComponentClass;
  ComponentEditor: TComponentEditorClass);
function GetComponentEditor(Component: TComponent;
  const Designer: TComponentEditorDesigner): TBaseComponentEditor;

type
  TPropertyEditorFilterFunc =
    function(const ATestEditor: TPropertyEditor): Boolean of object;


implementation

{ RegisterComponentEditor }
type
  PComponentClassRec = ^TComponentClassRec;
  TComponentClassRec = record
    Group: Integer;
    ComponentClass: TComponentClass;
    EditorClass: TComponentEditorClass;
  end;

const
  ComponentClassList: TList = nil;

procedure DefaultRegisterComponentEditorProc(ComponentClass: TComponentClass;
  ComponentEditor: TComponentEditorClass);
var
  P: PComponentClassRec;
begin
  if ComponentClassList = nil then
    ComponentClassList := TList.Create;
  New(P);
  P^.Group := -1;//CurrentGroup;
  P^.ComponentClass := ComponentClass;
  P^.EditorClass := ComponentEditor;
  ComponentClassList.Insert(0, P);
end;

procedure RegisterComponentEditor(ComponentClass: TComponentClass;
  ComponentEditor: TComponentEditorClass);
begin
  if Assigned(RegisterComponentEditorProc) then
    RegisterComponentEditorProc(ComponentClass, ComponentEditor);
end;

function GetComponentEditor(Component: TComponent;
  const Designer: TComponentEditorDesigner): TBaseComponentEditor;
var
  P: PComponentClassRec;
  I: Integer;
  ComponentClass: TComponentClass;
  EditorClass: TComponentEditorClass;
begin
  ComponentClass := TComponentClass(TPersistent);
  EditorClass := TDefaultComponentEditor;
  if ComponentClassList <> nil then
    for I := 0 to ComponentClassList.Count-1 do
    begin
      P := PComponentClassRec(ComponentClassList[I]);
      //DebugLn('GetComponentEditor Component=',dbgsName(Component),' ',dbgsName(P^.ComponentClass),' ',dbgsName(P^.EditorClass));
      if (Component is P^.ComponentClass) and
        (P^.ComponentClass <> ComponentClass) and
        (P^.ComponentClass.InheritsFrom(ComponentClass)) then
      begin
        EditorClass := P^.EditorClass;
        ComponentClass := P^.ComponentClass;
      end;
    end;
  Result := EditorClass.Create(Component, Designer);
end;

{ Component Editors -----------------------------------------------------------}


{ TBaseComponentEditor }

constructor TBaseComponentEditor.Create(AComponent: TComponent;
  ADesigner: TComponentEditorDesigner);
begin
  inherited Create;
end;

{ TComponentEditor }

constructor TComponentEditor.Create(AComponent: TComponent;
  ADesigner: TComponentEditorDesigner);
begin
  inherited Create(AComponent, ADesigner);
  FComponent := AComponent;
  FDesigner := ADesigner;
end;

procedure TComponentEditor.Edit;
begin
  if GetVerbCount > 0 then ExecuteVerb(0);
end;

function TComponentEditor.GetComponent: TComponent;
begin
  Result := FComponent;
end;

function TComponentEditor.GetDesigner: TComponentEditorDesigner;
begin
  Result := FDesigner;
end;

function TComponentEditor.GetVerbCount: Integer;
begin
  // Intended for descendents to implement
  Result := 0;
end;

function TComponentEditor.GetVerb(Index: Integer): string;
begin
  // Intended for descendents to implement
  Result:=ClassName+IntToStr(Index);
end;

procedure TComponentEditor.ExecuteVerb(Index: Integer);
begin
  // Intended for descendents to implement
  DebugLn(Classname+'.ExecuteVerb: ',IntToStr(Index));
end;

procedure TComponentEditor.Copy;
begin
  // Intended for descendents to implement
end;

function TComponentEditor.IsInInlined: Boolean;
begin
  Result := csInline in Component.Owner.ComponentState;
end;

procedure TComponentEditor.PrepareItem(Index: Integer;
  const AnItem: TMenuItem);
begin
  // Intended for descendents to implement
end;

function TComponentEditor.GetHook(out Hook: TPropertyEditorHook): boolean;
begin
  Result:=false;
  Hook:=nil;
  if GetDesigner=nil then exit;
  Hook:=GetDesigner.PropertyEditorHook;
  Result:=Hook<>nil;
end;

function TComponentEditor.GetCustomHint: String;
begin
  Result:=LineEnding;
end;

function TComponentEditor.HasHook: boolean;
var
  Hook: TPropertyEditorHook;
begin
  Result:=GetHook(Hook) and (Hook<>nil);
end;

procedure TComponentEditor.Modified;
begin
  GetDesigner.Modified;
end;

{ TDefaultComponentEditor }

procedure TDefaultComponentEditor.CheckEdit(Prop: TPropertyEditor);
begin
  if FContinue then
    EditProperty(Prop, FContinue);
  if FPropEditCandidates=nil then
    FPropEditCandidates:=TList.Create;
  FPropEditCandidates.Add(Prop);
end;

procedure TDefaultComponentEditor.EditProperty(const Prop: TPropertyEditor;
  var Continue: Boolean);
var
  PropName: string;
  BestName: string;

  procedure ReplaceBest;
  begin
    FBest := Prop;
    if FFirst = FBest then
      FFirst := nil;
  end;

begin
  if not Assigned(FFirst) and (Prop is TMethodPropertyEditor) then
    FFirst := Prop;
  PropName := Prop.GetName;
  BestName := '';
  if Assigned(FBest) then
    BestName := FBest.GetName;
  // event priority is hardcoded:
  // first priority has OnCreate, then OnClick and OnChange is the last
  if CompareText(PropName, FBestEditEvent) = 0 then
    ReplaceBest
  else
  if CompareText(BestName, FBestEditEvent) <> 0 then
    if CompareText(PropName, 'ONCHANGE') = 0 then
      ReplaceBest
    else
    if CompareText(BestName, 'ONCHANGE') <> 0 then
      if CompareText(PropName, 'ONCLICK') = 0 then
        ReplaceBest;
end;

procedure TDefaultComponentEditor.ClearPropEditorCandidates;
var
  i: Integer;
begin
  if FPropEditCandidates=nil then exit;
  for i:=0 to FPropEditCandidates.Count-1 do
    TObject(FPropEditCandidates[i]).Free;
  FPropEditCandidates.Free;
  FPropEditCandidates:=nil;
end;

constructor TDefaultComponentEditor.Create(AComponent: TComponent;
  ADesigner: TComponentEditorDesigner);
begin
  inherited Create(AComponent, ADesigner);
  FBestEditEvent:='OnCreate';
end;

destructor TDefaultComponentEditor.Destroy;
begin
  ClearPropEditorCandidates;
  inherited Destroy;
end;

procedure TDefaultComponentEditor.Edit;
var
  PropertyEditorHook: TPropertyEditorHook;
  NewLookupRoot: TPersistent;
begin
  PropertyEditorHook:=nil;
  if not GetHook(PropertyEditorHook) then exit;
  NewLookupRoot:=GetLookupRootForComponent(Component);
  if not (NewLookupRoot is TComponent) then exit;
  if NewLookupRoot<>PropertyEditorHook.LookupRoot then
    GetDesigner.SelectOnlyThisComponent(Component);
  FContinue := True;
  FFirst := nil;
  FBest := nil;
  try
    GetPersistentProperties(Component,tkAny,PropertyEditorHook,@CheckEdit,nil);
    if FContinue
    then begin
      if Assigned(FBest) then
        FBest.Edit
      else if Assigned(FFirst) then
        FFirst.Edit;
    end;
  finally
    FFirst := nil;
    FBest := nil;
    ClearPropEditorCandidates;
  end;
end;

function TDefaultComponentEditor.GetVerbCount: Integer;
begin
  Result:=1;
end;

function TDefaultComponentEditor.GetVerb(Index: Integer): string;
begin
  Result:=oisCreateDefaultEvent;
end;

procedure TDefaultComponentEditor.ExecuteVerb(Index: Integer);
begin
  Edit;
end;


{ TNotebookComponentEditor }

const
  nbvAddPage       = 0;
  nbvInsertPage    = 1;
  nbvDeletePage    = 2;
  nbvMovePageLeft  = 3;
  nbvMovePageRight = 4;
  nbvShowPage      = 5;

procedure TNotebookComponentEditor.ShowPageMenuItemClick(Sender: TObject);
var
  AMenuItem: TMenuItem;
  NewPageIndex: integer;
begin
  AMenuItem:=TMenuItem(Sender);
  if (AMenuItem=nil) or (not (AMenuItem is TMenuItem)) then exit;
  NewPageIndex:=AMenuItem.MenuIndex;
  if (NewPageIndex<0) or (NewPageIndex>=Notebook.PageCount) then exit;
  NoteBook.PageIndex:=NewPageIndex;
  GetDesigner.SelectOnlyThisComponent(NoteBook.CustomPage(NoteBook.PageIndex));
end;

procedure TNotebookComponentEditor.AddNewPageToDesigner(Index: integer);
var
  Hook: TPropertyEditorHook;
  NewPage: TCustomPage;
  NewName: string;
begin
  Hook:=nil;
  if not GetHook(Hook) then exit;
  NewPage:=NoteBook.CustomPage(Index);
  NewName:=GetDesigner.CreateUniqueComponentName(NewPage.ClassName);
  NewPage.Caption:=NewName;
  NewPage.Name:=NewName;
  NoteBook.PageIndex:=Index;
  Hook.PersistentAdded(NewPage,true);
  Modified;
end;

procedure TNotebookComponentEditor.DoAddPage;
begin
  if not HasHook then exit;
  NoteBook.Pages.Add('');
  AddNewPageToDesigner(NoteBook.PageCount-1);
end;

procedure TNotebookComponentEditor.DoInsertPage;
var
  NewIndex: integer;
begin
  if not HasHook then exit;
  NewIndex:=Notebook.PageIndex;
  if NewIndex<0 then NewIndex:=0;
  Notebook.Pages.Insert(NewIndex,'');
  AddNewPageToDesigner(NewIndex);
end;

procedure TNotebookComponentEditor.DoDeletePage;
var
  Hook: TPropertyEditorHook;
  OldIndex: integer;
  PageComponent: TPersistent;
begin
  OldIndex:=Notebook.PageIndex;
  if (OldIndex>=0) and (OldIndex<Notebook.PageCount) then begin
    if not GetHook(Hook) then exit;
    PageComponent := TPersistent(NoteBook.Pages.Objects[OldIndex]);
    Hook.DeletePersistent(PageComponent);
  end;
end;

procedure TNotebookComponentEditor.DoMoveActivePageLeft;
var
  Index: integer;
begin
  Index:=NoteBook.PageIndex;
  if (Index<0) then exit;
  DoMovePage(Index,Index-1);
end;

procedure TNotebookComponentEditor.DoMoveActivePageRight;
var
  Index: integer;
begin
  Index:=NoteBook.PageIndex;
  if (Index>=0)
  and (Index>=NoteBook.PageCount-1) then exit;
  DoMovePage(Index,Index+1);
end;

procedure TNotebookComponentEditor.DoMovePage(
  CurIndex, NewIndex: Integer);
begin
  NoteBook.Pages.Move(CurIndex,NewIndex);
  Modified;
end;

procedure TNotebookComponentEditor.AddMenuItemsForPages(
  ParentMenuItem: TMenuItem);
var
  i: integer;
  NewMenuItem: TMenuItem;
begin
  ParentMenuItem.Enabled:=NoteBook.PageCount>0;
  for i:=0 to NoteBook.PageCount-1 do begin
    NewMenuItem:=TMenuItem.Create(ParentMenuItem);
    NewMenuItem.Name:='ShowPage'+IntToStr(i);
    NewMenuItem.Caption:=Notebook.CustomPage(i).Name+' "'+Notebook.Pages[i]+'"';
    NewMenuItem.OnClick:=@ShowPageMenuItemClick;
    ParentMenuItem.Add(NewMenuItem);
  end;
end;

procedure TNotebookComponentEditor.ExecuteVerb(Index: Integer);
begin
  case Index of
    nbvAddPage:       DoAddPage;
    nbvInsertPage:    DoInsertPage;
    nbvDeletePage:    DoDeletePage; // beware: this can free the editor itself
    nbvMovePageLeft:  DoMoveActivePageLeft;
    nbvMovePageRight: DoMoveActivePageRight;
  end;
end;

function TNotebookComponentEditor.GetVerb(Index: Integer): string;
begin
  case Index of
    nbvAddPage:       Result:=nbcesAddPage;
    nbvInsertPage:    Result:=nbcesInsertPage;
    nbvDeletePage:    Result:=nbcesDeletePage;
    nbvMovePageLeft:  Result:=nbcesMovePageLeft;
    nbvMovePageRight: Result:=nbcesMovePageRight;
    nbvShowPage:      Result:=nbcesShowPage;
  else
    Result:='';
  end;
end;

function TNotebookComponentEditor.GetVerbCount: Integer;
begin
  Result:=6;
end;

procedure TNotebookComponentEditor.PrepareItem(Index: Integer;
  const AnItem: TMenuItem);
begin
  inherited PrepareItem(Index, AnItem);
  case Index of
    nbvAddPage:       ;
    nbvInsertPage:    AnItem.Enabled:=Notebook.PageIndex>=0;
    nbvDeletePage:    AnItem.Enabled:=Notebook.PageIndex>=0;
    nbvMovePageLeft:  AnItem.Enabled:=Notebook.PageIndex>0;
    nbvMovePageRight: AnItem.Enabled:=Notebook.PageIndex<Notebook.PageCount-1;
    nbvShowPage:      AddMenuItemsForPages(AnItem);
  end;
end;

function TNotebookComponentEditor.Notebook: TCustomNotebook;
begin
  Result:=TCustomNotebook(GetComponent);
end;

{ TPageComponentEditor }

function TPageComponentEditor.Notebook: TCustomNotebook;
var
  APage: TCustomPage;
begin
  APage:=Page;
  if (APage.Parent<>nil) and (APage.Parent is TCustomNoteBook) then
    Result:=TCustomNoteBook(APage.Parent);
end;

function TPageComponentEditor.Page: TCustomPage;
begin
  Result:=TCustomPage(GetComponent);
end;


function EditStringGrid(AStringGrid: TStringGrid): Boolean;
var
  StringGridEditorDlg: TStringGridEditorDlg;
begin
  StringGridEditorDlg := TStringGridEditorDlg.Create(Application);
  try
    StringGridEditorDlg.LoadFromGrid(AStringGrid);
    if StringGridEditorDlg.ShowModal = mrOk then
    begin
      StringGridEditorDlg.SaveToGrid;
    end;
    Result := StringGridEditorDlg.Modified;
  finally
    StringGridEditorDlg.Free;
  end;
end;

{ TStringGridComponentEditor }

procedure TStringGridComponentEditor.ExecuteVerb(Index: Integer);
var
  Hook: TPropertyEditorHook;
begin
  if Index = 0 then
  begin
    GetHook(Hook);
    if EditStringGrid(GetComponent as TStringGrid) then
      if Assigned(Hook) then
        Hook.Modified(Self);
  end;
end;

function TStringGridComponentEditor.GetVerb(Index: Integer): string;
begin
  if Index = 0 then Result := sccsSGEdt
  else Result := '';
end;

function TStringGridComponentEditor.GetVerbCount: Integer;
begin
  Result := 1;
end;

{ TCheckListBoxComponentEditor }

procedure TCheckListBoxComponentEditor.DoShowEditor;
var 
  Dlg: TCheckListBoxEditorDlg;
begin
  Dlg := TCheckListBoxEditorDlg.Create(nil);
  try
    if GetComponent is TCheckListBox then 
    begin
      Dlg.aCheck := TCheckListBox(GetComponent);
      if not HasHook then exit;

      AssignCheckList(Dlg.FCheck, Dlg.aCheck);

      //ShowEditor
      if Dlg.ShowModal=mrOK then 
      begin
        AssignCheckList(Dlg.aCheck, Dlg.FCheck);
        Modified;
      end;
      if Dlg.Modified then
        Modified;
    end;
  finally
    Dlg.Free;
  end;
end;

procedure TCheckListBoxComponentEditor.ExecuteVerb(Index: Integer);
begin
  DoShowEditor;
end;

function TCheckListBoxComponentEditor.GetVerb(Index: Integer): string;
begin
  Result:=clbCheckListBoxEditor+'...';
end;

function TCheckListBoxComponentEditor.GetVerbCount: Integer;
begin
  Result:=1;
end;

{ TCheckGroupEditorDlg }

procedure TCheckGroupComponentEditor.DoShowEditor;
var 
  Dlg: TCheckGroupEditorDlg;
begin
  Dlg := TCheckGroupEditorDlg.Create(nil);
  try
    if GetComponent is TCheckGroup then 
    begin
      Dlg.aCheck := TCheckGroup(GetComponent);
      if not HasHook then exit;

      AssignCheckGroup(Dlg.FCheck, Dlg.aCheck);
      Dlg.ColumnsUpDown.Position := Dlg.aCheck.Columns;
      //ShowEditor
      if Dlg.ShowModal = mrOK then 
      begin
        AssignCheckGroup(Dlg.aCheck, Dlg.FCheck);
        Modified;
      end;
      if Dlg.Modified then
        Modified;
    end;
  finally
    Dlg.Free;
  end;
end;

procedure TCheckGroupComponentEditor.ExecuteVerb(Index: Integer);
begin
  DoShowEditor;
end;

function TCheckGroupComponentEditor.GetVerb(Index: Integer): string;
begin
  Result:=cgCheckGroupEditor+'...';
end;

function TCheckGroupComponentEditor.GetVerbCount: Integer;
begin
  Result:=1;
end;

{ TToolBarComponentEditor }

procedure TToolBarComponentEditor.ExecuteVerb(Index: Integer);
var
  NewStyle: TToolButtonStyle;
  Hook: TPropertyEditorHook;
  NewToolButton: TToolButton;
  NewName: string;
  CurToolBar: TToolBar;
  SiblingButton: TToolButton;
begin
  Hook:=nil;
  if not GetHook(Hook) then exit;
  case Index of
    0: NewStyle := tbsButton;
    1: NewStyle := tbsCheck;
    2: NewStyle := tbsSeparator;
    3: NewStyle := tbsDivider;
  else
    exit;
  end;
  CurToolBar := ToolBar;
  NewToolButton := TToolButton.Create(CurToolBar.Owner);
  NewName := GetDesigner.CreateUniqueComponentName(NewToolButton.ClassName);
  NewToolButton.Caption := NewName;
  NewToolButton.Name := NewName;
  NewToolButton.Style := NewStyle;
  if NewStyle = tbsDivider then
    NewToolButton.Width := 3;
  // position the button next to the last button
  if CurToolBar.ButtonCount > 0 then
  begin
    SiblingButton := CurToolBar.Buttons[CurToolBar.ButtonCount - 1];
    NewToolButton.SetBounds(SiblingButton.Left + SiblingButton.Width,
      SiblingButton.Top, NewToolButton.Width, NewToolButton.Height);
  end;
  NewToolButton.Parent := CurToolBar;
  Hook.PersistentAdded(NewToolButton, True);
  Modified;
end;

function TToolBarComponentEditor.GetVerb(Index: Integer): string;
begin
  case Index of
    0: Result := 'New Button';
    1: Result := 'New Checkbutton';
    2: Result := 'New Separator';
    3: Result := 'New Divider';
  else
    Result := '';
  end;
end;

function TToolBarComponentEditor.GetVerbCount: Integer;
begin
  Result := 4;
end;

function TToolBarComponentEditor.ToolBar: TToolBar;
begin
  Result := TToolBar(GetComponent);
end;

{ TCommonDialogComponentEditor }

procedure TCommonDialogComponentEditor.TestDialog;
begin
  with Component as TCommonDialog do Execute;
end;

function TCommonDialogComponentEditor.GetVerbCount: integer;
begin
  Result:=1;
end;

function TCommonDialogComponentEditor.GetVerb(Index: integer): string;
begin
  case Index of
    0:Result:=oisTestDialog;
  else
    Result:=inherited GetVerb(Index);
  end;
end;

procedure TCommonDialogComponentEditor.ExecuteVerb(Index: integer);
begin
  case Index of
    0:TestDialog;
  else
    inherited ExecuteVerb(Index);
  end;
end;

//------------------------------------------------------------------------------

procedure InternalFinal;
var
  p: PComponentClassRec;
  i: integer;
begin
  if ComponentClassList<>nil then begin
    for i:=0 to ComponentClassList.Count-1 do begin
      p:=PComponentClassRec(ComponentClassList[i]);
      Dispose(p);
    end;
    ComponentClassList.Free;
  end;
end;

{ TTabControlComponentEditor }

const
  tcvAddTab       = 0;
  tcvInsertTab    = 1;
  tcvDeleteTab    = 2;
  tcvMoveTabLeft  = 3;
  tcvMoveTabRight = 4;

procedure TTabControlComponentEditor.DoAddTab;
begin
  TabControl.Tabs.Add(CreateNewTabCaption);
  Modified;
end;

procedure TTabControlComponentEditor.DoInsertTab;
begin
  TabControl.Tabs.Insert(TabControl.TabIndex,CreateNewTabCaption);
  Modified;
end;

procedure TTabControlComponentEditor.DoDeleteTab;
begin
  if (TabControl.Tabs.Count=0) then exit;
  TabControl.Tabs.Delete(TabControl.TabIndex);
  Modified;
end;

procedure TTabControlComponentEditor.DoMoveActiveTabLeft;
var
  Index: integer;
begin
  Index:=TabControl.TabIndex;
  if (Index<0) then exit;
  DoMoveTab(Index,Index-1);
end;

procedure TTabControlComponentEditor.DoMoveActiveTabRight;
var
  Index: integer;
begin
  Index:=TabControl.TabIndex;
  if (Index>=TabControl.Tabs.Count-1) then exit;
  DoMoveTab(Index,Index+1);
end;

procedure TTabControlComponentEditor.DoMoveTab(CurIndex, NewIndex: Integer);
begin
  TabControl.Tabs.Move(CurIndex,NewIndex);
  Modified;
end;

procedure TTabControlComponentEditor.AddMenuItemsForTabs(
  ParentMenuItem: TMenuItem);
var
  i: integer;
  NewMenuItem: TMenuItem;
begin
  ParentMenuItem.Enabled:=TabControl.Tabs.Count>0;
  for i:=0 to TabControl.Tabs.Count-1 do begin
    NewMenuItem:=TMenuItem.Create(ParentMenuItem);
    NewMenuItem.Name:='ShowTab'+IntToStr(i);
    NewMenuItem.Caption:='"'+TabControl.Tabs[i]+'"';
    NewMenuItem.OnClick:=@ShowTabMenuItemClick;
    ParentMenuItem.Add(NewMenuItem);
  end;
end;

procedure TTabControlComponentEditor.ShowTabMenuItemClick(Sender: TObject);
var
  AMenuItem: TMenuItem;
  NewTabIndex: LongInt;
begin
  AMenuItem:=TMenuItem(Sender);
  if (AMenuItem=nil) or (not (AMenuItem is TMenuItem)) then exit;
  NewTabIndex:=AMenuItem.MenuIndex;
  if (NewTabIndex<0) or (NewTabIndex>=TabControl.Tabs.Count) then exit;
  TabControl.TabIndex:=NewTabIndex;
  Modified;
end;

function TTabControlComponentEditor.CreateNewTabCaption: string;
begin
  Result:='New Tab';
  while TabControl.IndexOfTabWithCaption(Result)>=0 do
    Result:=CreateNextIdentifier(Result);
end;

procedure TTabControlComponentEditor.ExecuteVerb(Index: Integer);
begin
  case Index of
    tcvAddTab:       DoAddTab;
    tcvInsertTab:    DoInsertTab;
    tcvDeleteTab:    DoDeleteTab; // beware: this can free the editor itself
    tcvMoveTabLeft:  DoMoveActiveTabLeft;
    tcvMoveTabRight: DoMoveActiveTabRight;
  end;
end;

function TTabControlComponentEditor.GetVerb(Index: Integer): string;
begin
  case Index of
    tcvAddTab:       Result:=tccesAddTab;
    tcvInsertTab:    Result:=tccesInsertTab;
    tcvDeleteTab:    Result:=tccesDeleteTab;
    tcvMoveTabLeft:  Result:=tccesMoveTabLeft;
    tcvMoveTabRight: Result:=tccesMoveTabRight;
  else
    Result:='';
  end;
end;

function TTabControlComponentEditor.GetVerbCount: Integer;
begin
  Result:=5;
end;

procedure TTabControlComponentEditor.PrepareItem(Index: Integer;
  const AnItem: TMenuItem);
begin
  inherited PrepareItem(Index, AnItem);
  case Index of
    tcvAddTab:       ;
    tcvInsertTab:    AnItem.Enabled:=TabControl.TabIndex>=0;
    tcvDeleteTab:    AnItem.Enabled:=TabControl.TabIndex>=0;
    tcvMoveTabLeft:  AnItem.Enabled:=TabControl.TabIndex>0;
    tcvMoveTabRight: AnItem.Enabled:=TabControl.TabIndex<TabControl.Tabs.Count-1;
  end;
end;

function TTabControlComponentEditor.TabControl: TCustomTabControl;
begin
  Result:=TCustomTabControl(GetComponent);
end;

{ TTimerComponentEditor }

constructor TTimerComponentEditor.Create(AComponent: TComponent;
  ADesigner: TComponentEditorDesigner);
begin
  inherited Create(AComponent, ADesigner);
  BestEditEvent := 'ONTIMER';
end;

{ TComponentEditorDesigner }

function TComponentEditorDesigner.GetHandlerCount(
  HookType: TComponentEditorDesignerHookType): integer;
begin
  Result:=FHandlers[HookType].Count;
end;

procedure TComponentEditorDesigner.AddHandler(
  HookType: TComponentEditorDesignerHookType; const Handler: TMethod);
begin
  if Handler.Code=nil then RaiseGDBException('TComponentEditorDesigner.AddHandler');
  if FHandlers[HookType]=nil then
    FHandlers[HookType]:=TMethodList.Create;
  FHandlers[HookType].Add(Handler);
end;

procedure TComponentEditorDesigner.RemoveHandler(
  HookType: TComponentEditorDesignerHookType; const Handler: TMethod);
begin
  FHandlers[HookType].Remove(Handler);
end;

destructor TComponentEditorDesigner.Destroy;
var
  HookType: TComponentEditorDesignerHookType;
begin
  for HookType:=Low(FHandlers) to High(FHandlers) do
    FreeThenNil(FHandlers[HookType]);
  inherited Destroy;
end;

procedure TComponentEditorDesigner.Modified;
begin
  if FChangeStamp<High(FChangeStamp) then
    inc(FChangeStamp)
  else
    FChangeStamp:=Low(FChangeStamp);
  FHandlers[cedhtModified].CallNotifyEvents(Self);
end;

procedure TComponentEditorDesigner.RemoveAllHandlersForObject(
  const HandlerObject: TObject);
var
  HookType: TComponentEditorDesignerHookType;
begin
  for HookType:=Low(FHandlers) to High(FHandlers) do
    if FHandlers[HookType]<>nil then
      FHandlers[HookType].RemoveAllMethodsOfObject(HandlerObject);
end;

procedure TComponentEditorDesigner.AddHandlerModified(
  const OnModified: TNotifyEvent);
begin
  AddHandler(cedhtModified,TMethod(OnModified));
end;

procedure TComponentEditorDesigner.RemoveHandlerModified(
  const OnModified: TNotifyEvent);
begin
  RemoveHandler(cedhtModified,TMethod(OnModified));
end;

initialization
  RegisterComponentEditorProc := @DefaultRegisterComponentEditorProc;
  RegisterComponentEditor(TCustomNotebook, TNotebookComponentEditor);
  RegisterComponentEditor(TCustomPage, TPageComponentEditor);
  RegisterComponentEditor(TCustomTabControl, TTabControlComponentEditor);
  RegisterComponentEditor(TStringGrid, TStringGridComponentEditor);
  RegisterComponentEditor(TCheckListBox, TCheckListBoxComponentEditor);
  RegisterComponentEditor(TCheckGroup, TCheckGroupComponentEditor);
  RegisterComponentEditor(TToolBar, TToolBarComponentEditor);
  RegisterComponentEditor(TCommonDialog, TCommonDialogComponentEditor);
  RegisterComponentEditor(TCustomTimer, TTimerComponentEditor);

finalization
  InternalFinal;

end.

ComponentEditors.pas (38,295 bytes)

2010-08-19 19:11

 

Designer.pp (127,322 bytes)
{ /***************************************************************************
                   designer.pp  -  Lazarus IDE unit
                   --------------------------------

              Initial Revision  : Sat May 10 23:15:32 CST 1999


 ***************************************************************************/

 ***************************************************************************
 *                                                                         *
 *   This source is free software; you can redistribute it and/or modify   *
 *   it under the terms of the GNU General Public License as published by  *
 *   the Free Software Foundation; either version 2 of the License, or     *
 *   (at your option) any later version.                                   *
 *                                                                         *
 *   This code is distributed in the hope that it will be useful, but      *
 *   WITHOUT ANY WARRANTY; without even the implied warranty of            *
 *   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU     *
 *   General Public License for more details.                              *
 *                                                                         *
 *   A copy of the GNU General Public License is available on the World    *
 *   Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also      *
 *   obtain it by writing to the Free Software Foundation,                 *
 *   Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.        *
 *                                                                         *
 ***************************************************************************
}
unit Designer;

{$mode objfpc}{$H+}

interface

{off $DEFINE VerboseDesigner}
{off $DEFINE VerboseDesignerDraw}
{off $DEFINE VerboseDesignerSelect}

uses
  // FCL + LCL
  Types, Classes, SysUtils, Math, LCLProc, LCLType, LResources, LCLIntf, LMessages,
  InterfaceBase, Forms, Controls, GraphType, Graphics, Dialogs, ExtCtrls, Menus,
  ClipBrd, TypInfo,
  // IDEIntf
  IDEDialogs, PropEdits, PropEditUtils, ComponentEditors, MenuIntf, IDEImagesIntf,
  FormEditingIntf,
  // IDE
  LazarusIDEStrConsts, EnvironmentOpts, IDECommands, ComponentReg,
  NonControlDesigner, FrameDesigner, AlignCompsDlg, SizeCompsDlg, ScaleCompsDlg,
  TabOrderDlg, DesignerProcs, CustomFormEditor,  AskCompNameDlg,
  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
    FDesignerPopupMenu: TPopupMenu;
    FDefaultFormBounds: TRect;
    FLastFormBounds: TRect;
    FDefaultFormBoundsValid: boolean;
    FFlags: TDesignerFlags;
    FGridColor: TColor;
    FLookupRoot: TComponent;
    FMediator: TDesignerMediator;
    FOnActivated: TNotifyEvent;
    FOnCloseQuery: TNotifyEvent;
    FOnShowObjectInspector: 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;
    FPopupMenuComponentEditor: TBaseComponentEditor;

    //hint stuff
    FHintTimer: TTimer;
    FHintWIndow: THintWindow;

    // component drawing
    FDDC: TDesignerDeviceContext;
    FSurface: TBitmap;

    procedure DrawNonVisualComponent(AComponent: TComponent);
    function GetGridColor: TColor;
    function GetGridSizeX: integer;
    function GetGridSizeY: integer;
    function GetIsControl: Boolean;
    function GetShowBorderSpacing: boolean;
    function GetShowComponentCaptions: boolean;
    function GetShowEditorHints: boolean;
    function GetShowGrid: boolean;
    function GetSnapToGrid: boolean;
    procedure HintTimer(Sender : TObject);
    procedure InvalidateWithParent(AComponent: TComponent);
    procedure SetDefaultFormBounds(const AValue: TRect);
    procedure SetGridColor(const AValue: TColor);
    procedure SetGridSizeX(const AValue: integer);
    procedure SetGridSizeY(const AValue: integer);
    procedure SetIsControl(Value: Boolean);
    procedure SetMediator(const AValue: TDesignerMediator);
    procedure SetPopupMenuComponentEditor(const AValue: TBaseComponentEditor);
    procedure SetShowBorderSpacing(const AValue: boolean);
    procedure SetShowComponentCaptions(const AValue: boolean);
    procedure SetShowEditorHints(const AValue: boolean);
    procedure SetShowGrid(const AValue: boolean);
    procedure SetSnapToGrid(const AValue: boolean);
  protected
    MouseDownComponent: TComponent;
    MouseDownSender: TComponent;
    MouseDownPos: TPoint;
    MouseDownShift: TShiftState;
    MouseUpPos: TPoint;
    LastMouseMovePos: TPoint;
    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;
    procedure HandlePopupMenu(Sender: TControl; var Message: TLMContextMenu);
    procedure GetMouseMsgShift(TheMessage: TLMMouse; var Shift: TShiftState;
                               var Button: TMouseButton);

    // 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 NudgeSelection(DiffX, DiffY: Integer); overload;
    procedure NudgeSelection(SelectNext: Boolean); overload;
    procedure SelectParentOfSelection;
    function DoCopySelectionToClipboard: boolean;
    function GetPasteParent: TWinControl;
    procedure DoModified;
    function DoPasteSelectionFromClipboard(PasteFlags: TComponentPasteSelectionFlags
                                           ): boolean;
    function DoInsertFromStream(s: TStream; PasteParent: TWinControl;
                                PasteFlags: TComponentPasteSelectionFlags): Boolean;
    procedure DoShowTabOrderEditor;
    procedure DoShowChangeClassDialog;
    procedure DoShowObjectInspector;
    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;
    procedure SetTempCursor(ARoot: TWinControl; ACursor: TCursor);

    // 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);
    procedure OnCenterFormMenuClick(Sender: TObject);

    // hook
    function GetPropertyEditorHook: TPropertyEditorHook; override;
    function OnFormActivated: boolean;
    function OnFormCloseQuery: boolean;

    property PopupMenuComponentEditor: TBaseComponentEditor read FPopupMenuComponentEditor write SetPopupMenuComponentEditor;
  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;
    function ComponentIsIcon(AComponent: TComponent): boolean;
    function GetParentFormRelativeClientOrigin(AComponent: TComponent): TPoint;
  public
    property Flags: TDesignerFlags read FFlags;
    property GridSizeX: integer read GetGridSizeX write SetGridSizeX;
    property GridSizeY: integer read GetGridSizeY write SetGridSizeY;
    property GridColor: TColor read GetGridColor write SetGridColor;
    property IsControl: Boolean read GetIsControl write SetIsControl;
    property LookupRoot: TComponent read FLookupRoot;
    property Mediator: TDesignerMediator read FMediator write SetMediator;
    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 OnShowObjectInspector: TNotifyEvent read FOnShowObjectInspector write FOnShowObjectInspector;
    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;
  DesignerMenuCenterForm: TIDEMenuCommand;

  DesignerMenuSnapToGridOption: TIDEMenuCommand;
  DesignerMenuSnapToGuideLinesOption: TIDEMenuCommand;
  DesignerMenuShowOptions: TIDEMenuCommand;


procedure RegisterStandardDesignerMenuItems;


implementation

type
  TCustomFormAccess = class(TCustomForm);
  TControlAccess = class(TControl);
  TComponentAccess = class(TComponent);

  { TComponentSearch }

  TComponentSearch = class(TComponent)
  public
    Best: TComponent;
    BestLevel: integer;
    BestIsNonVisual: boolean;
    Level: integer;
    AtPos: TPoint;
    MinClass: TComponentClass;
    IgnoreHidden: boolean;
    OnlyNonVisual: boolean;
    Mediator: TDesignerMediator;
    Root: TComponent;
    procedure Gather(Child: TComponent);
    procedure Search(ARoot: TComponent);
  end;

{ TComponentSearch }

procedure TComponentSearch.Gather(Child: TComponent);
var
  Control: TControl;
  ChildBounds: TRect;
  OldRoot: TComponent;
  IsNonVisual: Boolean;
begin
  if Assigned(Best) and BestIsNonVisual and (BestLevel < Level) then exit;
  {$IFDEF VerboseDesignerSelect}
  DebugLn(['TComponentSearch.Gather ',DbgSName(Child),' ',dbgs(AtPos),' MinClass=',DbgSName(MinClass)]);
  {$ENDIF}
  // check if child is at position
  if Child is TControl then
  begin
    Control := TControl(Child);
    if IgnoreHidden and (csNoDesignVisible in Control.ControlStyle) then
      exit;
    if csNoDesignSelectable in Control.ControlStyle then
      exit;
  end
  else
    Control := nil;
  ChildBounds := GetParentFormRelativeBounds(Child);
  {$IFDEF VerboseDesignerSelect}
  DebugLn(['TComponentSearch.Gather PtInRect=',PtInRect(ChildBounds, AtPos),' ChildBounds=',dbgs(ChildBounds)]);
  {$ENDIF}
  if not PtInRect(ChildBounds, AtPos) then Exit;

  if Assigned(Mediator) then
    IsNonVisual := Mediator.ComponentIsIcon(Child)
  else
    IsNonVisual := DesignerProcs.ComponentIsNonVisual(Child);

  if Child.InheritsFrom(MinClass) and (IsNonVisual or not OnlyNonVisual) then
  begin
    Best := Child;
    BestIsNonVisual := IsNonVisual;
    BestLevel := Level;
    {$IFDEF VerboseDesignerSelect}
    DebugLn(['TComponentSearch.Gather Best=',DbgSName(Best)]);
    {$ENDIF}
  end;

  // search in children
  if (csInline in Child.ComponentState) or
     (Assigned(Control) and not (csOwnedChildrenNotSelectable in Control.ControlStyle)) then
  begin
    {$IFDEF VerboseDesignerSelect}
    DebugLn(['TComponentSearch.Gather search in children of ',DbgSName(Child)]);
    {$ENDIF}
    OldRoot := Root;
    try
      inc(Level);
      if csInline in Child.ComponentState then
        Root := Child;
      {$IFDEF VerboseDesignerSelect}
      DebugLn(['TComponentSearch.Gather Root=',DbgSName(Root)]);
      {$ENDIF}
      TComponentAccess(Child).GetChildren(@Gather, Root);
    finally
      dec(Level);
      Root := OldRoot;
    end;
    {$IFDEF VerboseDesignerSelect}
    DebugLn(['TComponentSearch.Gather searched in children of ',DbgSName(Child)]);
    {$ENDIF}
  end;
end;

procedure TComponentSearch.Search(ARoot: TComponent);
begin
  Root := ARoot;
  Level := 1;
  TComponentAccess(Root).GetChildren(@Gather, Root);
  Level := 0;
end;

const
  mk_lbutton =   1;
  mk_rbutton =   2;
  mk_shift   =   4;
  mk_control =   8;
  mk_mbutton = $10;

procedure RegisterStandardDesignerMenuItems;
begin
  DesignerMenuRoot:=RegisterIDEMenuRoot(DesignerMenuRootName);

  // register the dynamic section for the component editor
  DesignerMenuSectionComponentEditor:=RegisterIDEMenuSection(DesignerMenuRoot,
                                                    'Component editor section');

  // register the custom dynamic section
  DesignerMenuSectionCustomDynamic:=RegisterIDEMenuSection(DesignerMenuRoot,
                                                      'Custom dynamic section');

  // register align section
  DesignerMenuSectionAlign:=RegisterIDEMenuSection(DesignerMenuRoot,
                                                               'Align section');
    DesignerMenuAlign:=RegisterIDEMenuCommand(DesignerMenuSectionAlign,
                                         'Align',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 z-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);
    DesignerMenuCenterForm:=RegisterIDEMenuCommand(DesignerMenuSectionMisc,
                                                'Center form', lisCenterForm);

  // 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 begin
    FLookupRoot := TNonControlDesignerForm(FForm).LookupRoot;
    Mediator:=TNonControlDesignerForm(FForm).Mediator;
  end
  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;
  FPopupMenuComponentEditor := nil;
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;
    if Mediator<>nil then
      Mediator.Designer:=nil;
    // free or hide the form
    TheFormEditor.DeleteComponent(FLookupRoot,FreeComponent);
    FMediator:=nil;
  end;
  Free;
end;

destructor TDesigner.Destroy;
begin
  PopupMenuComponentEditor := nil;
  FreeAndNil(FDesignerPopupMenu);
  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, False);
  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;

function ComponentsSortByLeft(Item1, Item2: Pointer): Integer;
var
  Comp1: TComponent absolute Item1;
  Comp2: TComponent absolute Item2;
  L1, L2: Integer;
begin
  L1 := GetComponentLeft(Comp1);
  L2 := GetComponentLeft(Comp2);
  if L1 < L2 then
    Result := -1
  else
  if L1 > L2 then
    Result := 1
  else
    Result := 0;
end;

function ComponentsSortByTop(Item1, Item2: Pointer): Integer;
var
  Comp1: TComponent absolute Item1;
  Comp2: TComponent absolute Item2;
  T1, T2: Integer;
begin
  T1 := GetComponentTop(Comp1);
  T2 := GetComponentTop(Comp2);
  if T1 < T2 then
    Result := -1
  else
  if T1 > T2 then
    Result := 1
  else
    Result := 0;
end;

procedure TDesigner.NudgeSelection(DiffX, DiffY: Integer);
const
  Delta = 50; // radius for searching components
var
  List: TFPList;
  Coord, Test: TPoint;
  Current, AComponent: TComponent;
  i: integer;
begin
  if (ControlSelection.SelectionForm <> Form) or
     (ControlSelection.SelectionForm.ComponentCount = 0) or
     ControlSelection.LookupRootSelected or
     (ControlSelection.Count <> 1) then Exit;
  if not ControlSelection[0].IsTComponent then Exit;

  // create a list of components at the similar top/left
  Current := TComponent(ControlSelection[0].Persistent);
  AComponent := nil;
  List := TFPList.Create;
  try
    Coord := GetParentFormRelativeClientOrigin(Current);
    if DiffX <> 0 then
    begin
      for i := 0 to ControlSelection.SelectionForm.ComponentCount - 1 do
      begin
        AComponent := ControlSelection.SelectionForm.Components[i];
        if (AComponent = Current) or ComponentIsInvisible(AComponent) then
          Continue;
        Test := GetParentFormRelativeClientOrigin(AComponent);
        if (Abs(Test.Y - Coord.Y) <= Delta) and
           (Sign(Test.X - Coord.X) = Sign(DiffX)) then
          List.Add(AComponent);
      end;
      if List.Count > 0 then
      begin
        List.Sort(@ComponentsSortByLeft);
        if DiffX > 0 then
          AComponent := TComponent(List[0])
        else
          AComponent := TComponent(List[List.Count - 1]);
      end
      else
        AComponent := nil;
    end
    else
    if DiffY <> 0 then
    begin
      for i := 0 to ControlSelection.SelectionForm.ComponentCount - 1 do
      begin
        AComponent := ControlSelection.SelectionForm.Components[i];
        if (AComponent = Current) or ComponentIsInvisible(AComponent) then
          Continue;
        Test := GetParentFormRelativeClientOrigin(AComponent);
        if (Abs(Test.X - Coord.X) <= Delta) and
           (Sign(Test.Y - Coord.Y) = Sign(DiffY)) then
          List.Add(AComponent);
      end;
      if List.Count > 0 then
      begin
        List.Sort(@ComponentsSortByTop);
        if DiffY > 0 then
          AComponent := TComponent(List[0])
        else
          AComponent := TComponent(List[List.Count - 1]);
      end
      else
        AComponent := nil;
    end;
  finally
    List.Free;
  end;
  if AComponent <> nil then
  begin
    ControlSelection.AssignPersistent(AComponent);
    Modified;
  end;
end;

procedure TDesigner.NudgeSelection(SelectNext: Boolean);

  function StepIndex(Index: Integer): Integer;
  begin
    Result := Index;
    if SelectNext then
      Inc(Result)
    else
      Dec(Result);

    if Result >= ControlSelection.SelectionForm.ComponentCount then
      Result := 0
    else
    if Result < 0 then
      Result := ControlSelection.SelectionForm.ComponentCount - 1;
  end;

var
  Index, StartIndex: Integer;
  AComponent: TComponent;
begin
  if (ControlSelection.SelectionForm <> Form) or
     (ControlSelection.SelectionForm.ComponentCount = 0) then Exit;
  if (ControlSelection.Count = 1) and ControlSelection[0].IsTComponent then
    Index := TComponent(ControlSelection[0].Persistent).ComponentIndex
  else
    Index := -1;

  Index := StepIndex(Index);
  StartIndex := Index;

  AComponent := nil;
  while AComponent = nil do
  begin
    AComponent := ControlSelection.SelectionForm.Components[Index];
    if ComponentIsInvisible(AComponent) then
    begin
      AComponent := nil;
      Index := StepIndex(Index);
      if Index = StartIndex then
        break;
    end;
  end;

  if AComponent <> nil then
  begin
    ControlSelection.AssignPersistent(AComponent);
    Modified;
  end;
end;

procedure TDesigner.SelectParentOfSelection;

  function ParentComponent(AComponent: TComponent): TComponent;
  begin
    Result := AComponent.GetParentComponent;
    if (Result = nil) and ComponentIsIcon(AComponent) then
      Result := AComponent.Owner;
  end;

var
  i: Integer;
begin
  // resizing or moving
  if dfHasSized in FFlags then
  begin
    ControlSelection.RestoreBounds;
    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;

  // if not component moving then select parent
  i := ControlSelection.Count - 1;
  while (i >= 0) and
        (ControlSelection[i].ParentInSelection or
         not ControlSelection[i].IsTComponent or
         (ParentComponent(TComponent(ControlSelection[i].Persistent)) = nil)) do
    Dec(i);
  if i >= 0 then
    SelectOnlyThisComponent(ParentComponent(TComponent(ControlSelection[i].Persistent)));
end;

function TDesigner.CopySelectionToStream(AllComponentsStream: TStream): boolean;

  function UnselectDistinctControls: boolean;
  var
    i: Integer;
    AParent, CurParent: TWinControl;
  begin
    Result:=false;
    AParent:=nil;
    i:=0;
    while i<ControlSelection.Count do begin
      if ControlSelection[i].IsTControl then begin
        // unselect controls from which the parent is selected too
        if ControlSelection[i].ParentInSelection then begin
          ControlSelection.Delete(i);
          continue;
        end;

        // check if not the top level component is selected
        CurParent:=TControl(ControlSelection[i].Persistent).Parent;
        if CurParent=nil then begin
          MessageDlg(lisCanNotCopyTopLevelComponent,
            lisCopyingAWholeFormIsNotImplemented,
            mtError,[mbOk],0);
          exit;
        end;

        // unselect all controls, that do not have the same parent
        if (AParent=nil) then
          AParent:=CurParent
        else if (AParent<>CurParent) 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
          Writer.OnWriteMethodProperty:=@BaseFormEditor1.WriteMethodPropertyEvent;
          Writer.Root:=FLookupRoot;
          Writer.WriteComponent(CurComponent);
        finally
          if DestroyDriver then Writer.Driver.Free;
          Writer.Destroy;
        end;
      except
        on E: Exception do begin
          MessageDlg(lisUnableToStreamSelectedComponents,
            Format(lisThereWasAnErrorDuringWritingTheSelectedComponent, [
              CurComponent.Name, CurComponent.ClassName, #13, E.Message]),
            mtError,[mbOk],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,[mbOk],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,[mbOk],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;

procedure TDesigner.DoModified;
begin
  if Assigned(OnModified) then
    OnModified(Self)
end;

function TDesigner.DoPasteSelectionFromClipboard(
  PasteFlags: TComponentPasteSelectionFlags): boolean;
var
  AllComponentText: string;
  CurTextCompStream: TMemoryStream;
begin
  Result:=false;
  if not CanPaste then exit;
  // read component stream from clipboard
  AllComponentText:=ClipBoard.AsText;
  if AllComponentText='' then exit;
  CurTextCompStream:=TMemoryStream.Create;
  try
    CurTextCompStream.Write(AllComponentText[1],length(AllComponentText));
    CurTextCompStream.Position:=0;
    if not DoInsertFromStream(CurTextCompStream,nil,PasteFlags) then
      exit;
  finally
    CurTextCompStream.Free;
  end;
  Result:=true;
end;

function TDesigner.DoInsertFromStream(s: TStream;
  PasteParent: TWinControl; PasteFlags: TComponentPasteSelectionFlags): Boolean;
var
  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 := LeftTopToDesignInfo(
        SmallInt(Max(0, Min(P.x, Form.ClientWidth - NonVisualCompWidth))),
        SmallInt(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
    Form.DisableAutoSizing;
    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
      Form.EnableAutoSizing;
    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.DoShowObjectInspector;
begin
  if Assigned(FOnShowObjectInspector) then
    OnShowObjectInspector(Self);
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;
  try
    CompEditor.Free;
  except
    on E: Exception do begin
      DebugLn('TDesigner.InvokeComponentEditor ERROR freeing component editor: ',E.Message);
    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;
var
  ParentForm: TPoint;
begin
  Result.X := LeftFromDesignInfo(AComponent.DesignInfo);
  Result.Y := TopFromDesignInfo(AComponent.DesignInfo);
  // convert to lookuproot coords
  if (AComponent.Owner <> FLookupRoot) then
  begin
    ParentForm:=GetParentFormRelativeClientOrigin(AComponent.Owner);
    inc(Result.X,ParentForm.X);
    inc(Result.Y,ParentForm.Y);
  end;
end;

procedure TDesigner.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
      DoPaintDesignerItems
    else
    begin
      // client grid
      if (Sender is TWinControl) and (csAcceptsControls in Sender.ControlStyle) then
        PaintClientGrid(TWinControl(Sender),DDC);

      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
    SetTempCursor(Form, LastFormCursor);
    TheMessage.Result := 1;
  end;
end;

procedure TDesigner.HandlePopupMenu(Sender: TControl; var Message: TLMContextMenu);
var
  PopupPos: TPoint;
begin
  if Message.XPos = -1 then
  begin
    PopupMenuComponentEditor := GetComponentEditorForSelection;
    BuildPopupMenu;
    with ControlSelection do
      PopupPos := Point(Left + Width, Top);
    with Form.ClientToScreen(PopupPos) do
      FDesignerPopupMenu.Popup(X, Y);
  end;
  Message.Result := 1;
end;

procedure TDesigner.GetMouseMsgShift(TheMessage: TLMMouse;
  var Shift: TShiftState; var Button: TMouseButton);
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);

  if GetKeyState(VK_MENU) < 0 then Include(Shift, ssAlt);
  if (GetKeyState(VK_LWIN) < 0) or (GetKeyState(VK_RWIN) < 0) then Include(Shift, ssMeta);

  case TheMessage.Msg of
  LM_LBUTTONUP,LM_LBUTTONDBLCLK,LM_LBUTTONTRIPLECLK,LM_LBUTTONQUADCLK:
    begin
      Include(Shift, ssLeft);
      Button := mbLeft;
    end;
  LM_MBUTTONUP,LM_MBUTTONDBLCLK,LM_MBUTTONTRIPLECLK,LM_MBUTTONQUADCLK:
    begin
      Include(Shift, ssMiddle);
      Button := mbMiddle;
    end;
  LM_RBUTTONUP,LM_RBUTTONDBLCLK,LM_RBUTTONTRIPLECLK,LM_RBUTTONQUADCLK:
    begin
      Include(Shift, ssRight);
      Button := mbRight;
    end;
  else
    if (TheMessage.Keys and MK_MButton) <> 0 then
    begin
      Include(Shift, ssMiddle);
      Button := mbMiddle;
    end;
    if (TheMessage.Keys and MK_RButton) <> 0 then
    begin
      Include(Shift, ssRight);
      Button := mbRight;
    end;
    if (TheMessage.Keys and MK_LButton) <> 0 then
    begin
      Include(Shift, ssLeft);
      Button := mbLeft;
    end;
    if (TheMessage.Keys and MK_XBUTTON1) <> 0 then
    begin
      Include(Shift, ssExtra1);
      Button := mbExtra1;
    end;
    if (TheMessage.Keys and MK_XBUTTON2) <> 0 then
    begin
      Include(Shift, ssExtra2);
      Button := mbExtra2;
    end;
  end;

  case TheMessage.Msg of
  LM_LBUTTONDBLCLK,LM_MBUTTONDBLCLK,LM_RBUTTONDBLCLK,LM_XBUTTONDBLCLK:
    Include(Shift, ssDouble);
  LM_LBUTTONTRIPLECLK,LM_MBUTTONTRIPLECLK,LM_RBUTTONTRIPLECLK,LM_XBUTTONTRIPLECLK:
    Include(Shift, ssTriple);
  LM_LBUTTONQUADCLK,LM_MBUTTONQUADCLK,LM_RBUTTONQUADCLK,LM_XBUTTONQUADCLK:
    Include(Shift, ssQuad);
  end;
end;

function TDesigner.GetDesignControl(AControl: TControl): TControl;
// checks if AControl is designable.
// if not check Owner.
// AControl can be a TNonControlDesignerForm
var
  OwnerControl: TControl;
  AComponent: TComponent;
begin
  Result:=AControl;
  if (Result=nil) or (Result=LookupRoot) or (Result.Owner=LookupRoot) then exit;
  if Result=Form then exit;
  if (Result.Owner is TControl) then begin
    OwnerControl:=TControl(Result.Owner);
    if (not (csOwnedChildrenNotSelectable in OwnerControl.ControlStyle)) then
      exit;
    Result:=GetDesignControl(OwnerControl);
  end else begin
    AComponent:=GetDesignedComponent(AControl);
    if AComponent is TControl then
      Result:=TControl(AComponent)
    else
      Result:=nil;
  end;
end;

function TDesigner.SizeControl(Sender: TControl; TheMessage: TLMSize): Boolean;
begin
  Result := True;
  Sender.Dispatch(TheMessage);
  if 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;
  Button: TMouseButton;
  Handled: Boolean;
begin
  FHintTimer.Enabled := False;
  FHintWindow.Visible := 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;

  MouseDownComponent := ComponentAtPos(MouseDownPos.X, MouseDownPos.Y, True, True);
  if (MouseDownComponent = nil) then exit;

  if ComponentIsIcon(MouseDownComponent) then
  begin
    NonVisualComp := MouseDownComponent;
    MoveNonVisualComponentIntoForm(NonVisualComp);
  end;

  MouseDownSender := DesignSender;

  GetMouseMsgShift(TheMessage,Shift,Button);
  MouseDownShift:=Shift;

  {$IFDEF VerboseDesigner}
  DebugLn('************************************************************');
  DbgOut('MouseDownOnControl');
  DbgOut(' Sender=',dbgsName(Sender),' DesignSender=',dbgsName(DesignSender));
  //write(' Msg=',TheMessage.Pos.X,',',TheMessage.Pos.Y);
  //write(' Mouse=',MouseDownPos.X,',',MouseDownPos.Y);
  //writeln('');

  if (TheMessage.Keys and MK_Shift) = MK_Shift then
    DbgOut(' Shift down')
  else
    DbgOut(' No Shift down');

  if (TheMessage.Keys and MK_Control) = MK_Control then
    DebugLn(', CTRL down')
  else
    DebugLn(', No CTRL down');
  {$ENDIF}

  if (MouseDownComponent <> nil) and (MouseDownComponent is TControl) then
  begin
    if TControl(MouseDownComponent).Perform(CM_DESIGNHITTEST, 0, Longint(SmallPoint(MouseDownPos.X, MouseDownPos.Y))) > 0 then
    begin
      TControlAccess(MouseDownComponent).MouseDown(Button, Shift, MouseDownPos.X, MouseDownPos.Y);
      Exit;
    end;
  end;

  if Mediator<>nil then begin
    Handled:=false;
    Mediator.MouseDown(Button,Shift,MouseDownPos,Handled);
    if Handled then exit;
  end;

  SelectedCompClass := GetSelectedComponentClass;

  if Button=mbLeft then begin
    // left button
    // -> check if a grabber was activated
    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;
    if (Button = mbRight) and EnvironmentOptions.RightClickSelects and
       (ControlSelection.SelectionForm <> Form) then
      ControlSelection.AssignPersistent(MouseDownComponent);
  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
  NewLeft, NewTop, NewWidth, NewHeight: Integer;
  Button: TMouseButton;
  Shift: TShiftState;
  SenderParentForm: TCustomForm;
  RubberBandWasActive: boolean;
  ParentClientOrigin, PopupPos: TPoint;
  SelectedCompClass: TRegisteredComponent;
  SelectionChanged, NewRubberbandSelection: boolean;
  DesignSender: TControl;

  procedure AddComponent;
  var
    NewParent: TComponent;
    NewParentControl: TWinControl;
    NewComponent: TComponent;
    NewComponentClass: TComponentClass;
    NewName: String;
    DisableAutoSize: Boolean;
    NewControl: TControl;
  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
    NewParent := FLookupRoot;
    if Mediator<>nil then begin
      NewParent:=MouseDownComponent;
      while (NewParent<>nil)
      and (not Mediator.ParentAcceptsChild(NewParent,NewComponentClass)) do
        NewParent:=NewParent.GetParentComponent;
      if NewParent=nil then
        NewParent:=FLookupRoot;
    end else if (FLookupRoot is TCustomForm) or (FLookupRoot is TCustomFrame)
    then begin
      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;
    if not Assigned(NewParent) 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
    NewLeft:=Min(MouseDownPos.X,MouseUpPos.X);
    NewTop:=Min(MouseDownPos.Y,MouseUpPos.Y);
    if (Mediator<>nil) then begin
      ParentClientOrigin:=Mediator.GetComponentOriginOnForm(NewParent);
      DebugLn(['AddComponent ParentClientOrigin=',dbgs(ParentClientOrigin)]);
      // adjust left,top to parent origin
      dec(NewLeft,ParentClientOrigin.X);
      dec(NewTop,ParentClientOrigin.Y);
    end else if SelectedCompClass.ComponentClass.InheritsFrom(TControl) then
    begin
      ParentClientOrigin:=GetParentFormRelativeClientOrigin(NewParent);
      // adjust left,top to parent origin
      dec(NewLeft,ParentClientOrigin.X);
      dec(NewTop,ParentClientOrigin.Y);
    end;
    NewWidth:=Abs(MouseUpPos.X-MouseDownPos.X);
    NewHeight:=Abs(MouseUpPos.Y-MouseDownPos.Y);
    if Abs(NewWidth+NewHeight)<7 then begin
      // this very small component is probably only a wag, take default size
      NewWidth:=0;
      NewHeight:=0;
    end;

    //DebugLn(['AddComponent ',dbgsName(NewComponentClass)]);
    if NewComponentClass = nil then exit;

    // check circles
    if TheFormEditor.ClassDependsOnComponent(NewComponentClass, LookupRoot) then
    begin
      IDEMessageDialog(lisInvalidCircle,
        Format(lisIsAThisCircleDependencyIsNotAllowed, [dbgsName(LookupRoot),
          dbgsName(NewComponentClass), #13]),
        mtError,[mbOk],'');
      exit;
    end;
    
    // create component and component interface
    DebugLn(['AddComponent ',DbgSName(NewComponentClass),' Parent=',DbgSName(NewParent),' ',NewLeft,',',NewTop,',',NewWidth,',',NewHeight]);
    DisableAutoSize:=true;
    NewComponent := TheFormEditor.CreateComponent(
       NewParent,NewComponentClass,'',
       NewLeft,NewTop,NewWidth,NewHeight,DisableAutoSize);
    if NewComponent=nil then exit;
    if DisableAutoSize and (NewComponent is TControl) then
      TControl(NewComponent).EnableAutoSizing;
    TheFormEditor.FixupReferences(NewComponent); // e.g. frame references a datamodule

    // modified
    Modified;


    // set initial properties
    if NewComponent is TControl then begin
      NewControl:=TControl(NewComponent);
      //debugln(['AddComponent ',DbgSName(Self),' Bounds=',dbgs(NewControl.BoundsRect),' BaseBounds=',dbgs(NewControl.BaseBounds),' BaseParentClientSize=',dbgs(NewControl.BaseParentClientSize)]);
      NewControl.Visible:=true;
      if csSetCaption in NewControl.ControlStyle then
        NewControl.Caption:=NewComponent.Name;
    end;
    if Assigned(FOnSetDesigning) then
      FOnSetDesigning(Self,NewComponent,True);

    if EnvironmentOptions.CreateComponentFocusNameProperty then begin
      // ask user for name
      NewName:=NewComponent.Name;
      ShowComponentNameDialog(LookupRoot,NewComponent,NewName);
      NewComponent.Name:=NewName;
    end;

    // 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
    MaxParentComponent: TComponent;
  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) then begin
      if MouseDownComponent=Form then
        MaxParentComponent:=FLookupRoot
      else
        MaxParentComponent:=MouseDownComponent;
    end else
      MaxParentComponent:=FLookupRoot;
    SelectionChanged:=false;
    ControlSelection.SelectWithRubberBand(
      FLookupRoot,Mediator,NewRubberbandSelection,ssShift in Shift,
      SelectionChanged,MaxParentComponent);
    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 (ssDouble in MouseDownShift) 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
      ControlSelection.RubberbandActive := False;
  end;

var
  Handled: Boolean;
begin
  FHintTimer.Enabled := False;
  FHintWindow.Visible := False;

  SetCaptureControl(nil);

  // check if the message is for the designed form
  // and there was a mouse down before
  DesignSender:=GetDesignControl(Sender);
  SenderParentForm:=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;

  GetMouseMsgShift(TheMessage,Shift,Button);
  MouseUpPos:=GetFormRelativeMousePosition(Form);

  {$IFDEF VerboseDesigner}
  DebugLn('************************************************************');
  DbgOut('MouseUpOnControl');
  DbgOut(' Sender=',dbgsName(Sender),' DesignSender=',dbgsName(DesignSender));
  //write(' Msg=',TheMessage.Pos.X,',',TheMessage.Pos.Y);
  DebugLn('');
  {$ENDIF}

  if (MouseDownComponent <> nil) and (MouseDownComponent is TControl) then
  begin
    if TControl(MouseDownComponent).Perform(CM_DESIGNHITTEST, 0, Longint(SmallPoint(MouseUpPos.X, MouseUpPos.Y))) > 0 then
    begin
      TControlAccess(MouseDownComponent).MouseUp(Button, Shift, MouseUpPos.X, MouseUpPos.Y);
      Exit;
    end;
  end;

  if Mediator<>nil then
  begin
    Handled:=false;
    Mediator.MouseUp(Button,Shift,MouseUpPos,Handled);
    if Handled then exit;
  end;

  if Button=mbLeft 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
      else
        ControlSelection.UpdateBounds;
    end else
    begin
      // create new a component on the form
      AddComponent;
    end;
  end
  else
  if Button=mbRight 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);
    FDesignerPopupMenu.Popup(PopupPos.X, PopupPos.Y);
  end;

  DisableRubberBand;

  LastMouseMovePos.X:=-1;
  if (not ControlSelection.OnlyVisualComponentsSelected and ShowComponentCaptions) or
     (dfHasSized in FFlags) then
    Form.Invalidate;
  Exclude(FFlags,dfHasSized);

  MouseDownComponent:=nil;
  MouseDownSender:=nil;
  {$IFDEF VerboseDesigner}
  DebugLn('[TDesigner.MouseLeftUpOnControl] END');
  {$ENDIF}
end;

procedure TDesigner.MouseMoveOnControl(Sender: TControl;
  var TheMessage: TLMMouse);
var
  Button: TMouseButton;
  Shift : TShiftState;
  SenderParentForm:TCustomForm;
  OldMouseMovePos: TPoint;
  Grabber: TGrabber;
  ACursor: TCursor;
  SelectedCompClass: TRegisteredComponent;
  CurSnappedMousePos, OldSnappedMousePos: TPoint;
  DesignSender: TControl;
  Handled: Boolean;
begin
  GetMouseMsgShift(TheMessage, Shift, Button);

  if [dfShowEditorHints] * FFlags <> [] then
  begin
    FHintTimer.Enabled := False;
    // hide hint
    FHintTimer.Enabled := Shift * [ssLeft, ssRight, ssMiddle] = [];
    if not (dfHasSized in FFlags) then
      FHintWindow.Visible := False;
  end;

  DesignSender := GetDesignControl(Sender);
  //DebugLn('TDesigner.MouseMoveOnControl Sender=',dbgsName(Sender),' ',dbgsName(DesignSender));
  SenderParentForm := 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 (MouseDownComponent <> nil) and (MouseDownComponent is TControl) then
  begin
    if TControl(MouseDownComponent).Perform(CM_DESIGNHITTEST, 0, Longint(SmallPoint(LastMouseMovePos.X, LastMouseMovePos.Y))) > 0 then
    begin
      TControlAccess(MouseDownComponent).MouseMove(Shift, LastMouseMovePos.X, LastMouseMovePos.Y);
      Exit;
    end;
  end;

  if Mediator <> nil then
  begin
    Handled := False;
    Mediator.MouseMove(Shift, LastMouseMovePos, Handled);
    if Handled then Exit;
  end;

  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
      ACursor := Grabber.Cursor;

    if ACursor <> LastFormCursor then
    begin
      LastFormCursor := ACursor;
      SetTempCursor(Form, ACursor);
    end;
    Exit;
  end;

  if (ControlSelection.SelectionForm = nil) or (ControlSelection.SelectionForm = Form) then
  begin
    if Button = mbLeft then // left button pressed
    begin
      if (ControlSelection.ActiveGrabber <> nil) then // grabber active => resizing
      begin
        // grabber moving -> size selection
        if not ControlSelection.LookupRootSelected then // if not current form is selected then resize selection
        begin
          if not (dfHasSized in FFlags) then
          begin
            ControlSelection.SaveBounds;
            Include(FFlags, dfHasSized);
          end;
          // skip snapping when Alt is pressed
          if not (ssAlt in Shift) then
          begin
            OldSnappedMousePos := ControlSelection.SnapGrabberMousePos(OldMouseMovePos);
            CurSnappedMousePos := ControlSelection.SnapGrabberMousePos(LastMouseMovePos);
          end
          else
          begin
            OldSnappedMousePos := OldMouseMovePos;
            CurSnappedMousePos := LastMouseMovePos;
          end;
          ControlSelection.SizeSelection(
            CurSnappedMousePos.X - OldSnappedMousePos.X,
            CurSnappedMousePos.Y - OldSnappedMousePos.Y);
          DoModified;
        end;
      end
      else
      begin // no grabber active => moving
        SelectedCompClass := GetSelectedComponentClass;
        if (not ControlSelection.RubberBandActive) and
           (SelectedCompClass=nil) and
           ((Shift=[ssLeft]) or (Shift=[ssAlt, ssLeft])) 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 ((ssAlt in Shift) and ControlSelection.MoveSelection(LastMouseMovePos.X - MouseDownPos.X, LastMouseMovePos.Y - MouseDownPos.Y, True)) or
             ControlSelection.MoveSelectionWithSnapping(LastMouseMovePos.X - MouseDownPos.X, LastMouseMovePos.Y - MouseDownPos.Y) then
            DoModified;
        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
      ControlSelection.ActiveGrabber:=nil;
  end;
  if [dfShowEditorHints, dfHasSized] * FFlags = [dfShowEditorHints, dfHasSized] then
    HintTimer(Self);
end;


{
-----------------------------K E Y D O W N -------------------------------
}
{
  Handles the keydown messages.  DEL deletes the selected controls, CTRL-ARROR
  moves the selection up one, SHIFT-ARROW resizes, etc.
}
Procedure TDesigner.KeyDown(Sender : TControl; var TheMessage: TLMKEY);
var
  Shift: TShiftState;
  Command: word;
  Handled: boolean;
  
  procedure Nudge(x, y: integer);
  begin
    if (ssCtrl in Shift) then
    begin
      if ssShift in Shift then
      begin
        x := x * GetGridSizeX;
        y := y * GetGridSizeY;
      end;
      NudgePosition(x, y)
    end
    else
    if (ssShift in Shift) then
      NudgeSize(x, y)
    else
    if (Shift = []) then
      NudgeSelection(x, y);
  end;

begin
  {$IFDEF VerboseDesigner}
  DebugLn(['TDesigner.KEYDOWN ',TheMessage.CharCode,' ',TheMessage.KeyData]);
  {$ENDIF}

  Shift := KeyDataToShiftState(TheMessage.KeyData);

  Handled := False;

  if Mediator<>nil then
    Mediator.KeyDown(Sender,TheMessage.CharCode,Shift);

  Command := FTheFormEditor.TranslateKeyToDesignerCommand(
                                                    TheMessage.CharCode, Shift);
  //DebugLn(['TDesigner.KEYDOWN Command=',dbgs(Command),' ',TheMessage.CharCode,' ',dbgs(Shift)]);
  DoProcessCommand(Self, Command, Handled);
  //DebugLn(['TDesigner.KeyDown Command=',Command,' Handled=',Handled,' TheMessage.CharCode=',TheMessage.CharCode]);

  if not Handled 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_TAB:
        if Shift = [ssShift] then
          NudgeSelection(False)
        else
        if Shift = [] then
          NudgeSelection(True)
        else
          Handled := False;

      VK_RETURN:
        if Shift = [] then
          DoShowObjectInspector
        else
          Handled := False;

      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);
var
  Shift: TShiftState;
Begin
  {$IFDEF VerboseDesigner}
  //Writeln('TDesigner.KEYUP ',TheMessage.CharCode,' ',TheMessage.KeyData);
  {$ENDIF}
  if Mediator<>nil then begin
    Shift := KeyDataToShiftState(TheMessage.KeyData);
    Mediator.KeyUp(Sender,TheMessage.CharCode,Shift);
  end;
end;

function TDesigner.DoDeleteSelectedPersistents: boolean;
var
  i: integer;
  APersistent: TPersistent;
  AncestorRoot: TComponent;
  AComponent: TComponent;
begin
  Result:=true;
  if (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,
       [mbOk],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, [mbOk],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, [mbOk],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;
  AComponent: TComponent;
  AForm: TCustomForm;
begin
  if APersistent=nil then exit;
  try
    //debugln(['TDesigner.DoDeletePersistent A ',dbgsName(APersistent),' FreeIt=',FreeIt]);
    PopupMenuComponentEditor:=nil;
    // unselect component
    ControlSelection.Remove(APersistent);
    if (APersistent is TComponent) then begin
      AComponent:=TComponent(APersistent);
      if csDestroying in AComponent.ComponentState then
        FreeIt:=false;
    end;
    AForm:=GetDesignerForm(APersistent);
    if AForm=nil then begin
      // has no designer
      // -> do not call handlers and simply get rid of the rubbish
      if FreeIt then begin
        //debugln('TDesigner.DoDeletePersistent UNKNOWN in formeditor: ',dbgsName(APersistent));
        APersistent.Free;
      end;
      exit;
    end;
    // call component deleting handlers
    Hook:=GetPropertyEditorHook;
    if Hook<>nil then
      Hook.PersistentDeleting(APersistent);
    // delete component
    if APersistent is TComponent then
      TheFormEditor.DeleteComponent(TComponent(APersistent),FreeIt)
    else if FreeIt then
      APersistent.Free;
  finally
    // unmark component
    DeletingPersistent.Remove(APersistent);
    IgnoreDeletingPersistent.Remove(APersistent);
  end;
  // 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);
      LM_CONTEXTMENU: HandlePopupMenu(Sender, TLMContextMenu(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;
  DoModified;
  inherited Modified;
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;
  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.BeginPainting;
  try
    // exclude all child control areas
    Count:=AWinControl.ControlCount;
    for i := 0 to Count - 1 do begin
      with AWinControl.Controls[I] do begin
        if (Visible or ((csDesigning in ComponentState)
          and not (csNoDesignVisible in ControlStyle)))
        then begin
          Clip := ExcludeClipRect(aDDC.DC, Left, Top, Left + Width, Top + Height);
          if Clip = NullRegion then exit;
        end;
      end;
    end;

    // paint points
    if ShowGrid then
    begin
      ADDC.Canvas.Pen.Color := GridColor;
      ADDC.Canvas.Pen.Width := 1;
      ADDC.Canvas.Pen.Style := psSolid;
      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];
        if csNoDesignSelectable in CurControl.ControlStyle then
          Continue;
        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.EndPainting;
  end;
end;

procedure TDesigner.ValidateRename(AComponent: TComponent;
  const CurName, NewName: string);
begin
  // check if component is initialized
  if (CurName='') or (NewName='')
  or ((AComponent<>nil) and (csDestroying in AComponent.ComponentState)) then
    exit;

  // check if component is the LookupRoot
  if AComponent=nil then AComponent:=FLookupRoot;

  // consistency check
  if CurName<>AComponent.Name then
    DebugLn('WARNING: TDesigner.ValidateRename: OldComponentName="',CurName,'" <> AComponent=',dbgsName(AComponent));
  if Assigned(OnRenameComponent) then
    OnRenameComponent(Self,AComponent,NewName);
end;

function TDesigner.GetShiftState: TShiftState;
begin
  Result:=FShiftState;
end;

function TDesigner.CreateUniqueComponentName(const AClassName: string): string;
begin
  Result:=TheFormEditor.CreateUniqueComponentName(AClassName,FLookupRoot);
end;

procedure TDesigner.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.OnCenterFormMenuClick(Sender: TObject);
var
  NewLeft: Integer;
  NewTop: Integer;
begin
  if Form=nil then exit;
  NewLeft:=Max(30,(Screen.Width-Form.Width) div 2);
  NewTop:=Max(30,(Screen.Height-Form.Height) div 2);
  Form.SetBounds(NewLeft,NewTop,Form.Width,Form.Height);
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.SetMediator(const AValue: TDesignerMediator);
begin
  if Mediator=AValue then exit;
  if Mediator<>nil then Mediator.Designer:=nil;
  FMediator:=AValue;
  if Mediator<>nil then Mediator.Designer:=Self;
end;

procedure TDesigner.SetPopupMenuComponentEditor(const AValue: TBaseComponentEditor);
begin
   if FPopupMenuComponentEditor <> AValue then
   begin
     FPopupMenuComponentEditor.Free;
     FPopupMenuComponentEditor := AValue;
   end;
end;

procedure TDesigner.SetShowEditorHints(const AValue: boolean);
begin
  if AValue = ShowEditorHints then Exit;
  if AValue then
    Include(FFlags, dfShowEditorHints)
  else
    Exclude(FFlags, dfShowEditorHints);
end;

procedure TDesigner.DrawNonVisualComponent(AComponent: TComponent);
var
  Icon: TBitmap;
  ItemLeft, ItemTop, ItemRight, ItemBottom: integer;
  Diff, ItemLeftTop: TPoint;
  OwnerRect, IconRect, TextRect: TRect;
  TextSize: TSize;
  IsSelected: Boolean;
  RGN: HRGN;
begin
  if (AComponent is TControl)
  and (csNoDesignVisible in TControl(AComponent).ControlStyle) then
    exit;

  // draw children
  if (AComponent.Owner=nil) then
  begin
    FDDC.BeginPainting;
    TComponentAccess(AComponent).GetChildren(@DrawNonVisualComponent, AComponent);
    FDDC.EndPainting;
  end
  else if (csInline in AComponent.ComponentState) then
  begin
    if AComponent is TControl then
    begin
      // clip to client area
      FDDC.BeginPainting;
      FDDC.Canvas.SaveHandleState;
      OwnerRect := TControl(AComponent).ClientRect;
      Diff := GetParentFormRelativeClientOrigin(AComponent);
      OffsetRect(OwnerRect, Diff.X, Diff.Y);
      with OwnerRect do
        RGN := CreateRectRGN(Left, Top, Right, Bottom);
      SelectClipRGN(FDDC.DC, RGN);
      DeleteObject(RGN);
    end;
    TComponentAccess(AComponent).GetChildren(@DrawNonVisualComponent, AComponent);
    if AComponent is TControl then
    begin
      FDDC.Canvas.RestoreHandleState;
      FDDC.EndPainting;
    end;
  end
  else
    TComponentAccess(AComponent).GetChildren(@DrawNonVisualComponent, AComponent.Owner);

  if not ComponentIsIcon(AComponent) or (AComponent.Owner = nil) then
    Exit;
  // actual draw
  Diff := FDDC.FormOrigin;
  //DebugLn(['FDDC.FormOrigin - ', Diff.X, ' : ' ,Diff.Y]);
  // non-visual component
  ItemLeftTop := NonVisualComponentLeftTop(AComponent);
  ItemLeft := ItemLeftTop.X - Diff.X;
  ItemTop := ItemLeftTop.Y - Diff.Y;
  ItemRight := ItemLeft + NonVisualCompWidth;
  ItemBottom := ItemTop + NonVisualCompWidth;
  if not FDDC.RectVisible(ItemLeft, ItemTop, ItemRight, ItemBottom) then
    Exit;

  IsSelected := ControlSelection.IsSelected(AComponent);

  if FSurface = nil then
  begin
    FSurface := TBitmap.Create;
    FSurface.SetSize(NonVisualCompWidth, NonVisualCompWidth);
    FSurface.Canvas.Brush.Color := clBtnFace;
    FSurface.Canvas.Pen.Width := 1;
  end;

  IconRect := Rect(0, 0, NonVisualCompWidth, NonVisualCompWidth);
  FSurface.Canvas.Frame3D(IconRect, 1, bvRaised);
  FSurface.Canvas.FillRect(IconRect);
  if NonVisualCompBorder > 1 then
    InflateRect(IconRect, -NonVisualCompBorder + 1, -NonVisualCompBorder + 1);

  // draw component Name
  if ShowComponentCaptions
  and (((GetKeyState(VK_LBUTTON) and $80) = 0) or not IsSelected) then
  begin
    // workarounds gtk2 problem with DrawText on gc with GDK_INCLUDE_INFERIORS
    // it uses pango drawing and this for some reason does not take subwindow_mode
    // into account
    Icon := TBitmap.Create;
    try
      TextSize := FDDC.Canvas.TextExtent(AComponent.Name);
      Icon.SetSize(TextSize.cx, TextSize.cy);
      TextRect := Rect(0, 0, TextSize.cx, TextSize.cy);
      if FDDC.Form <> nil then
        Icon.Canvas.Brush.Color := FDDC.Form.Canvas.Brush.Color
      else
        Icon.Canvas.Brush.Color := clBtnFace;
      Icon.Canvas.FillRect(TextRect);
      DrawText(Icon.Canvas.Handle, PChar(AComponent.Name), -1, TextRect,
        DT_CENTER or DT_VCENTER or DT_SINGLELINE or DT_NOCLIP);
      FDDC.Canvas.Draw(
        (ItemLeft + ItemRight - TextSize.cx) div 2,
        ItemBottom + NonVisualCompBorder + 2, Icon);
    finally
      Icon.Free;
    end;
  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;
      FSurface.Canvas.StretchDraw(IconRect, Icon);
    end;
  end;
  FDDC.Canvas.Draw(ItemLeft, ItemTop, FSurface);
  if (ControlSelection.Count > 1) and IsSelected then
    ControlSelection.DrawMarkerAt(FDDC,
      ItemLeft, ItemTop, NonVisualCompWidth, NonVisualCompWidth);
end;

procedure TDesigner.DrawNonVisualComponents(aDDC: TDesignerDeviceContext);
begin
  FSurface := nil;
  FDDC := aDDC;
  DrawNonVisualComponent(FLookupRoot);
  FDDC := nil;
  if FSurface <> nil then
    FSurface.Free;
end;

procedure TDesigner.DrawDesignerItems(OnlyIfNeeded: boolean);
var
  DesignerDC: HDC;
begin
  if WidgetSet.GetLCLCapability(lcCanDrawOutsideOnPaint) = 0 then Exit;
  if OnlyIfNeeded and (not (dfNeedPainting in FFlags)) then exit;
  Exclude(FFlags,dfNeedPainting);

  if (Form=nil) or (not Form.HandleAllocated) then exit;

  //writeln('TDesigner.DrawDesignerItems B painting');
  DesignerDC := GetDesignerDC(Form.Handle);
  DDC.SetDC(Form, Form, DesignerDC);
  DDC.BeginPainting;
  DoPaintDesignerItems;
  DDC.EndPainting;
  DDC.Clear;
  ReleaseDesignerDC(Form.Handle, DesignerDC);
end;

procedure TDesigner.CheckFormBounds;
// check if the Form was moved or resized
// Note: During form loading the window manager can resize and position
//       the Form. Such initial changes are ignored, by waiting and comparing
//       not before the IDE becomes idle. When the IDE becomes the first time
//       idle, the form bounds are stored and used as default.
//       After that any change of the Form Bounds is treated as a user move
//       and thus calls Modified.
var
  NewFormBounds: TRect;
begin
  NewFormBounds:=Form.BoundsRect;
  if FDefaultFormBoundsValid then begin
    if (not 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.ComponentIsIcon(AComponent: TComponent): boolean;
begin
  Result:=DesignerProcs.ComponentIsNonVisual(AComponent);
  if Result and (Mediator<>nil) then
    Result:=Mediator.ComponentIsIcon(AComponent);
end;

function TDesigner.GetParentFormRelativeClientOrigin(AComponent: TComponent): TPoint;
var
  CurClientArea: TRect;
  ScrollOffset: TPoint;
begin
  if Mediator<>nil then begin
    Result:=Mediator.GetComponentOriginOnForm(AComponent);
    Mediator.GetClientArea(AComponent,CurClientArea,ScrollOffset);
    inc(Result.X,CurClientArea.Left+ScrollOffset.X);
    inc(Result.Y,CurClientArea.Top+ScrollOffset.Y);
  end else begin
    Result:=DesignerProcs.GetParentFormRelativeClientOrigin(AComponent);
  end;
end;

function TDesigner.GetDesignedComponent(AComponent: TComponent): TComponent;
begin
  Result:=AComponent;
  if AComponent=Form then begin
    Result:=FLookupRoot;
  end else begin
    while (Result<>nil)
    and (Result<>FLookupRoot)
    and (Result.Owner<>FLookupRoot)
    and (Result is TControl) do
      Result:=TControl(Result).Parent;
  end;
end;

function TDesigner.GetComponentEditorForSelection: TBaseComponentEditor;
begin
  Result := nil;
  if (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 ClearOldOnes then
    DesignerMenuSectionComponentEditor.Clear;

  if (AComponentEditor = nil) or (DesignerMenuSectionComponentEditor = nil) then
    Exit;

  VerbCount := AComponentEditor.GetVerbCount;
  for i := 0 to VerbCount - 1 do
  begin
    NewMenuCmd:=RegisterIDEMenuCommand(DesignerMenuSectionComponentEditor,
      'ComponentEditorVerMenuItem' + IntToStr(i),
      AComponentEditor.GetVerb(i),
      @OnComponentEditorVerbMenuItemClick);
    if NewMenuCmd.MenuItem<>nil then
      AComponentEditor.PrepareItem(i, NewMenuCmd.MenuItem);
  end;
end;

function TDesigner.NonVisualComponentAtPos(X, Y: integer): TComponent;
var
  s: TComponentSearch;
begin
  s := TComponentSearch.Create(nil);
  try
    s.MinClass := TComponent;
    s.AtPos := Point(X,Y);
    s.IgnoreHidden := true;
    s.OnlyNonVisual := true;
    s.Search(FLookupRoot);
    s.Mediator := Mediator;
    Result := s.Best;
  finally
    s.Free;
  end;
end;

procedure TDesigner.MoveNonVisualComponentIntoForm(AComponent: TComponent);
var
  X, Y: SmallInt;
begin
  DesignInfoToLeftTop(AComponent.DesignInfo, X, Y);
  AComponent.DesignInfo := LeftTopToDesignInfo(X, Y);
end;

procedure TDesigner.MoveNonVisualComponentsIntoForm;
var
  i: Integer;
  AComponent: TComponent;
begin
  for i:=0 to FLookupRoot.ComponentCount-1 do begin
    AComponent:=FLookupRoot.Components[i];
    if ComponentIsIcon(AComponent) then begin
      MoveNonVisualComponentIntoForm(AComponent);
    end;
  end;
end;

function TDesigner.ComponentClassAtPos(const AClass: TComponentClass;
  const APos: TPoint; const UseRootAsDefault, IgnoreHidden: boolean): TComponent;
var
  s: TComponentSearch;
  MediatorFlags: TDMCompAtPosFlags;
begin
  if Mediator <> nil then
  begin
    MediatorFlags := [];
    if IgnoreHidden then
      Include(MediatorFlags, dmcapfOnlyVisible);
    Result := Mediator.ComponentAtPos(APos,AClass,MediatorFlags);
  end
  else
  begin
    s := TComponentSearch.Create(nil);
    try
      s.AtPos := APos;
      s.MinClass := AClass;
      s.IgnoreHidden := IgnoreHidden;
      s.Search(FLookupRoot);
      s.Mediator := Mediator;
      Result := s.Best;
    finally
      s.Free;
    end;
  end;

  if (Result = nil) and UseRootAsDefault and (FLookupRoot.InheritsFrom(AClass)) then
    Result := LookupRoot;
end;

procedure TDesigner.SetTempCursor(ARoot: TWinControl; ACursor: TCursor);

  procedure Traverse(ARoot: TWinControl);
  var
    i: integer;
  begin
    for i := 0 to ARoot.ControlCount - 1 do
    begin
      ARoot.Controls[i].SetTempCursor(ACursor);
      if ARoot.Controls[i] is TWinControl then
        Traverse(TWinControl(ARoot.Controls[i]));
    end;
  end;

begin
  Traverse(ARoot);
  ARoot.SetTempCursor(ACursor);
end;

function TDesigner.WinControlAtPos(x, y: integer; UseRootAsDefault,
  IgnoreHidden: boolean): TWinControl;
begin
  Result := TWinControl(ComponentClassAtPos(TWinControl, Point(x,y),
                                            UseRootAsDefault, IgnoreHidden));
end;

function TDesigner.ControlAtPos(x, y: integer; UseRootAsDefault,
  IgnoreHidden: boolean): TControl;
begin
  Result := TControl(ComponentClassAtPos(TControl, Point(x,y), UseRootAsDefault,
                                IgnoreHidden));
end;

function TDesigner.ComponentAtPos(x, y: integer; UseRootAsDefault,
  IgnoreHidden: boolean): TComponent;
begin
  Result := ComponentClassAtPos(TComponent, Point(x,y), UseRootAsDefault,
                                IgnoreHidden);
end;

procedure TDesigner.BuildPopupMenu;
begin
  if FDesignerPopupMenu = nil then
  begin
    FDesignerPopupMenu:=TPopupMenu.Create(nil);
    with FDesignerPopupMenu do
    begin
      Name := 'DesignerPopupmenu';
      OnPopup := @DesignerPopupMenuPopup;
      Images := IDEImages.Images_16;
    end;
  end;
  

  // assign the root TMenuItem to the registered menu root.
  // This will automatically create all registered items
  {$IFDEF VerboseMenuIntf}
  DesignerPopupMenu.Items.WriteDebugReport('TSourceNotebook.BuildPopupMenu ');
  DesignerMenuRoot.ConsistencyCheck;
  {$ENDIF}
  DesignerMenuRoot.MenuItem := FDesignerPopupMenu.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;
  DesignerMenuCenterForm.OnClick:=@OnCenterFormMenuClick;

  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);

  function GetComponentHintText(AComponent: TComponent): String;
  const
    HintNameStr = '%s: %s';
    HintPositionStr = 'Position: %d, %d';
    HintSizeStr = 'Size: %d x %d';
    HintTabStr = 'TabStop: %s; TabOrder: %d';
  var
    AControl: TControl absolute AComponent;
    AWinControl: TWinControl absolute AComponent;
    AComponentEditor:TBaseComponentEditor;
  begin
    // component name and classname
    Result := Format(HintNameStr, [AComponent.Name, AComponent.ClassName]);
    // component position
    Result := Result + LineEnding + Format(HintPositionStr, [GetComponentLeft(AComponent), GetComponentTop(AComponent)]);
    if AComponent is TControl then // more info for controls
    begin
      // size
      Result := Result + '; ' + Format(HintSizeStr, [AControl.Width, AControl.Height]);
      // and TabStop, TabOrder for TWinControl
      if (AComponent is TWinControl) and not (AComponent = Form) then
        Result := Result + LineEnding + Format(HintTabStr, [BoolToStr(AWinControl.TabStop, True), AWinControl.TabOrder]);
    end;
    AComponentEditor:=TheFormEditor.GetComponentEditor(AComponent);
    if AComponentEditor<>nil then
      Result := Result + AComponentEditor.GetCustomHint;
  end;

  function GetSelectionSizeHintText: String;
  begin
    Result := Format('%d x %d', [ControlSelection.Width, ControlSelection.Height]);
  end;

  function GetSelectionPosHintText: String;

    function ParentComponent(AComponent: TComponent): TComponent;
    begin
      Result := AComponent.GetParentComponent;
      if (Result = nil) and ComponentIsIcon(AComponent) then
        Result := AComponent.Owner;
    end;

  var
    BaseParent, TestParent: TComponent;
    BaseFound: Boolean;
    i: integer;
    P: TPoint;
  begin
    BaseFound := ControlSelection[0].IsTComponent;
    // search for one parent of our selection
    if BaseFound then
    begin
      BaseParent := ParentComponent(TComponent(ControlSelection[0].Persistent));
      BaseFound := BaseParent is TWinControl;
      if BaseFound then
      begin
        for i := 1 to ControlSelection.Count - 1 do
        begin
          if ControlSelection[0].IsTComponent then
            TestParent := ParentComponent(TComponent(ControlSelection[0].Persistent))
          else
            TestParent := nil;
          if TestParent <> BaseParent then
          begin
            BaseFound := False;
            Break;
          end;
        end;
      end;
    end;
    P := Point(ControlSelection.Left, ControlSelection.Top);
    if BaseFound then
      P := TWinControl(BaseParent).ScreenToClient(Form.ClientToScreen(P));
    Result := Format('%d, %d', [P.X, P.Y]);
  end;

var
  Rect: TRect;
  AHint: String;
  Position, ClientPos: TPoint;
  AWinControl: TWinControl;
  AComponent: TComponent;
begin
  FHintTimer.Enabled := False;
  if [dfShowEditorHints]*FFlags=[] then exit;

  Position := Mouse.CursorPos;
  if not (dfHasSized in FFlags) then
  begin
    AWinControl := FindLCLWindow(Position);
    if not (Assigned(AWinControl)) then Exit;
    if GetDesignerForm(AWinControl) <> Form then exit;

    // search a component at the position
    ClientPos := Form.ScreenToClient(Position);
    AComponent := ComponentAtPos(ClientPos.X,ClientPos.Y,true,true);
    if not Assigned(AComponent) then
      AComponent := AWinControl;
    AComponent := GetDesignedComponent(AComponent);
    if AComponent = nil then exit;
    AHint := GetComponentHintText(AComponent);
  end
  else
  begin
    // components are either resize or move
    if (ControlSelection.LookupRoot <> Form) or (ControlSelection.Count = 0) then
      Exit;

    if ControlSelection.ActiveGrabber <> nil then
      AHint := GetSelectionSizeHintText
    else
      AHint := GetSelectionPosHintText;
  end;

  Rect := FHintWindow.CalcHintRect(0, AHint, nil);  //no maxwidth
  Rect.Left := Position.X + 15;
  Rect.Top := Position.Y + 15;
  Rect.Right := Rect.Left + Rect.Right;
  Rect.Bottom := Rect.Top + Rect.Bottom;

  FHintWindow.ActivateHint(Rect, AHint);
end;

procedure TDesigner.SetSnapToGrid(const AValue: boolean);
begin
  if SnapToGrid=AValue then exit;
  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.

Designer.pp (127,322 bytes)

Zeljan Rikalo

2010-08-27 19:00

developer   ~0040549

I don't see any patch here.

2010-08-27 20:01

 

componenteditors.patch (1,023 bytes)
--- lazarus/ideintf/componenteditors.pas 
+++ lazarus.old/ideintf/componenteditors.pas 
@@ -174,6 +174,7 @@
     function GetComponent: TComponent; virtual; abstract;
     function GetDesigner: TComponentEditorDesigner; virtual; abstract;
     function GetHook(out Hook: TPropertyEditorHook): boolean; virtual; abstract;
+    function GetCustomHint:String; virtual; abstract;
     procedure Modified; virtual; abstract;
   end;
 
@@ -205,6 +206,7 @@
     property Component: TComponent read FComponent;
     property Designer: TComponentEditorDesigner read GetDesigner;
     function GetHook(out Hook: TPropertyEditorHook): boolean; override;
+    function GetCustomHint: String; override;
     function HasHook: boolean;
     procedure Modified; override;
   end;
@@ -546,6 +548,11 @@
   if GetDesigner=nil then exit;
   Hook:=GetDesigner.PropertyEditorHook;
   Result:=Hook<>nil;
+end;
+
+function TComponentEditor.GetCustomHint: String;
+begin
+  Result:=LineEnding;
 end;
 
 function TComponentEditor.HasHook: boolean;
componenteditors.patch (1,023 bytes)

2010-08-27 20:04

 

designer.patch (808 bytes)
--- lazarus/designer/designer.pp 
+++ lazarus.old/designer/designer.pp 
@@ -3697,6 +3697,7 @@
   var
     AControl: TControl absolute AComponent;
     AWinControl: TWinControl absolute AComponent;
+    AComponentEditor:TBaseComponentEditor;
   begin
     // component name and classname
     Result := Format(HintNameStr, [AComponent.Name, AComponent.ClassName]);
@@ -3710,6 +3711,9 @@
       if (AComponent is TWinControl) and not (AComponent = Form) then
         Result := Result + LineEnding + Format(HintTabStr, [BoolToStr(AWinControl.TabStop, True), AWinControl.TabOrder]);
     end;
+    AComponentEditor:=TheFormEditor.GetComponentEditor(AComponent);
+    if AComponentEditor<>nil then
+      Result := Result + AComponentEditor.GetCustomHint;
   end;
 
   function GetSelectionSizeHintText: String;
designer.patch (808 bytes)

Fabio Luis Girardi

2010-08-27 20:05

reporter   ~0040554

Sorry, I'm so stupid. I sent the source of changed files and not the patch. Now I uploaded the patches based on rev 27207 of lazarus.

Fabio Luis Girardi

2010-09-01 15:28

reporter   ~0040712

Patches is here.

Paul Ishenin

2010-11-19 08:20

manager   ~0043225

Please test and close if ok.

Fabio Luis Girardi

2010-11-23 19:39

reporter   ~0043427

Thanks!!

Issue History

Date Modified Username Field Change
2010-08-19 19:09 Fabio Luis Girardi New Issue
2010-08-19 19:09 Fabio Luis Girardi File Added: ComponentEditors.pas
2010-08-19 19:09 Fabio Luis Girardi Widgetset => GTK, GTK 2, Win32/Win64, WinCE, Carbon, QT, fpGUI
2010-08-19 19:11 Fabio Luis Girardi File Added: Designer.pp
2010-08-27 19:00 Zeljan Rikalo LazTarget => -
2010-08-27 19:00 Zeljan Rikalo Note Added: 0040549
2010-08-27 19:00 Zeljan Rikalo Status new => feedback
2010-08-27 20:01 Fabio Luis Girardi File Added: componenteditors.patch
2010-08-27 20:04 Fabio Luis Girardi File Added: designer.patch
2010-08-27 20:05 Fabio Luis Girardi Note Added: 0040554
2010-09-01 15:28 Fabio Luis Girardi Note Added: 0040712
2010-10-26 22:18 Vincent Snijders LazTarget - => 0.9.30
2010-10-26 22:18 Vincent Snijders Status feedback => acknowledged
2010-10-26 22:18 Vincent Snijders Target Version => 0.9.30
2010-11-19 08:20 Paul Ishenin Fixed in Revision => 28336
2010-11-19 08:20 Paul Ishenin Status acknowledged => resolved
2010-11-19 08:20 Paul Ishenin Fixed in Version => 0.9.29 (SVN)
2010-11-19 08:20 Paul Ishenin Resolution open => fixed
2010-11-19 08:20 Paul Ishenin Assigned To => Paul Ishenin
2010-11-19 08:20 Paul Ishenin Note Added: 0043225
2010-11-23 19:39 Fabio Luis Girardi Status resolved => closed
2010-11-23 19:39 Fabio Luis Girardi Note Added: 0043427