IDEIntf: designer mediator: started ComponentAtPos

git-svn-id: trunk@21638 -

designer/designer.pp

@@ -2762,22 +2762,30 @@ function TDesigner.ComponentClassAtPos(const AClass: TComponentClass;
   var
     i: integer;
     Bounds: TRect;
+    Flags: TDMCompAtPosFlags;
   begin
-    for i := FLookupRoot.ComponentCount - 1 downto 0 do
-    begin
-      Result := FLookupRoot.Components[i]; // bit tricky, but we set it to nil anyhow
-      if not Result.InheritsFrom(AClass) then Continue;
-      if Result is TControl then begin
-        if IgnoreHidden and (not ControlIsInDesignerVisible(TControl(Result)))
-        then
-          Continue;
-        if csNoDesignSelectable in TControl(Result).ControlStyle then
-          continue;
+    if Mediator<>nil then begin
+      Flags:=[];
+      if IgnoreHidden then
+        Include(Flags,dmcapfOnlyVisible);
+      Result:=Mediator.ComponentAtPos(APos,AClass,Flags);
+    end else begin
+      for i := FLookupRoot.ComponentCount - 1 downto 0 do
+      begin
+        Result := FLookupRoot.Components[i]; // bit tricky, but we set it to nil anyhow
+        if not Result.InheritsFrom(AClass) then Continue;
+        if Result is TControl then begin
+          if IgnoreHidden and (not ControlIsInDesignerVisible(TControl(Result)))
+          then
+            Continue;
+          if csNoDesignSelectable in TControl(Result).ControlStyle then
+            continue;
+        end;
+        Bounds := GetParentFormRelativeBounds(Result);
+        if PtInRect(Bounds, APos) then Exit;
       end;
-      Bounds := GetParentFormRelativeBounds(Result);
-      if PtInRect(Bounds, APos) then Exit;
+      Result := nil;
     end;
-    Result := nil;
   end;
 
   function DoWinControl: TComponent;

examples/designnonlcl/mywidgetdesigner.pas

@@ -89,7 +89,7 @@ end;
 class function TMyWidgetMediator.CreateMediator(TheOwner, aForm: TComponent
   ): TDesignerMediator;
 begin
-  Result:=TMyWidgetMediator.Create(TheOwner);
+  Result:=inherited CreateMediator(TheOwner,aForm);
   TMyWidgetMediator(Result).FMyForm:=aForm as TMyForm;
 end;
 

examples/designnonlcl/mywidgetset.pas

@@ -82,6 +82,7 @@ type
     procedure SetParentComponent(Value: TComponent); override;
     function HasParent: Boolean; override;
     function GetParentComponent: TComponent; override;
+    procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
   public
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
@@ -244,6 +245,15 @@ begin
   Result:=Parent;
 end;
 
+procedure TMyWidget.GetChildren(Proc: TGetChildProc; Root: TComponent);
+var
+  i: Integer;
+begin
+  for i:=0 to ChildCount-1 do
+    if Childs[i].Owner=Root then
+      Proc(Childs[i]);
+end;
+
 constructor TMyWidget.Create(AOwner: TComponent);
 begin
   inherited Create(AOwner);

examples/designnonlcl/project/NonLCL1.lpi

@@ -44,8 +44,7 @@
       <Unit1>
         <Filename Value="unit1.pas"/>
         <IsPartOfProject Value="True"/>
-        <ComponentName Value="Form1"/>
-        <ResourceBaseClass Value="Form"/>
+        <ComponentName Value="MyForm1"/>
         <UnitName Value="Unit1"/>
       </Unit1>
     </Units>

examples/designnonlcl/project/unit1.lfm

@@ -5,4 +5,11 @@ object MyForm1: TMyForm1
   Height = 236
   Visible = False
   Caption = 'MyForm1'
+  object MyButton1: TMyButton
+    Left = 20
+    Top = 10
+    Width = 75
+    Height = 25
+    Caption = 'MyButton1'
+  end
 end

examples/designnonlcl/project/unit1.lrs

@@ -1,6 +1,6 @@
-{ This is an automatically generated lazarus resource file }
-
 LazarusResources.Add('TMyForm1','FORMDATA',[
   'TPF0'#8'TMyForm1'#7'MyForm1'#4'Left'#3'?'#1#3'Top'#3#231#0#5'Width'#3'B'#1#6
-  +'Height'#3#236#0#7'Visible'#8#7'Caption'#6#7'MyForm1'#0#0
+  +'Height'#3#236#0#7'Visible'#8#7'Caption'#6#7'MyForm1'#0#9'TMyButton'#9'MyBut'
+  +'ton1'#4'Left'#2#20#3'Top'#2#10#5'Width'#2'K'#6'Height'#2#25#7'Caption'#6#9
+  +'MyButton1'#0#0#0
 ]);

ideintf/formeditingintf.pas

@@ -86,6 +86,12 @@ type
                              X,Y,W,H : Integer): TIComponentInterface; virtual; abstract;
   end;
 
+  TDMCompAtPosFlag = (
+    dmcapfOnlyVisible,
+    dmcapfOnlySelectable
+    );
+  TDMCompAtPosFlags = set of TDMCompAtPosFlag;
+
   { TDesignerMediator
     To edit designer forms which do not use the LCL, register a TDesignerMediator,
     which will emulate the painting, handle the mouse and editing bounds. }
