MG: fixed codetools proc collection

git-svn-id: trunk@1957 -

components/codetools/eventcodetool.pas

@@ -220,7 +220,7 @@ begin
   try
     BuildSubTreeForClass(ClassNode);
     {$IFDEF CTDEBUG}
-    writeln('[TEventsCodeTool.GetCompatiblePublishedMethods]');
+    writeln('[TEventsCodeTool.GetCompatiblePublishedMethods] D');
     {$ENDIF}
     // 1. convert the TypeData to an expression type list
     CheckDependsOnNodeCaches;
@@ -241,6 +241,9 @@ begin
         Params.ContextNode:=ClassNode;
         Params.Flags:=[fdfCollect,fdfSearchInAncestors,fdfClassPublished];
         Params.SetIdentifier(Self,nil,@CollectPublishedMethods);
+        {$IFDEF CTDEBUG}
+        writeln('[TEventsCodeTool.GetCompatiblePublishedMethods] E Searching ...');
+        {$ENDIF}
         FindIdentifierInContext(Params);
       finally
         SearchedExprList.Free;
@@ -675,9 +678,15 @@ var
   ParamCompatibility: TTypeCompatibility;
   FirstParameterNode: TCodeTreeNode;
 begin
+  {$IFDEF CTDEBUG}
+  writeln('[TEventsCodeTool.CollectPublishedMethods] A ',
+  ' Node=',FoundContext.Node.DescAsString,
+  ' "',copy(FoundContext.Tool.Src,FoundContext.Node.StartPos,50),'"',
+  ' Tool=',FoundContext.Tool.MainFilename);
+  {$ENDIF}
   if (FoundContext.Node.Desc=ctnProcedure) then begin
     {$IFDEF CTDEBUG}
-    writeln('[TEventsCodeTool.CollectPublishedMethods] ',
+    writeln('[TEventsCodeTool.CollectPublishedMethods] B ',
     ' Node=',FoundContext.Node.DescAsString,
     ' "',copy(FoundContext.Tool.Src,FoundContext.Node.StartPos,50),'"',
     ' Tool=',FoundContext.Tool.MainFilename);

components/codetools/finddeclarationtool.pas

@@ -58,6 +58,8 @@ interface
 { $DEFINE ShowNodeCache}
 { $DEFINE ShowBaseTypeCache}
 { $DEFINE ShowCacheDependencies}
+{$DEFINE ShowCollect}
+
 
 uses
   {$IFDEF MEM_CHECK}
@@ -1192,6 +1194,17 @@ var
   begin
     Result:=true;
     FindIdentifierInContext:=NewResult;
+    {$IFDEF ShowCollect}
+    if fdfCollect in Params.Flags then begin
+      writeln('[TFindDeclarationTool.FindIdentifierInContext] COLLECT CheckResult Ident=',
+      '"',GetIdentifier(Params.Identifier),'"',
+      ' File="',ExtractFilename(MainFilename)+'"',
+      ' Flags=[',FindDeclarationFlagsAsString(Params.Flags),']',
+      ' NewResult=',NewResult,
+      ' CallOnIdentifierFound=',CallOnIdentifierFound
+      );
+    end;
+    {$ENDIF}
     if NewResult then begin
       // identifier found
       if CallOnIdentifierFound then begin
@@ -1480,8 +1493,19 @@ begin
   ' File="',ExtractFilename(MainFilename)+'"',
   ' Flags=[',FindDeclarationFlagsAsString(Params.Flags),']'
   );
+  {$ELSE}
+    {$IFDEF ShowCollect}
+    if fdfCollect in Params.Flags then begin
+      writeln('[TFindDeclarationTool.FindIdentifierInContext] COLLECT Start Ident=',
+      '"',GetIdentifier(Params.Identifier),'"',
+      ' Context="',ContextNode.DescAsString,'" "',copy(Src,ContextNode.StartPos,20),'"',
+      ' File="',ExtractFilename(MainFilename)+'"',
+      ' Flags=[',FindDeclarationFlagsAsString(Params.Flags),']'
+      );
+    end;
+    {$ENDIF}
   {$ENDIF}
-  
+
   try
     // search in the Tree of this tool
     repeat
@@ -1491,6 +1515,16 @@ begin
       ' Context="',ContextNode.DescAsString,'" "',copy(Src,ContextNode.StartPos,20),'"',
       ' Flags=[',FindDeclarationFlagsAsString(Params.Flags),']'
       );
