diff --git a/components/codetools/eventcodetool.pas b/components/codetools/eventcodetool.pas index 40dcc9a61a..333ce03ed2 100644 --- a/components/codetools/eventcodetool.pas +++ b/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); diff --git a/components/codetools/finddeclarationtool.pas b/components/codetools/finddeclarationtool.pas index b58a4a318d..00b2e80052 100644 --- a/components/codetools/finddeclarationtool.pas +++ b/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; diff --git a/designer/designer.pp b/designer/designer.pp index c6af0ddcbf..33ca4e3077 100644 --- a/designer/designer.pp +++ b/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;