IDEIntf: form designer: added AddClicked hook, called whenever the user selected a component class and clicked on the designer to add a new component

git-svn-id: trunk@44335 -

components/ideintf/propedits.pp

@@ -1165,6 +1165,11 @@ type
   TPropHookGetComponentNames = procedure(TypeData: PTypeData;
                                          Proc: TGetStrProc) of object;
   TPropHookGetRootClassName = function:ShortString of object;
+  TPropHookAddClicked = function(ADesigner: TIDesigner;
+                            MouseDownComponent: TComponent; Button: TMouseButton;
+                            Shift: TShiftState; X, Y: Integer;
+                            var AComponentClass: TComponentClass;
+                            var NewParent: TComponent): boolean of object;
   TPropHookBeforeAddPersistent = function(Sender: TObject;
                                          APersistentClass: TPersistentClass;
                                          Parent: TPersistent): boolean of object;
@@ -1210,6 +1215,7 @@ type
     htGetComponentName,
     htGetComponentNames,
     htGetRootClassName,
+    htAddClicked, // user selected a component class and clicked on a form to add a component
     htComponentRenamed,
     // persistent selection
     htBeforeAddPersistent,
@@ -1273,6 +1279,11 @@ type
     function GetComponentName(AComponent: TComponent): ShortString;
     procedure GetComponentNames(TypeData: PTypeData; const Proc: TGetStrProc);
     function GetRootClassName: ShortString;
+    function AddClicked(ADesigner: TIDesigner;
+                        MouseDownComponent: TComponent; Button: TMouseButton;
+                        Shift: TShiftState; X, Y: Integer;
+                        var AComponentClass: TComponentClass;
+                        var NewParent: TComponent): boolean;
     function BeforeAddPersistent(Sender: TObject;
                                  APersistentClass: TPersistentClass;
                                  Parent: TPersistent): boolean;
@@ -1354,6 +1365,8 @@ type
                          const OnGetComponentNames: TPropHookGetComponentNames);
     procedure RemoveHandlerGetComponentNames(
                          const OnGetComponentNames: TPropHookGetComponentNames);
+    procedure AddHandlerAddClicked(const Handler: TPropHookAddClicked);
+    procedure RemoveHandlerAddClicked(const Handler: TPropHookAddClicked);
     procedure AddHandlerGetRootClassName(
                            const OnGetRootClassName: TPropHookGetRootClassName);
     procedure RemoveHandlerGetRootClassName(
@@ -5503,6 +5516,27 @@ begin
     Result := LookupRoot.ClassName;
 end;
 
+function TPropertyEditorHook.AddClicked(ADesigner: TIDesigner;
+  MouseDownComponent: TComponent; Button: TMouseButton; Shift: TShiftState; X,
+  Y: Integer; var AComponentClass: TComponentClass; var NewParent: TComponent
+  ): boolean;
+var
+  i: Integer;
+  Handler: TPropHookAddClicked;
+begin
+  i := GetHandlerCount(htAddClicked);
+  while GetNextHandlerIndex(htAddClicked, i) do
+  begin
+    Handler := TPropHookAddClicked(FHandlers[htAddClicked][i]);
+    Result := Handler(ADesigner,MouseDownComponent,Button,Shift,X,Y,
+                      AComponentClass,NewParent);
+    if not Result then exit;
+    if AComponentClass=nil then
+      exit(false);
+  end;
+  Result := True;
+end;
+
 function TPropertyEditorHook.BeforeAddPersistent(Sender: TObject;
   APersistentClass: TPersistentClass; Parent: TPersistent): boolean;
 var
@@ -5950,6 +5984,18 @@ begin
   RemoveHandler(htGetComponentNames,TMethod(OnGetComponentNames));
 end;
 
+procedure TPropertyEditorHook.AddHandlerAddClicked(
+  const Handler: TPropHookAddClicked);
+begin
+  AddHandler(htAddClicked,TMethod(Handler));
+end;
+
+procedure TPropertyEditorHook.RemoveHandlerAddClicked(
+  const Handler: TPropHookAddClicked);
+begin
+  RemoveHandler(htAddClicked,TMethod(Handler));
+end;
+
 procedure TPropertyEditorHook.AddHandlerGetRootClassName(
   const OnGetRootClassName: TPropHookGetRootClassName);
 begin

designer/designer.pp

@@ -2190,9 +2190,13 @@ var
     //debugln(['AddComponent NewComponentClass=',DbgSName(NewComponentClass)]);
 
     // find a parent for the new component
-    NewParent := FLookupRoot;
+    NewParent:=nil;
+    PropertyEditorHook.AddClicked(Self,MouseDownComponent,Button,Shift,
+      MouseUpPos.X,MouseUpPos.Y,NewComponentClass,NewParent);
     if Mediator<>nil then begin
-      NewParent:=MouseDownComponent;
+      // mediator, non LCL components
+      if NewParent=nil then
+        NewParent:=MouseDownComponent;
       while (NewParent<>nil)
       and (not Mediator.ParentAcceptsChild(NewParent,NewComponentClass)) do
         NewParent:=NewParent.GetParentComponent;
@@ -2200,7 +2204,14 @@ var
         NewParent:=FLookupRoot;
     end else if (FLookupRoot is TCustomForm) or (FLookupRoot is TCustomFrame)
     then begin
-      if MouseDownComponent is TWinControl then
+      // LCL controls
+      if NewParent<>nil then begin
+        if not (NewParent is TWinControl) then begin
+          debugln(['ERROR: AddComponent failed: AddClicked returned not a TWinControl: ',DbgSName(NewParent)]);
+          exit;
+        end;
+        NewParentControl := TWinControl(NewParent);
+      end else if MouseDownComponent is TWinControl then
         NewParentControl := TWinControl(MouseDownComponent)
       else
         NewParentControl := WinControlAtPos(MouseUpPos.X, MouseUpPos.Y, true, true);
@@ -2212,14 +2223,17 @@ var
         NewParentControl := NewParentControl.Parent;
       NewParent := NewParentControl;
       //debugln(['AddComponent NewParent=',DbgSName(NewParent)]);
+    end else begin
+      // TDataModule
+      NewParent := FLookupRoot;
     end;
     if not Assigned(NewParent) then exit;
 
     if not PropertyEditorHook.BeforeAddPersistent(Self,
-                                     SelectedCompClass.ComponentClass,NewParent)
+                                     NewComponentClass,NewParent)
     then begin
-      DebugLn('TDesigner.AddComponent ',
+      DebugLn('Note: TDesigner.AddComponent BeforeAddPersistent failed: ComponentClass=',
-              SelectedCompClass.ComponentClass.ClassName,' not possible');
+              NewComponentClass.ClassName,' NewParent=',DbgSName(NewParent));
       exit;
     end;
 
@@ -2232,7 +2246,7 @@ var
       // adjust left,top to parent origin
       dec(NewLeft,ParentClientOrigin.X);
       dec(NewTop,ParentClientOrigin.Y);
-    end else if SelectedCompClass.ComponentClass.InheritsFrom(TControl) then
+    end else if NewComponentClass.InheritsFrom(TControl) then
     begin
       ParentClientOrigin:=GetParentFormRelativeClientOrigin(NewParent);
       // adjust left,top to parent origin