paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-06-03 01:58:14 +02:00
Code Issues Packages Projects Releases Wiki Activity

LCL: added dbgs for TMethod

Browse Source 
git-svn-id: trunk@28432 -
This commit is contained in:
mattias 2010-11-23 11:02:58 +00:00
parent a4f82ba95d
commit 3fbccdd74b
1 changed files with 14 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
lcl/lclproc.pas
View File

@ -257,6 +257,7 @@ function DbgS(const p: pointer): string; overload;
function DbgS(const e: extended; MaxDecimals: integer = 999): string; overload;
function DbgS(const b: boolean): string; overload;
function DbgS(const s: TComponentState): string; overload;
function DbgS(const m: TMethod): string; overload;
function DbgSName(const p: TObject): string; overload;
function DbgSName(const p: TClass): string; overload;
function DbgStr(const StringWithSpecialChars: string): string; overload;
@ -2550,6 +2551,19 @@ begin
Result:='['+Result+']';
end;
function DbgS(const m: TMethod): string;
var
o: TObject;
aMethodName: ShortString;
begin
o:=TObject(m.Data);
Result:=dbgsname(o)+'.'+dbgs(m.Code);
if (o<>nil) and (m.Code<>nil) then begin
aMethodName:=o.MethodName(m.Code);
Result:=Result+'='''+aMethodName+'''';
end;
end;
function DbgSName(const p: TObject): string;
begin
if p=nil then