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

LCLProc: Added DbgS for TSize, TTextMetric and TScrollInfo

Browse Source 
git-svn-id: trunk@11000 -
This commit is contained in:
tombo 2007-04-25 10:24:29 +00:00
parent 1798531667
commit 576446d7e6
1 changed files with 52 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

52
lcl/lclproc.pas
View File

@ -240,6 +240,10 @@ function DbgS(const i1,i2,i3,i4: integer): string; overload;
function DbgS(const Shift: TShiftState): string; overload;
function DbgsVKCode(c: word): string;
function DbgS(const ASize: TSize): string; overload;
function DbgS(const ATM: TTextMetric): string; overload;
function DbgS(const AScrollInfo: TScrollInfo): string; overload;
procedure DbgOutThreadLog(const Msg: string); overload;
procedure DebuglnThreadLog(const Msg: string); overload;
procedure DebuglnThreadLog(Args: array of const); overload;
@ -1913,6 +1917,54 @@ begin
end;
end;
function DbgS(const ASize: TSize): string;
begin
Result := 'cx: ' + DbgS(ASize.cx) + ' cy: ' + DbgS(ASize.cy);
end;
function DbgS(const ATM: TTextMetric): string;
begin
with ATM do
Result :=
'tmHeight: ' + DbgS(tmHeight) +
' tmAscent: ' + DbgS(tmAscent) +
' tmDescent: ' + DbgS(tmDescent) +
' tmInternalLeading: ' + DbgS(tmInternalLeading) +
' tmExternalLeading: ' + DbgS(tmExternalLeading) +
' tmAveCharWidth: ' + DbgS(tmAveCharWidth) +
' tmMaxCharWidth: ' + DbgS(tmMaxCharWidth) +
' tmWeight: ' + DbgS(tmWeight) +
' tmOverhang: ' + DbgS(tmOverhang) +
' tmDigitizedAspectX: ' + DbgS(tmDigitizedAspectX) +
' tmDigitizedAspectY: ' + DbgS(tmDigitizedAspectY) +
' tmFirstChar: ' + tmFirstChar +
' tmLastChar: ' + tmLastChar +
' tmDefaultChar: ' + tmDefaultChar +
' tmBreakChar: ' + tmBreakChar +
' tmItalic: ' + DbgS(tmItalic) +
' tmUnderlined: ' + DbgS(tmUnderlined) +
' tmStruckOut: ' + DbgS(tmStruckOut) +
' tmPitchAndFamily: ' + DbgS(tmPitchAndFamily) +
' tmCharSet: ' + DbgS(tmCharSet);
end;
function DbgS(const AScrollInfo: TScrollInfo): string;
begin
Result := '';
if (SIF_POS and AScrollInfo.fMask) > 0 then
Result := 'Pos: ' + DbgS(AScrollInfo.nPos);
if (SIF_RANGE and AScrollInfo.fMask) > 0 then
Result := Result + ' Min: ' + DbgS(AScrollInfo.nMin) + ' Max: ' +
DbgS(AScrollInfo.nMax);
if (SIF_PAGE and AScrollInfo.fMask) > 0 then
Result := Result + ' Page: ' + DbgS(AScrollInfo.nPage);
if (SIF_TRACKPOS and AScrollInfo.fMask) > 0 then
Result := Result + ' TrackPos: ' + DbgS(AScrollInfo.nTrackPos);
if Result = '' then Result := '(no scrollinfo)';
end;
procedure DbgOutThreadLog(const Msg: string);
var
PID: PtrInt;