+      {$ELSE}
+        {$IFDEF ShowCollect}
+        if fdfCollect in Params.Flags then begin
+          writeln('[TFindDeclarationTool.FindIdentifierInContext] COLLECT Loop Ident=',
+          '"',GetIdentifier(Params.Identifier),'"',
+          ' Context="',ContextNode.DescAsString,'" "',copy(Src,ContextNode.StartPos,20),'"',
+          ' Flags=[',FindDeclarationFlagsAsString(Params.Flags),']'
+          );
+        end;
+        {$ENDIF}
       {$ENDIF}
       // search identifier in current context
       LastContextNode:=ContextNode;
@@ -1525,7 +1559,7 @@ begin
             IdentifierFoundResult:=
               FindIdentifierInProcContext(ContextNode,Params);
             if IdentifierFoundResult in [ifrAbortSearch,ifrSuccess] then begin
-              if CheckResult(IdentifierFoundResult=ifrSuccess,false) then
+              if CheckResult(IdentifierFoundResult=ifrSuccess,true) then
                 exit;
             end;
           end;
@@ -1948,7 +1982,8 @@ begin
     // -> proceed the search normally ...
   end else begin
     // proc is a proc declaration
-    if CompareSrcIdentifiers(NameAtom.StartPos,Params.Identifier) then begin
+    if (fdfCollect in Params.Flags)
+    or CompareSrcIdentifiers(NameAtom.StartPos,Params.Identifier) then begin
       // proc identifier found
       {$IFDEF ShowTriedContexts}
       writeln('[TFindDeclarationTool.FindIdentifierInProcContext]  Proc-Identifier found="',GetIdentifier(Params.Identifier),'"');
@@ -3947,7 +3982,7 @@ function TFindDeclarationTool.CheckSrcIdentifier(
   Params: TFindDeclarationParams;
   FoundContext: TFindContext): TIdentifierFoundResult;
 // this is a TOnIdentifierFound function
-//   if identifier found is a proc it searches for the best overloaded proc
+//   if identifier found is a proc then it searches for the best overloaded proc
 var FirstParameterNode: TCodeTreeNode;
   ParamCompatibility: TTypeCompatibility;
   OldInput: TFindDeclarationInput;

designer/designer.pp

@@ -134,12 +134,15 @@ type
     Procedure OnFormActivated;
   public
     ControlSelection : TControlSelection;
-    constructor Create(Customform : TCustomform; AControlSelection: TControlSelection);
+    constructor Create(Customform : TCustomform;
+       AControlSelection: TControlSelection);
     destructor Destroy; override;
 
-    function IsDesignMsg(Sender: TControl; var TheMessage: TLMessage): Boolean; override;
+    function IsDesignMsg(Sender: TControl;
+       var TheMessage: TLMessage): Boolean; override;
     procedure Modified; override;
-    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
+    procedure Notification(AComponent: TComponent;
+       Operation: TOperation); override;
     procedure PaintGrid; override;
     procedure ValidateRename(AComponent: TComponent;
        const CurName, NewName: string); override;
@@ -147,6 +150,7 @@ type
     function NonVisualComponentLeftTop(AComponent: TComponent): TPoint;
     function NonVisualComponentAtPos(x,y: integer): TComponent;
     procedure DrawNonVisualComponents(DC: HDC);
+    function GetDesignedComponent(AComponent: TComponent): TComponent;
 
     property ShowGrid: boolean read GetShowGrid write SetShowGrid;
     property Form: TCustomForm read FCustomForm write FCustomForm;
@@ -156,7 +160,8 @@ type
     property IsControl: Boolean read GetIsControl write SetIsControl;
     property OnActivated: TNotifyEvent
        read FOnActivated write FOnActivated;
-    property OnAddComponent: TOnAddComponent read FOnAddComponent write FOnAddComponent;
+    property OnAddComponent: TOnAddComponent
+       read FOnAddComponent write FOnAddComponent;
     property OnComponentListChanged: TNotifyEvent
        read FOnComponentListChanged write FOnComponentListChanged;
     property OnGetSelectedComponentClass: TOnGetSelectedComponentClass
@@ -168,7 +173,8 @@ type
        read FOnRemoveComponent write FOnRemoveComponent;
     property OnRenameComponent: TOnRenameComponent
        read FOnRenameComponent write FOnRenameComponent;