@@ -94,12 +100,16 @@ type
   private
     FDesigner: TComponentEditorDesigner;
     FLCLForm: TForm;
+    FRoot: TComponent;
   protected
-    procedure SetDesigner(const AValue: TComponentEditorDesigner);
+    FCollectedChilds: TFPList;
+    procedure SetDesigner(const AValue: TComponentEditorDesigner); virtual;
     procedure SetLCLForm(const AValue: TForm); virtual;
+    procedure SetRoot(const AValue: TComponent); virtual;
+    procedure CollectChildren(Child: TComponent); virtual;
   public
     class function FormClass: TComponentClass; virtual; abstract;
-    class function CreateMediator(TheOwner, aForm: TComponent): TDesignerMediator; virtual; abstract;
+    class function CreateMediator(TheOwner, aForm: TComponent): TDesignerMediator; virtual;
     class procedure InitFormInstance(aForm: TComponent); virtual; // called after NewInstance, before constructor
   public
     procedure SetBounds(AComponent: TComponent; NewBounds: TRect); virtual;
@@ -112,8 +122,14 @@ type
     procedure Paint; virtual;
     function ComponentIsIcon(AComponent: TComponent): boolean; virtual;
     function ParentAcceptsChild(Parent: TComponent; Child: TComponentClass): boolean; virtual;
+    function ComponentIsVisible(AComponent: TComponent): Boolean; virtual;
+    function ComponentIsSelectable(AComponent: TComponent): Boolean; virtual;
+    function ComponentAtPos(p: TPoint; MinClass: TComponentClass;
+                            Flags: TDMCompAtPosFlags): TComponent; virtual;
+    procedure GetChilds(Parent: TComponent; ChildComponents: TFPList); virtual;
     property LCLForm: TForm read FLCLForm write SetLCLForm;
     property Designer: TComponentEditorDesigner read FDesigner write SetDesigner;
+    property Root: TComponent read FRoot write SetRoot;
   end;
   TDesignerMediatorClass = class of TDesignerMediator;
 
@@ -306,6 +322,24 @@ end;
 
 { TDesignerMediator }
 
+procedure TDesignerMediator.SetRoot(const AValue: TComponent);
+begin
+  if FRoot=AValue then exit;
+  FRoot:=AValue;
+end;
+
+procedure TDesignerMediator.CollectChildren(Child: TComponent);
+begin
+  FCollectedChilds.Add(Child);
+end;
+
+class function TDesignerMediator.CreateMediator(TheOwner, aForm: TComponent
+  ): TDesignerMediator;
+begin
+  Result:=Create(TheOwner);
+  Result.FRoot:=aForm;
+end;
+
 procedure TDesignerMediator.SetDesigner(const AValue: TComponentEditorDesigner
   );
 begin
@@ -407,5 +441,71 @@ begin
   Result:=false;
 end;
 
+function TDesignerMediator.ComponentIsVisible(AComponent: TComponent): Boolean;
+begin
+  Result:=true;
+end;
+
+function TDesignerMediator.ComponentIsSelectable(AComponent: TComponent
+  ): Boolean;
+begin
+  Result:=true;
+end;
+
+function TDesignerMediator.ComponentAtPos(p: TPoint; MinClass: TComponentClass;
+  Flags: TDMCompAtPosFlags): TComponent;
+var
+  i: Integer;
+  Child: TComponent;
+  ClientArea: TRect;
+  ScrollOffset: TPoint;
+  ChildBounds: TRect;
+  Found: Boolean;
+  Childs: TFPList;
+begin
+  Result:=Root;
+  while Result<>nil do begin
+    GetClientArea(Result,ClientArea,ScrollOffset);
+    Childs:=TFPList.Create;
+    try
+      GetChilds(Result,Childs);
+      Found:=false;
+      // iterate backwards (z-order)
+      for i:=Childs.Count-1 downto 0 do begin
+        Child:=TComponent(Childs[i]);
+        if (MinClass<>nil) and (not Child.InheritsFrom(MinClass)) then
+          continue;
+        if (dmcapfOnlyVisible in Flags) and (not ComponentIsVisible(Child)) then
+          continue;
+        if (dmcapfOnlySelectable in Flags)
+        and (not ComponentIsSelectable(Child)) then
+          continue;
+        GetBounds(Child,ChildBounds);
+        OffsetRect(ChildBounds,ClientArea.Left+ScrollOffset.X,
+                               ClientArea.Top+ScrollOffset.Y);
+        if PtInRect(ChildBounds,p) then begin
+          Found:=true;
+          Result:=Child;
+          break;
+        end;
+      end;
+      if not Found then exit;
+    finally
+      Childs.Free;
+    end;
+  end;
+end;
+
+procedure TDesignerMediator.GetChilds(Parent: TComponent;
+  ChildComponents: TFPList);
+begin
+  FCollectedChilds:=ChildComponents;
+  try
+    TDesignerMediator(Parent).GetChildren(@CollectChildren,Root);
+  finally
+    FCollectedChilds:=nil;
+  end;
+end;
+
 end.