浏览代码

* Improved ToString for TComponent

Michaël Van Canneyt 1 年之前
父节点
当前提交
634e01d525
共有 2 个文件被更改,包括 22 次插入0 次删除
  1. 5 0
      rtl/objpas/classes/classesh.inc
  2. 17 0
      rtl/objpas/classes/compon.inc

+ 5 - 0
rtl/objpas/classes/classesh.inc

@@ -2524,6 +2524,10 @@ type
       NameCount, LocaleID: Integer; DispIDs: Pointer): HResult; stdcall;
     function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
       Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; stdcall;
+  public
+    Type
+       TToStringNameMode = (snmNameClassName,snmClassName,snmName);
+    class var ToStringNameMode : TToStringNameMode;
   public
     //!! Moved temporary
     // fpdoc doesn't handle this yet :(
@@ -2554,6 +2558,7 @@ type
     property ComObject: IUnknown read GetComObject;
     function IsImplementorOf (const Intf:IInterface):boolean;
     procedure ReferenceInterface(const intf:IInterface;op:TOperation);
+    function ToString : RTLString; override;
     property Components[Index: Integer]: TComponent read GetComponent;
     property ComponentCount: Integer read GetComponentCount;
     property ComponentIndex: Integer read GetComponentIndex write SetComponentIndex;

+ 17 - 0
rtl/objpas/classes/compon.inc

@@ -520,6 +520,23 @@ begin
 end;
 
 
+function TComponent.ToString : RTLString;
+
+begin
+  Case ToStringNameMode of
+    snmName :
+      Result:=Name;
+    snmClassName :
+      Result:=Inherited;
+    snmNameClassName :
+      begin
+      Result:=Inherited;
+      if (Name<>'') then
+       Result:=Name+' ('+Result+')';
+      end;
+  end;
+end;
+
 Procedure TComponent.BeforeDestruction;
 begin
   if not(csDestroying in FComponentstate) then