-    property OnSetDesigning: TOnSetDesigning read FOnSetDesigning write FOnSetDesigning;
+    property OnSetDesigning: TOnSetDesigning
+       read FOnSetDesigning write FOnSetDesigning;
     property OnUnselectComponentClass: TNotifyEvent
        read FOnUnselectComponentClass write FOnUnselectComponentClass;
     property OnGetNonVisualCompIconCanvas: TOnGetNonVisualCompIconCanvas
@@ -314,11 +320,13 @@ function TDesigner.PaintControl(Sender: TControl; TheMessage: TLMPaint):boolean;
 var OldDuringPaintControl: boolean;
 begin
   Result:=true;
-
+//writeln('TDesigner.PaintControl A ',Sender.Name);
   //writeln('***  LM_PAINT A ',Sender.Name,':',Sender.ClassName,' DC=',HexStr(Message.DC,8));
   OldDuringPaintControl:=FDuringPaintControl;
   FDuringPaintControl:=true;
+//writeln('TDesigner.PaintControl B ',Sender.Name);
   Sender.Dispatch(TheMessage);
+//writeln('TDesigner.PaintControl C ',Sender.Name);
 
   if TheMessage.DC<>0 then begin
     //writeln('***  LM_PAINT B ',Sender.Name,':',Sender.ClassName,' DC=',HexStr(Message.DC,8));
@@ -332,7 +340,8 @@ begin
     if ControlSelection.RubberBandActive then
       ControlSelection.DrawRubberBand(TheMessage.DC);
   end;
-    
+//writeln('TDesigner.PaintControl D ',Sender.Name);
+
   FDuringPaintControl:=OldDuringPaintControl;
 end;
 
@@ -373,10 +382,12 @@ var i,
 Begin
   FHintTimer.Enabled := False;
   FHasSized:=false;
+  SetCaptureControl(nil);
   if (getParentForm(Sender)=nil) then exit;
 
   if MouseDownComponent=nil then begin
-    MouseDownComponent:=Sender;
+    MouseDownComponent:=GetDesignedComponent(Sender);
+    if MouseDownComponent=nil then exit;
     MouseDownSender:=Sender;
   end;
 
@@ -486,8 +497,14 @@ var
 Begin
   FHintTimer.Enabled := False;
 
+  SetCaptureControl(nil);
   SenderParentForm:=GetParentForm(Sender);
-  if (MouseDownComponent=nil) or (SenderParentForm=nil) then exit;
+  if (MouseDownComponent=nil) or (SenderParentForm=nil)
+  or (SenderParentForm<>Form) then begin
+    MouseDownComponent:=nil;
+    MouseDownSender:=nil;
+    exit;
+  end;
 
   ControlSelection.ActiveGrabber:=nil;
   RubberBandWasActive:=ControlSelection.RubberBandActive;
@@ -607,6 +624,7 @@ var
   SenderParentForm:TCustomForm;
   OldMouseMovePos: TPoint;
 begin
+  SetCaptureControl(nil);
   if FShowHints then begin
     FHintTimer.Enabled := False;
 
@@ -619,7 +637,7 @@ begin
 
   if MouseDownComponent=nil then exit;
   SenderParentForm:=GetParentForm(Sender);
-  if SenderParentForm=nil then exit;
+  if (SenderParentForm=nil) or (SenderParentForm<>Form) then exit;
   
   OldMouseMovePos:=LastMouseMovePos;
   LastMouseMovePos:=GetFormRelativeMousePosition(Form);
@@ -677,6 +695,7 @@ procedure TDesigner.MouseRightUpOnControl(Sender : TControl;
   TheMessage: TLMMouse);
 begin
   FHintTimer.Enabled := False;
+  SetCaptureControl(nil);
 
   MouseUpPos:=GetFormRelativeMousePosition(Form);
   BuildPopupMenu;
@@ -967,6 +986,15 @@ begin
   RestoreDC(DC,SaveIndex);
 end;
 
+function TDesigner.GetDesignedComponent(AComponent: TComponent): TComponent;
+begin
+  Result:=AComponent;
+  while (Result<>nil)
+  and (Result.Owner<>Form)
+  and (Result is TControl) do
+    Result:=TControl(Result).Parent;
+end;
+
 function TDesigner.NonVisualComponentAtPos(x,y: integer): TComponent;
 var i: integer;
   LeftTop: TPoint;