paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2026-01-08 11:42:08 +01:00
Code Issues Packages Projects Releases Wiki Activity

changed hexstr(cardinal()) for pointers to dbgs() and other 64-bits fixes from Peter Vreman

Browse Source 
git-svn-id: trunk@6915 -
This commit is contained in:
vincents 2005-03-07 21:59:45 +00:00
parent 8430049987
commit 5c84454943
75 changed files with 643 additions and 568 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
components/codetools/codecache.pas
View File

@ -406,7 +406,7 @@ end;
function TCodeCache.OnScannerGetSource(Sender: TObject;
Code: pointer): TSourceLog;
begin
//DebugLn('[TCodeCache.OnScannerGetSource] A ',HexStr(Cardinal(Code),8),'/',Count);
//DebugLn('[TCodeCache.OnScannerGetSource] A ',DbgS(Code),'/',Count);
if (Code<>nil) then
Result:=TSourceLog(Code)
else

12
components/codetools/customcodetool.pas
View File

@ -1933,12 +1933,12 @@ procedure TCustomCodeTool.WriteDebugTreeReport;
DbgOut(' End='+DbgS(EndPos)+' ');
WriteSrcSubString(EndPos-5,5);
{$ifdef fpc}
DbgOut(' Self=',HexStr(Cardinal(RootNode),8));
DbgOut(' P=',HexStr(Cardinal(Parent),8));
DbgOut(' NB=',HexStr(Cardinal(NextBrother),8));
//write(' PB=',HexStr(Cardinal(PriorBrother),8));
//write(' FC=',HexStr(Cardinal(FirstChild),8));
//write(' LC=',HexStr(Cardinal(LastChild),8));
DbgOut(' Self=',DbgS(RootNode));
DbgOut(' P=',DbgS(Parent));
DbgOut(' NB=',DbgS(NextBrother));
//write(' PB=',DbgS(PriorBrother));
//write(' FC=',DbgS(FirstChild));
//write(' LC=',DbgS(LastChild));
{$endif}
end;
DebugLn('');

6
components/codetools/definetemplates.pas
View File

@ -1415,11 +1415,11 @@ procedure TDefineTemplate.WriteDebugReport(OnlyMarked: boolean);
if ANode=nil then exit;
if (not OnlyMarked) or (ANode.Marked) then begin
ActionStr:=DefineActionNames[ANode.Action];
DebugLn(Prefix+'Self='+HexStr(Cardinal(ANode),8),
DebugLn(Prefix+'Self='+DbgS(ANode),
' Name="'+ANode.Name,'"',
' Consistency='+dbgs(ANode.ConsistencyCheck),
' Next='+HexStr(Cardinal(ANode.Next),8),
' Prior='+HexStr(Cardinal(ANode.Prior),8),
' Next='+DbgS(ANode.Next),
' Prior='+DbgS(ANode.Prior),
' Action='+ActionStr,
' Flags=['+DefineTemplateFlagsToString(ANode.Flags),']',
' Marked='+dbgs(ANode.Marked)

2
components/codetools/fileprocs.pas
View File

@ -1098,7 +1098,7 @@ end;
function DbgS(const p: pointer): string;
begin
Result:=HexStr(Cardinal(p),8);
Result:=DbgS(p);
end;
function DbgS(const e: extended): string;

2
components/codetools/finddeclarationcache.pas
View File

@ -895,7 +895,7 @@ var Node: TAVLTreeNode;
Entry: PCodeTreeNodeCacheEntry;
begin
DebugLn(Prefix+'[TCodeTreeNodeCache.WriteDebugReport] Self='+
HexStr(Cardinal(Self),8)+' Consistency=',dbgs(ConsistencyCheck));
DbgS(Self)+' Consistency=',dbgs(ConsistencyCheck));
if FItems<>nil then begin
Node:=FItems.FindLowest;
while Node<>nil do begin

6
components/codetools/finddeclarationtool.pas
View File

@ -2580,7 +2580,7 @@ begin
AddNodeToStack(@NodeStack,Result.Node);
{$IFDEF ShowTriedBaseContexts}
DebugLn('[TFindDeclarationTool.FindBaseTypeOfNode] LOOP Result=',Result.Node.DescAsString,' ',HexStr(Cardinal(Result.Node),8));
DebugLn('[TFindDeclarationTool.FindBaseTypeOfNode] LOOP Result=',Result.Node.DescAsString,' ',DbgS(Result.Node));
DebugLn(' Flags=[',FindDeclarationFlagsAsString(Params.Flags),']');
{$ENDIF}
if (Result.Node.Desc in AllIdentifierDefinitions) then begin
@ -2952,7 +2952,7 @@ var
if PosTree=nil then
PosTree:=TAVLTree.Create;
p:=@Src[StartPos];
//debugln('TFindDeclarationTool.FindReferences.AddReference ',HexStr(Cardinal(p),8),' ',dbgs(PosTree.Find(p)=nil));
//debugln('TFindDeclarationTool.FindReferences.AddReference ',DbgS(p),' ',dbgs(PosTree.Find(p)=nil));
if PosTree.Find(p)=nil then
PosTree.Add(p);
end;
@ -7142,7 +7142,7 @@ end;
procedure TFindDeclarationParams.WriteDebugReport;
begin
DebugLn('TFindDeclarationParams.WriteDebugReport Self=',HexStr(Cardinal(Self),8));
DebugLn('TFindDeclarationParams.WriteDebugReport Self=',DbgS(Self));
// input parameters:
DebugLn(' Flags=',FindDeclarationFlagsAsString(Flags));

6
components/codetools/linkscanner.pas
View File

@ -796,7 +796,7 @@ procedure TLinkScanner.SetSource(ACode: pointer);
procedure RaiseUnableToGetCode;
begin
RaiseException('unable to get source with Code='+HexStr(Cardinal(Code),8));
RaiseException('unable to get source with Code='+DbgS(Code));
end;
var SrcLog: TSourceLog;
@ -1250,7 +1250,7 @@ var l,r,m: integer;
NewSrcChangeStep: PSourceChangeStep;
c: pointer;
begin
//DebugLn('[TLinkScanner.AddSourceChangeStep] ',HexStr(Cardinal(ACode),8));
//DebugLn('[TLinkScanner.AddSourceChangeStep] ',DbgS(ACode));
if ACode=nil then
RaiseCodeNil;
l:=0;
@ -1269,7 +1269,7 @@ begin
NewSrcChangeStep^.ChangeStep:=AChangeStep;
if (FSourceChangeSteps.Count>0) and (c<ACode) then inc(m);
FSourceChangeSteps.Insert(m,NewSrcChangeStep);
//DebugLn(' ADDING ',HexStr(Cardinal(ACode),8),',',FSourceChangeSteps.Count);
//DebugLn(' ADDING ',DbgS(ACode),',',FSourceChangeSteps.Count);
end;
function TLinkScanner.TokenIs(const AToken: shortstring): boolean;

73
components/codetools/memcheck.pas
View File

@ -54,7 +54,7 @@ type
{ Allows to add info pre memory block, see ppheap.pas of the compiler
for example source }
procedure SetHeapExtraInfo( size : longint;fillproc : tfillextrainfoproc;displayproc : tdisplayextrainfoproc);
procedure SetHeapExtraInfo( size : ptrint;fillproc : tfillextrainfoproc;displayproc : tdisplayextrainfoproc);
{ Redirection of the output to a file }
procedure SetHeapTraceOutput(const name : string);
@ -255,7 +255,7 @@ procedure call_stack(pp : pheap_mem_info;var ptext : text);
var
i : ptrint;
begin
writeln(ptext,'Call trace for block $',hexstr(ptrint(pointer(pp)+sizeof(theap_mem_info)),8),' size ',pp^.size);
writeln(ptext,'Call trace for block $',HexStr(ptrint(pointer(pp)+sizeof(theap_mem_info)),sizeof(PtrInt)),' size ',pp^.size);
for i:=1 to tracesize do
if pp^.calls[i]<>nil then
writeln(ptext,BackTraceStrFunc(pp^.calls[i]));
@ -271,7 +271,7 @@ procedure call_free_stack(pp : pheap_mem_info;var ptext : text);
var
i : ptrint;
begin
writeln(ptext,'Call trace for block at $',hexstr(ptrint(pointer(pp)+sizeof(theap_mem_info)),8),' size ',pp^.size);
writeln(ptext,'Call trace for block at $',HexStr(ptrint(pointer(pp)+sizeof(theap_mem_info)),sizeof(ptrint)),' size ',pp^.size);
for i:=1 to tracesize div 2 do
if pp^.calls[i]<>nil then
writeln(ptext,BackTraceStrFunc(pp^.calls[i]));
@ -289,7 +289,7 @@ end;
procedure dump_already_free(p : pheap_mem_info;var ptext : text);
begin
Writeln(ptext,'Marked memory at $',HexStr(ptrint(pointer(p)+sizeof(theap_mem_info)),8),' released');
Writeln(ptext,'Marked memory at $',HexStr(ptrint(pointer(p)+sizeof(theap_mem_info)),sizeof(ptrint)),' released');
call_free_stack(p,ptext);
Writeln(ptext,'freed again at');
dump_stack(ptext,get_caller_frame(get_frame));
@ -297,8 +297,8 @@ end;
procedure dump_error(p : pheap_mem_info;var ptext : text);
begin
Writeln(ptext,'Marked memory at $',HexStr(ptrint(pointer(p)+sizeof(theap_mem_info)),8),' invalid');
Writeln(ptext,'Wrong signature $',hexstr(p^.sig,8),' instead of ',hexstr(calculate_sig(p),8));
Writeln(ptext,'Marked memory at $',HexStr(ptrint(pointer(p)+sizeof(theap_mem_info)),sizeof(ptrint)),' invalid');
Writeln(ptext,'Wrong signature $',HexStr(p^.sig,sizeof(ptrint)),' instead of ',HexStr(calculate_sig(p),sizeof(ptrint)));
dump_stack(ptext,get_caller_frame(get_frame));
end;
@ -307,20 +307,20 @@ procedure dump_change_after(p : pheap_mem_info;var ptext : text);
var pp : pchar;
i : ptrint;
begin
Writeln(ptext,'Marked memory at $',HexStr(ptrint(pointer(p)+sizeof(theap_mem_info)),8),' invalid');
Writeln(ptext,'Wrong release CRC $',hexstr(p^.release_sig,8),' instead of ',hexstr(calculate_release_sig(p),8));
Writeln(ptext,'Marked memory at $',HexStr(ptrint(pointer(p)+sizeof(theap_mem_info)),sizeof(ptrint)),' invalid');
Writeln(ptext,'Wrong release CRC $',HexStr(p^.release_sig,sizeof(ptrint)),' instead of ',HexStr(calculate_release_sig(p),sizeof(ptrint)));
Writeln(ptext,'This memory was changed after call to freemem !');
call_free_stack(p,ptext);
pp:=pointer(p)+sizeof(theap_mem_info);
for i:=0 to p^.size-1 do
if byte(pp[i])<>$F0 then
Writeln(ptext,'offset',i,':$',hexstr(i,8),'"',pp[i],'"');
Writeln(ptext,'offset',i,':$',HexStr(i,sizeof(ptrint)),'"',pp[i],'"');
end;
{$endif EXTRA}
procedure dump_wrong_size(p : pheap_mem_info;size : ptrint;var ptext : text);
begin
Writeln(ptext,'Marked memory at $',HexStr(ptrint(pointer(p)+sizeof(theap_mem_info)),8),' invalid');
Writeln(ptext,'Marked memory at $',HexStr(ptrint(pointer(p)+sizeof(theap_mem_info)),sizeof(ptrint)),' invalid');
Writeln(ptext,'Wrong size : ',p^.size,' allocated ',size,' freed');
dump_stack(ptext,get_caller_frame(get_frame));
{ the check is done to be sure that the procvar is not overwritten }
@ -855,7 +855,7 @@ begin
goto _exit
else
begin
writeln(ptext^,'pointer $',hexstr(ptrint(p),8),' points into invalid memory block');
writeln(ptext^,'pointer $',HexStr(ptrint(p),sizeof(ptrint)),' points into invalid memory block');
dump_error(pp,ptext^);
runerror(204);
end;
@ -867,7 +867,7 @@ begin
halt(1);
end;
end;
writeln(ptext^,'pointer $',hexstr(ptrint(p),8),' does not point to valid memory block');
writeln(ptext^,'pointer $',HexStr(ptrint(p),sizeof(ptrint)),' does not point to valid memory block');
runerror(204);
_exit:
end;
@ -1417,7 +1417,7 @@ begin
for i:=1 to InLen do
begin
InitCrc:=Crc32Tbl[byte(InitCrc) xor byte(p^)] xor (InitCrc shr 8);
inc(longint(p));
inc(ptrint(p));
end;
UpdateCrc32:=InitCrc;
end;
@ -1480,15 +1480,15 @@ var
i : longint;
begin
writeln(ptext,'Call trace for block 0x',
hexstr(longint(pointer(pp)+sizeof(theap_mem_info)
+extra_info_size),8),' size ',pp^.size);
HexStr(ptrint(pointer(pp)+sizeof(theap_mem_info)
+extra_info_size),sizeof(ptrint)),' size ',pp^.size);
for i:=1 to tracesize do
if pp^.calls[i]<>0 then
writeln(ptext,BackTraceStrFunc(pp^.calls[i]));
if assigned(extra_info_string_func) then
writeln(ptext,extra_info_string_func(@pp^.extra_info))
else for i:=0 to (exact_info_size div 4)-1 do
writeln(ptext,'info ',i,'=',plongint(pointer(@pp^.extra_info)+4*i)^);
writeln(ptext,'info ',i,'=',pptrint(pointer(@pp^.extra_info)+4*i)^);
end;
procedure call_free_stack(pp : pheap_mem_info;var ptext : text);
@ -1496,8 +1496,8 @@ var
i : longint;
begin
writeln(ptext,'Call trace for block at 0x',
hexstr(longint(pointer(pp)+sizeof(theap_mem_info))
+extra_info_size,8),' size ',pp^.size);
HexStr(ptrint(pointer(pp)+sizeof(theap_mem_info))
+extra_info_size,sizeof(ptrint)),' size ',pp^.size);
for i:=1 to tracesize div 2 do
if pp^.calls[i]<>0 then
writeln(ptext,BackTraceStrFunc(pp^.calls[i]));
@ -1506,15 +1506,15 @@ begin
if pp^.calls[i]<>0 then
writeln(ptext,BackTraceStrFunc(pp^.calls[i]));
for i:=0 to (exact_info_size div 4)-1 do
writeln(ptext,'info ',i,'=',plongint(pointer(@pp^.extra_info)+4*i)^);
writeln(ptext,'info ',i,'=',pptrint(pointer(@pp^.extra_info)+4*i)^);
end;
procedure dump_already_free(p : pheap_mem_info;var ptext : text);
begin
Writeln(ptext,'Marked memory at 0x',
HexStr(longint(pointer(p)+sizeof(theap_mem_info))
+extra_info_size,8),' released');
HexStr(ptrint(pointer(p)+sizeof(theap_mem_info))
+extra_info_size,sizeof(ptrint)),' released');
call_free_stack(p,ptext);
Writeln(ptext,'freed again at');
dump_stack(ptext,get_caller_frame(get_frame));
@ -1523,10 +1523,10 @@ end;
procedure dump_error(p : pheap_mem_info;var ptext : text);
begin
Writeln(ptext,'Marked memory at 0x',
HexStr(longint(pointer(p)+sizeof(theap_mem_info))
+extra_info_size,8),' invalid');
Writeln(ptext,'Wrong signature $',hexstr(p^.sig,8)
,' instead of ',hexstr(calculate_sig(p),8));
HexStr(ptrint(pointer(p)+sizeof(theap_mem_info))
+extra_info_size,sizeof(ptrint)),' invalid');
Writeln(ptext,'Wrong signature $',HexStr(p^.sig,sizeof(ptrint))
,' instead of ',HexStr(calculate_sig(p),sizeof(ptrint)));
dump_stack(ptext,get_caller_frame(get_frame));
end;
@ -1536,16 +1536,16 @@ procedure dump_change_after(p : pheap_mem_info;var ptext : text);
i : longint;
begin
Writeln(ptext,'Marked memory at 0x',
HexStr(longint(pointer(p)+sizeof(theap_mem_info))
+extra_info_size,8),' invalid');
Writeln(ptext,'Wrong release CRC $',hexstr(p^.release_sig,8)
,' instead of ',hexstr(calculate_release_sig(p),8));
HexStr(ptrint(pointer(p)+sizeof(theap_mem_info))
+extra_info_size,sizeof(ptrint)),' invalid');
Writeln(ptext,'Wrong release CRC $',HexStr(p^.release_sig,sizeof(ptrint))
,' instead of ',HexStr(calculate_release_sig(p),sizeof(ptrint)));
Writeln(ptext,'This memory was changed after call to freemem !');
call_free_stack(p,ptext);
pp:=pointer(p)+sizeof(theap_mem_info)+extra_info_size;
for i:=0 to p^.size-1 do
if byte(pp[i])<>$F0 then
Writeln(ptext,'offset',i,':$',hexstr(i,8),'"',pp[i],'"');
Writeln(ptext,'offset',i,':$',HexStr(i,sizeof(ptrint)),'"',pp[i],'"');
end;
{$endif EXTRA}
@ -1553,11 +1553,11 @@ procedure dump_wrong_size(p : pheap_mem_info;size : longint;var ptext : text);
var
i : longint;
begin
Writeln(ptext,'Marked memory at 0x',HexStr(longint(pointer(p)+sizeof(theap_mem_info)),8),' invalid');
Writeln(ptext,'Marked memory at 0x',HexStr(ptrint(pointer(p)+sizeof(theap_mem_info)),sizeof(ptrint)),' invalid');
Writeln(ptext,'Wrong size : ',p^.size,' allocated ',size,' freed');
dump_stack(ptext,get_caller_frame(get_frame));
for i:=0 to (exact_info_size div 4)-1 do
writeln(ptext,'info ',i,'=',plongint(@p^.extra_info+4*i)^);
writeln(ptext,'info ',i,'=',pptrint(@p^.extra_info+4*i)^);
call_stack(p,ptext);
end;
@ -2118,7 +2118,7 @@ begin
goto _exit
else
begin
writeln(ptext^,'pointer $',hexstr(longint(p),8),' points into invalid memory block');
writeln(ptext^,'pointer $',HexStr(ptrint(p),sizeof(ptrint)),' points into invalid memory block');
dump_error(pp,ptext^);
// MG: changes for codetools:
runerror(214);
@ -2144,14 +2144,14 @@ begin
(MemInfo.Protect <> PAGE_EXECUTE_READWRITE) and
(MemInfo.Protect <> PAGE_EXECUTE_WRITECOPY)) then
begin
writeln(ptext^,'pointer $',hexstr(longint(p),8),' does not point to valid memory block');
writeln(ptext^,'pointer $',HexStr(ptrint(p),sizeof(ptrint)),' does not point to valid memory block');
// MG: changes for codetools:
runerror(214);
end
else
exit;
{$else not win32}
writeln(ptext^,'pointer $',hexstr(longint(p),8),' does not point to valid memory block');
writeln(ptext^,'pointer $',HexStr(ptrint(p),sizeof(ptrint)),' does not point to valid memory block');
// MG: changes for codetools:
runerror(214);
@ -2391,6 +2391,9 @@ end.
{
$Log$
Revision 1.41 2005/03/07 21:59:43 vincents
changed hexstr(cardinal()) for pointers to dbgs() and other 64-bits fixes from Peter Vreman
Revision 1.40 2005/03/05 00:51:07 marc
* Fixed compilation

10
components/codetools/oldavltree.pas
View File

@ -879,7 +879,7 @@ var RealCount: integer;
Result:=-2; exit;
end;
if fOnCompare(ANode.Left.Data,ANode.Data)>0 then begin
//DebugLn('CCC-3 ',HexStr(Cardinal(ANode.Data),8),' ',HexStr(Cardinal(ANode.Left.Data),8));
//DebugLn('CCC-3 ',hexstr(ANode.Data),' ',hexstr(ANode.Left.Data));
Result:=-3; exit;
end;
Result:=CheckNode(ANode.Left);
@ -891,7 +891,7 @@ var RealCount: integer;
Result:=-4; exit;
end;
if fOnCompare(ANode.Data,ANode.Right.Data)>0 then begin
//DebugLn('CCC-5 ',HexStr(Cardinal(ANode.Data),8),' ',HexStr(Cardinal(ANode.Right.Data),8));
//DebugLn('CCC-5 ',hexstr(ANode.Data),' ',hexstr(ANode.Right.Data));
Result:=-5; exit;
end;
Result:=CheckNode(ANode.Right);
@ -967,9 +967,9 @@ var h: string;
begin
if ANode=nil then exit;
WriteTreeNode(ANode.Right,Prefix+' ');
b:=Prefix+HexStr(Cardinal(ANode.Data),8)+' '
+' Self='+HexStr(Cardinal(ANode),8)
+' Parent='+HexStr(Cardinal(ANode.Parent),8)
b:=Prefix+hexstr(PtrInt(ANode.Data),sizeof(Pointer))+' '
+' Self='+hexstr(PtrInt(ANode),sizeof(Pointer))
+' Parent='+hexstr(PtrInt(ANode.Parent),sizeof(Pointer))
+' Balance='+IntToStr(ANode.Balance)
+#13#10;
WriteStr(b);

2
components/codetools/pascalparsertool.pas
View File

@ -1630,7 +1630,7 @@ end;
function TPascalParserTool.DoAtom: boolean;
begin
//DebugLn('[TPascalParserTool.DoAtom] A ',HexStr(Cardinal(CurKeyWordFuncList),8));
//DebugLn('[TPascalParserTool.DoAtom] A ',DbgS(CurKeyWordFuncList));
if (CurPos.StartPos<=SrcLen) and (CurPos.EndPos>CurPos.StartPos) then begin
if IsIdentStartChar[Src[CurPos.StartPos]] then
Result:=CurKeyWordFuncList.DoItUpperCase(UpperSrc,CurPos.StartPos,

6
components/codetools/sourcelog.pas
View File

@ -523,7 +523,7 @@ end;
procedure TSourceLog.BuildLineRanges;
var p,line:integer;
begin
//DebugLn('[TSourceLog.BuildLineRanges] A Self=',HexStr(Cardinal(Self),8),',LineCount=',FLineCount,' Len=',SourceLength);
//DebugLn('[TSourceLog.BuildLineRanges] A Self=',DbgS(Self),',LineCount=',FLineCount,' Len=',SourceLength);
if FLineCount>=0 then exit;
if FLineRanges<>nil then begin
FreeMem(FLineRanges);
@ -659,14 +659,14 @@ begin
inc(FChangeStep)
else
FChangeStep:=-$7fffffff;
//DebugLn('[TSourceLog.IncreaseChangeStep] ',FChangeStep,',',HexStr(Cardinal(Self),8));
//DebugLn('[TSourceLog.IncreaseChangeStep] ',FChangeStep,',',DbgS(Self));
end;
function TSourceLog.SaveToFile(const Filename: string): boolean;
var
fs: TFileStream;
begin
//DebugLn('TSourceLog.SaveToFile Self=',HexStr(Cardinal(Self),8));
//DebugLn('TSourceLog.SaveToFile Self=',DbgS(Self));
Result:=true;
try
InvalidateFileStateCache;

8
components/htmllite/htmllite.pas
View File

@ -2793,7 +2793,7 @@ try
end;
{$ENDIF}
finally
writeln('TPaintPanel.Paint B Canvas.Handle=',HexStr(Cardinal(Canvas.Handle),8));
writeln('TPaintPanel.Paint B Canvas.Handle=',DbgS(Canvas.Handle));
{$IFDEF HL_LAZARUS}
Canvas2.Handle:=0;
{$ENDIF}
@ -2804,12 +2804,12 @@ end;
procedure TPaintPanel.CreateWnd;
begin
inherited CreateWnd;
writeln('TPaintPanel.CreateWnd ',HexStr(Cardinal(Self),8),' ',HexStr(Cardinal(Handle),8));
writeln('TPaintPanel.CreateWnd ',DbgS(Self),' ',DbgS(Handle));
end;
procedure TPaintPanel.DestroyWnd;
begin
writeln('TPaintPanel.DestroyWnd ',HexStr(Cardinal(Self),8));
writeln('TPaintPanel.DestroyWnd ',DbgS(Self));
inherited DestroyWnd;
end;
@ -2824,7 +2824,7 @@ var
DC: HDC;
CopyFromDC: boolean;
begin
writeln('TPaintPanel.DoBackground A ',HexStr(Cardinal(ACanvas),8));
writeln('TPaintPanel.DoBackground A ',DbgS(ACanvas));
DC := ACanvas.handle;
if DC <> 0 then
begin

16
components/htmllite/litereadthd.pas
View File

@ -153,7 +153,7 @@ end;
procedure TFakeThread.DoTerminate;
begin
writeln('TFakeThread.DoTerminate ',HexStr(Cardinal(Self),8));
writeln('TFakeThread.DoTerminate ',DbgS(Self));
CallOnTerminate;
FFinished:=true;
if FFreeOnTerminate then Free;
@ -162,20 +162,20 @@ end;
procedure TFakeThread.Synchronize(Method: TThreadMethod);
begin
writeln('TFakeThread.Synchronize ',HexStr(Cardinal(Self),8));
writeln('TFakeThread.Synchronize ',DbgS(Self));
Method();
end;
constructor TFakeThread.Create(CreateSuspended: Boolean);
begin
writeln('TFakeThread.Create CreateSuspended=',CreateSuspended,' ',HexStr(Cardinal(Self),8));
writeln('TFakeThread.Create CreateSuspended=',CreateSuspended,' ',DbgS(Self));
inherited Create;
if CreateSuspended then Suspend else DoExecute;
end;
destructor TFakeThread.Destroy;
begin
writeln('TFakeThread.Destroy ',HexStr(Cardinal(Self),8));
writeln('TFakeThread.Destroy ',DbgS(Self));
if not FFinished and not Suspended then
begin
Terminate;
@ -186,25 +186,25 @@ end;
procedure TFakeThread.Resume;
begin
writeln('TFakeThread.Resume Self=',HexStr(Cardinal(Self),8));
writeln('TFakeThread.Resume Self=',DbgS(Self));
DoExecute;
end;
procedure TFakeThread.Suspend;
begin
writeln('TFakeThread.Suspend Self=',HexStr(Cardinal(Self),8));
writeln('TFakeThread.Suspend Self=',DbgS(Self));
FSuspended:=true;
end;
procedure TFakeThread.Terminate;
begin
writeln('TFakeThread.Terminate Self=',HexStr(Cardinal(Self),8));
writeln('TFakeThread.Terminate Self=',DbgS(Self));
DoTerminate;
end;
function TFakeThread.WaitFor: Integer;
begin
writeln('TFakeThread.WaitFor Self=',HexStr(Cardinal(Self),8));
writeln('TFakeThread.WaitFor Self=',DbgS(Self));
Result:=0;
end;

16
components/htmllite/litesubs.pas
View File

@ -2189,7 +2189,7 @@ begin
end;
end;
Len := Curs - StartCurs;
writeln('TCell.DoLogic ',HexStr(Cardinal(Self),8),' ',Curs,' ',StartCurs,' Len=',Len);
writeln('TCell.DoLogic ',DbgS(Self),' ',Curs,' ',StartCurs,' Len=',Len);
Result := H;
IB := IMgr.ImageBottom - YValue; {check for image overhang}
if IB > Result then
@ -2226,7 +2226,7 @@ begin
H := Y;
for I := 0 to Count-1 do
begin
writeln('TCell.Draw ',HexStr(Cardinal(Self),8),' ',I,' ',TSectionBase(Items[I]).ClassName);
writeln('TCell.Draw ',DbgS(Self),' ',I,' ',TSectionBase(Items[I]).ClassName);
H := TSectionBase(Items[I]).Draw(Canvas, ARect, IMgr, X, H);
end;
Result := H;
@ -3932,7 +3932,7 @@ Inc(CaptionIndent, IMgr.LeftIndent(YValue));
Indent := CaptionIndent + (CaptionWidth-TableWidth) div 2; {table indent}
Len := Curs-StartCurs;
writeln('ThtmlTable.DrawLogic ',HexStr(Cardinal(Self),8),' ',Curs,' ',StartCurs,' Len=',Len);
writeln('ThtmlTable.DrawLogic ',DbgS(Self),' ',Curs,' ',StartCurs,' Len=',Len);
MaxWidth := CaptionWidth;
if Float then
begin
@ -4379,7 +4379,7 @@ inherited Create(AMasterList);
Parser := ThlParser(ParentSectionList.Parser);
Buff := Nil;
Len := 0;
writeln('TSection.Create ',HexStr(Cardinal(Self),8),' Len=',Len);
writeln('TSection.Create ',DbgS(Self),' Len=',Len);
BuffSize := 0;
Parser.CurrentSScript := Normal;
Fonts := TFontList.Create;
@ -4409,7 +4409,7 @@ end;
{----------------TSection.Destroy}
destructor TSection.Destroy;
begin
writeln('TSection.Destroy ',HexStr(Cardinal(Self),8));
writeln('TSection.Destroy ',DbgS(Self));
if Assigned(Buff) then FreeMem(Buff, BuffSize);
if Assigned(XP) then
FreeMem(XP);
@ -4555,7 +4555,7 @@ if BuffSize < L+1 then Allocate(L + 100); {L+1 so there is always extra for fon
Move(S.S[1], (Buff+Len)^, Length(S.S));
Move(S.I[1], XP^[Len], Length(S.S)*Sizeof(integer));
Len := L;
writeln('TSection.AddTokenObj ',HexStr(Cardinal(Self),8),' Len=',Len);
writeln('TSection.AddTokenObj ',DbgS(Self),' Len=',Len);
end;
function TSection.BreakInfo(Index: integer; NoBreak: boolean): JustifyType; {called when <br> encountered}
@ -5423,7 +5423,7 @@ var
if SScript = Normal then Addon := 0
else if SScript = SupSc then Addon := -(FontHeight div 3)
else Addon := Descent div 2 +1;
writeln('DrawTheText D ',S,' ',HexStr(Cardinal(Canvas.Font.Color),8));
writeln('DrawTheText D ',S,' ',DbgS(Canvas.Font.Color));
Canvas.Brush.Color:=clRed;
Canvas.FillRect(Rect(0,0,200,200));
TextOut(Canvas.Handle, XX-OHang div 2, Y - Descent + Addon - YOffset, PChar(S), I);
@ -5521,7 +5521,7 @@ begin
Result := Y + SectionHeight;
YOffset := ParentSectionList.YOff;
writeln('TSection.Draw A ',HexStr(Cardinal(Self),8),' Lines.Count=',Lines.Count,
writeln('TSection.Draw A ',DbgS(Self),' Lines.Count=',Lines.Count,
' Len=',Len,' Y=',Y,' YOffset=',YOffset,
' DrawHeight=',DrawHeight,' ARect.Top=',ARect.Top,' ARect.Bottom=',ARect.Bottom);
if (Len > 0) and (Y-YOffset+DrawHeight >= ARect.Top) and (Y-YOffset < ARect.Bottom) then

2
components/synedit/synedit.pp
View File

@ -6777,7 +6777,7 @@ procedure TCustomSynEdit.CommandProcessor(Command: TSynEditorCommand;
begin
{$IFDEF VerboseKeys}
DebugLn('[TCustomSynEdit.CommandProcessor] ',Command
,' AChar=',AChar,' Data=',HexStr(Cardinal(Data),8));
,' AChar=',AChar,' Data=',DbgS(Data));
{$ENDIF}
// first the program event handler gets a chance to process the command
DoOnProcessCommand(Command, AChar, Data);

8
components/synedit/syneditregexsearch.pas
View File

@ -97,8 +97,8 @@ function TSynEditRegexSearch.FindAll(const NewText: string): integer;
procedure AddResult(const aPos, aLength: integer);
begin
fPositions.Add( pointer(aPos) );
fLengths.Add( pointer(aLength) );
fPositions.Add( pointer(PtrInt(aPos)) );
fLengths.Add( pointer(PtrInt(aLength)) );
end;
begin
@ -120,7 +120,7 @@ end;
function TSynEditRegexSearch.GetLength(aIndex: integer): integer;
begin
Result := integer( fLengths[ aIndex ] );
Result := PtrInt( fLengths[ aIndex ] );
end;
function TSynEditRegexSearch.GetPattern: string;
@ -130,7 +130,7 @@ end;
function TSynEditRegexSearch.GetResult(aIndex: integer): integer;
begin
Result := integer( fPositions[ aIndex ] );
Result := PtrInt( fPositions[ aIndex ] );
end;
function TSynEditRegexSearch.GetResultCount: integer;

4
components/synedit/synhighlightercpp.pp
View File

@ -1412,7 +1412,7 @@ end;
function TSynCppSyn.GetRange: Pointer;
begin
Result := Pointer(fRange);
Result := Pointer(PtrInt(fRange));
end;
function TSynCppSyn.GetToken: String;
@ -1480,7 +1480,7 @@ end;
procedure TSynCppSyn.SetRange(Value: Pointer);
begin
fRange := TRangeState(Value);
fRange := TRangeState(PtrInt(Value));
end;
procedure TSynCppSyn.EnumUserSettings(settings: TStrings);

4
components/synedit/synhighlightercss.pas
View File

@ -1648,7 +1648,7 @@ end;
function TSynCssSyn.GetRange: Pointer;
begin
Result := Pointer(fRange);
Result := Pointer(PtrInt(fRange));
end;
function TSynCssSyn.GetToken: string;
@ -1707,7 +1707,7 @@ end;
procedure TSynCssSyn.SetRange(Value: Pointer);
begin
FRange := TRangeState(Value);
FRange := TRangeState(PtrInt(Value));
end;
function TSynCssSyn.GetIdentChars: TSynIdentChars;

4
components/synedit/synhighlighterhtml.pp
View File

@ -2265,12 +2265,12 @@ end;
function TSynHTMLSyn.GetRange: Pointer;
begin
Result := Pointer(fRange);
Result := Pointer(PtrInt(fRange));
end;
procedure TSynHTMLSyn.SetRange(Value: Pointer);
begin
fRange := TRangeState(Value);
fRange := TRangeState(PtrInt(Value));
end;
procedure TSynHTMLSyn.ReSetRange;

4
components/synedit/synhighlighterjava.pas
View File

@ -1290,7 +1290,7 @@ end;
function TSynJavaSyn.GetRange: Pointer;
begin
Result := Pointer(fRange);
Result := Pointer(PtrInt(fRange));
end;
procedure TSynJavaSyn.ReSetRange;
@ -1300,7 +1300,7 @@ end;
procedure TSynJavaSyn.SetRange(Value: Pointer);
begin
fRange := TRangeState(Value);
fRange := TRangeState(PtrInt(Value));
end;
function TSynJavaSyn.GetToken: String;

4
components/synedit/synhighlighterlfm.pas
View File

@ -482,7 +482,7 @@ end;
function TSynLFMSyn.GetRange: Pointer;
begin
Result := Pointer(fRange);
Result := Pointer(PtrInt(fRange));
end;
function TSynLFMSyn.GetTokenID: TtkTokenKind;
@ -539,7 +539,7 @@ end;
procedure TSynLFMSyn.SetRange(Value: Pointer);
begin
fRange := TRangeState(Value);
fRange := TRangeState(PtrInt(Value));
end;
function TSynLFMSyn.GetIdentChars: TSynIdentChars;

8
components/synedit/synhighlightermulti.pas
View File

@ -349,14 +349,14 @@ begin
iSchemeIndex := fCurrScheme +2;
Assert( iSchemeIndex <= MaxSchemeCount );
if iHL <> nil then begin
iSchemeRange := cardinal( iHL.GetRange );
iSchemeRange := PtrInt( iHL.GetRange );
Assert( (iSchemeRange <= MaxSchemeRange) or (iHL is TSynMultiSyn) );
end else
iSchemeRange := 0;
{ checks the limit of nested MultiSyns }
Assert( iSchemeRange shr ((MaxNestedMultiSyn -1)*SchemeIndexSize + SchemeRangeSize) = 0 );
iSchemeRange := (iSchemeRange shl SchemeIndexSize) or iSchemeIndex;
Result := pointer(iSchemeRange);
Result := pointer(PtrInt(iSchemeRange));
end;
function TSynMultiSyn.GetToken: string;
@ -649,11 +649,11 @@ end;
procedure TSynMultiSyn.SetRange(Value: Pointer);
var
iSchemeRange: integer;
iSchemeRange: PtrInt;
begin
if Value = nil then
Exit;
iSchemeRange := integer(Value);
iSchemeRange := PtrInt(Value);
fCurrScheme := (iSchemeRange and MaxSchemeCount) -2;
iSchemeRange := iSchemeRange shr SchemeIndexSize;
if (CurrScheme < 0) then begin

6
components/synedit/synhighlighterpas.pp
View File

@ -489,7 +489,7 @@ begin
end;
if IsUnderScoreOrNumberChar[ToHash^] then
inc(ToHash);
fStringLen := integer(ToHash) - integer(Start);
fStringLen := PtrInt(ToHash) - PtrInt(Start);
end else begin
fStringLen := 0;
end;
@ -1560,12 +1560,12 @@ end;
function TSynPasSyn.GetRange: Pointer;
begin
Result := Pointer(fRange);
Result := Pointer(PtrInt(fRange));
end;
procedure TSynPasSyn.SetRange(Value: Pointer);
begin
fRange := TRangeState(Value);
fRange := TRangeState(PtrInt(Value));
end;
procedure TSynPasSyn.ResetRange;

4
components/synedit/synhighlighterphp.pas
View File

@ -1353,7 +1353,7 @@ end;
function TSynPHPSyn.GetRange: Pointer;
begin
Result := Pointer(fRange);
Result := Pointer(PtrInt(fRange));
end;
function TSynPHPSyn.GetToken: String;
@ -1403,7 +1403,7 @@ end;
procedure TSynPHPSyn.SetRange(Value: Pointer);
begin
fRange := TRangeState(Value);
fRange := TRangeState(PtrInt(Value));
end;
function TSynPHPSyn.GetIdentChars: TSynIdentChars;

2
components/synedit/synhighlighterposition.pas
View File

@ -169,7 +169,7 @@ end;
function TSynPositionHighlighter.GetRange: Pointer;
begin
Result := Pointer(fLineNumber);
Result := Pointer(PtrInt(fLineNumber));
end;
function TSynPositionHighlighter.GetToken: string;

6
components/synedit/synhighlighterpython.pas
View File

@ -363,7 +363,7 @@ begin
{$ENDIF}
if index <> -1 then
Result := TtkTokenKind (FKeywords.Objects[index])
Result := TtkTokenKind (PtrInt(FKeywords.Objects[index]))
// Check if it is a system identifier (__*__)
else if (fStringLen >= 5) and
@ -1181,7 +1181,7 @@ end;
function TSynPythonSyn.GetRange: Pointer;
begin
Result := Pointer(fRange);
Result := Pointer(PtrInt(fRange));
end;
function TSynPythonSyn.GetToken: string;
@ -1236,7 +1236,7 @@ end;
procedure TSynPythonSyn.SetRange(Value: Pointer);
begin
fRange := TRangeState(Value);
fRange := TRangeState(PtrInt(Value));
end;
function TSynPythonSyn.GetIdentChars: TSynIdentChars;

4
components/synedit/synhighlightersql.pas
View File

@ -1443,7 +1443,7 @@ end;
function TSynSQLSyn.GetRange: Pointer;
begin
Result := Pointer(fRange);
Result := Pointer(PtrInt(fRange));
end;
function TSynSQLSyn.GetToken: string;
@ -1507,7 +1507,7 @@ end;
procedure TSynSQLSyn.SetRange(Value: Pointer);
begin
fRange := TRangeState(Value);
fRange := TRangeState(PtrInt(Value));
end;
function TSynSQLSyn.GetIdentChars: TSynIdentChars;

4
components/synedit/synhighlighterunixshellscript.pas
View File

@ -699,7 +699,7 @@ end;
function TSynUNIXShellScriptSyn.GetRange: Pointer;
begin
Result := Pointer(fRange);
Result := Pointer(PtrInt(fRange));
end;
function TSynUNIXShellScriptSyn.GetToken: string;
@ -760,7 +760,7 @@ end;
procedure TSynUNIXShellScriptSyn.SetRange(Value: Pointer);
begin
fRange := TRangeState(Value);
fRange := TRangeState(PtrInt(Value));
end;
procedure TSynUNIXShellScriptSyn.SetSecondKeys(const Value: TStrings);

4
components/synedit/synhighlighterxml.pas
View File

@ -862,12 +862,12 @@ end;
function TSynXMLSyn.GetRange: Pointer;
begin
Result := Pointer(fRange);
Result := Pointer(PtrInt(fRange));
end;
procedure TSynXMLSyn.SetRange(Value: Pointer);
begin
fRange := TRangeState(Value);
fRange := TRangeState(PtrInt(Value));
end;
procedure TSynXMLSyn.ReSetRange;

8
components/synedit/synregexpr.pas
View File

@ -1227,7 +1227,7 @@ function RegExprSubExpressions (const ARegExpr : string;
with Stack [StackIdx] do begin
SubExprLen := i - StartPos + 1;
ASubExprs.Objects [SubExprIdx] :=
TObject (StartPos or (SubExprLen ShL 16));
TObject (PtrInt(StartPos or (SubExprLen ShL 16)));
ASubExprs [SubExprIdx] := System.Copy (
ARegExpr, StartPos + 1, SubExprLen - 2); // add without brackets
end;
@ -1270,11 +1270,11 @@ function RegExprSubExpressions (const ARegExpr : string;
// check if entire r.e. added
if (ASubExprs.Count = 0)
or ((integer (ASubExprs.Objects [0]) and $FFFF) <> 1)
or (((integer (ASubExprs.Objects [0]) ShR 16) and $FFFF) <> Len)
or ((PtrInt (ASubExprs.Objects [0]) and $FFFF) <> 1)
or (((PtrInt (ASubExprs.Objects [0]) ShR 16) and $FFFF) <> Len)
// whole r.e. wasn't added because it isn't bracketed
// well, we add it now:
then ASubExprs.InsertObject (0, ARegExpr, TObject ((Len ShL 16) or 1));
then ASubExprs.InsertObject (0, ARegExpr, TObject (PtrInt(Len ShL 16) or 1));
finally FreeMem (Stack);
end;

20
designer/designer.pp
View File

@ -945,7 +945,7 @@ begin
{$IFDEF VerboseDsgnPaintMsg}
writeln('*** TDesigner.PaintControl A ',Sender.Name,':',Sender.ClassName,
' DC=',HexStr(Cardinal(TheMessage.DC),8));
' DC=',DbgS(TheMessage.DC));
{$ENDIF}
// Set flag
OldDuringPaintControl:=dfDuringPaintControl in FFlags;
@ -954,7 +954,7 @@ begin
// send the Paint message to the control, so that it paints itself
//writeln('TDesigner.PaintControl B ',Sender.Name);
Sender.Dispatch(TheMessage);
//writeln('TDesigner.PaintControl C ',Sender.Name,' DC=',HexStr(Cardinal(TheMessage.DC),8));
//writeln('TDesigner.PaintControl C ',Sender.Name,' DC=',DbgS(TheMessage.DC));
// paint the Designer stuff
if TheMessage.DC <> 0 then begin
@ -964,7 +964,7 @@ begin
DDC.SetDC(Form, TheMessage.DC);
{$IFDEF VerboseDesignerDraw}
writeln('TDesigner.PaintControl D ',Sender.Name,':',Sender.ClassName,
' DC=',HexStr(DDC.DC,8),
' DC=',DbgS(DDC.DC,8),
{' FormOrigin=',DDC.FormOrigin.X,',',DDC.FormOrigin.Y,}
' DCOrigin=',DDC.DCOrigin.X,',',DDC.DCOrigin.Y,
' FormClientOrigin=',DDC.FormClientOrigin.X,',',DDC.FormClientOrigin.Y,
@ -973,7 +973,7 @@ begin
{$ENDIF}
if LastPaintSender=Sender then begin
//writeln('NOTE: TDesigner.PaintControl E control painted twice: ',
// Sender.Name,':',Sender.ClassName,' DC=',HexStr(Cardinal(TheMessage.DC),8));
// Sender.Name,':',Sender.ClassName,' DC=',DbgS(TheMessage.DC));
//RaiseException('');
end;
LastPaintSender:=Sender;
@ -1636,7 +1636,7 @@ begin
if DeletingPersistent.Count=0 then exit;
while DeletingPersistent.Count>0 do begin
APersistent:=TPersistent(DeletingPersistent[DeletingPersistent.Count-1]);
//writeln('TDesigner.DoDeleteSelectedComponents A ',AComponent.Name,':',AComponent.ClassName,' ',HexStr(Cardinal(AComponent),8));
//writeln('TDesigner.DoDeleteSelectedComponents A ',AComponent.Name,':',AComponent.ClassName,' ',DbgS(AComponent));
RemovePersistentAndChilds(APersistent);
//writeln('TDesigner.DoDeleteSelectedComponents B ',DeletingPersistent.IndexOf(AComponent));
end;
@ -1651,7 +1651,7 @@ procedure TDesigner.DoDeletePersistent(APersistent: TPersistent;
var
Hook: TPropertyEditorHook;
begin
//writeln('TDesigner.DoDeleteComponent A ',AComponent.Name,':',AComponent.ClassName,' ',HexStr(Cardinal(AComponent),8));
//writeln('TDesigner.DoDeleteComponent A ',AComponent.Name,':',AComponent.ClassName,' ',DbgS(AComponent));
PopupMenuComponentEditor:=nil;
// unselect component
ControlSelection.Remove(APersistent);
@ -1660,7 +1660,7 @@ begin
// this component is currently in the process of deletion or the component
// was not properly created
// -> do not call handlers and simply get rid of the rubbish
//writeln('TDesigner.DoDeleteComponent UNKNOWN ',AComponent.Name,':',AComponent.ClassName,' ',HexStr(Cardinal(AComponent),8));
//writeln('TDesigner.DoDeleteComponent UNKNOWN ',AComponent.Name,':',AComponent.ClassName,' ',DbgS(AComponent));
if FreeIt then
APersistent.Free;
// unmark component
@ -1752,7 +1752,7 @@ var
ChildControl: TControl;
Begin
{$IFDEF VerboseDesigner}
DebugLn('[TDesigner.RemovePersistentAndChilds] ',dbgsName(APersistent),' ',HexStr(Cardinal(APersistent),8));
DebugLn('[TDesigner.RemovePersistentAndChilds] ',dbgsName(APersistent),' ',DbgS(APersistent));
{$ENDIF}
if (APersistent=FLookupRoot) or (APersistent=Form)
or (IgnoreDeletingPersistent.IndexOf(APersistent)>=0)
@ -1765,7 +1765,7 @@ Begin
ChildControl:=AWinControl.Controls[i];
if (ChildControl.Owner=FLookupRoot)
and (IgnoreDeletingPersistent.IndexOf(ChildControl)<0) then begin
//Writeln('[TDesigner.RemoveComponentAndChilds] B ',AComponent.Name,':',AComponent.ClassName,' ',HexStr(Cardinal(AComponent),8),' Child=',ChildControl.Name,':',ChildControl.ClassName,' i=',i);
//Writeln('[TDesigner.RemoveComponentAndChilds] B ',AComponent.Name,':',AComponent.ClassName,' ',DbgS(AComponent),' Child=',ChildControl.Name,':',ChildControl.ClassName,' i=',i);
RemovePersistentAndChilds(ChildControl);
// the component list of the form has changed
// -> restart the search
@ -1785,7 +1785,7 @@ procedure TDesigner.Notification(AComponent: TComponent; Operation: TOperation);
Begin
if Operation = opInsert then begin
{$IFDEF VerboseDesigner}
DebugLn('opInsert ',AComponent.Name,':',AComponent.ClassName,' ',HexStr(Cardinal(AComponent),8));
DebugLn('opInsert ',AComponent.Name,':',AComponent.ClassName,' ',DbgS(AComponent));
{$ENDIF}
if dfDeleting in FFlags then begin
// a component has auto created a new component during deletion

44
designer/jitforms.pp
View File

@ -373,25 +373,25 @@ function ClassAsString(AClass: TClass): string;
var
ParentClass: TClass;
begin
Result:='Class='+HexStr(Cardinal(AClass),8);
Result:='Class='+DbgS(AClass);
if AClass=nil then exit;
Result:=Result+' Name="'+AClass.ClassName+'"';
ParentClass:=AClass.ClassParent;
if ParentClass<>nil then
Result:=Result+' Parent='+HexStr(Cardinal(ParentClass),8)+'-"'+ParentClass.ClassName+'"';
Result:=Result+' Parent='+DbgS(ParentClass)+'-"'+ParentClass.ClassName+'"';
Result:=Result+LineEnding;
Result:=Result+' vmtInstanceSize='+IntToStr(PLongInt(pointer(AClass)+vmtInstanceSize)^);
Result:=Result+' vmtInstanceSizeNeg='+IntToStr(PLongInt(pointer(AClass)+vmtInstanceSizeNeg)^);
Result:=Result+' vmtParent='+HexStr(Cardinal(pcardinal(pointer(AClass)+vmtParent)^),8);
Result:=Result+' vmtParent='+DbgS(pcardinal(pointer(AClass)+vmtParent)^);
Result:=Result+' vmtClassName="'+PShortString((Pointer(AClass)+vmtClassName)^)^+'"';
Result:=Result+' vmtDynamicTable='+HexStr(Cardinal(pcardinal(pointer(AClass)+vmtDynamicTable)^),8);
Result:=Result+' vmtMethodTable='+HexStr(Cardinal(pcardinal(pointer(AClass)+vmtMethodTable)^),8);
Result:=Result+' vmtFieldTable='+HexStr(Cardinal(pcardinal(pointer(AClass)+vmtFieldTable)^),8);
Result:=Result+' vmtTypeInfo='+HexStr(Cardinal(pcardinal(pointer(AClass)+vmtTypeInfo)^),8);
Result:=Result+' vmtInitTable='+HexStr(Cardinal(pcardinal(pointer(AClass)+vmtInitTable)^),8);
Result:=Result+' vmtAutoTable='+HexStr(Cardinal(pcardinal(pointer(AClass)+vmtAutoTable)^),8);
Result:=Result+' vmtIntfTable='+HexStr(Cardinal(pcardinal(pointer(AClass)+vmtIntfTable)^),8);
Result:=Result+' vmtMsgStrPtr='+HexStr(Cardinal(pcardinal(pointer(AClass)+vmtMsgStrPtr)^),8);
Result:=Result+' vmtDynamicTable='+DbgS(pcardinal(pointer(AClass)+vmtDynamicTable)^);
Result:=Result+' vmtMethodTable='+DbgS(pcardinal(pointer(AClass)+vmtMethodTable)^);
Result:=Result+' vmtFieldTable='+DbgS(pcardinal(pointer(AClass)+vmtFieldTable)^);
Result:=Result+' vmtTypeInfo='+DbgS(pcardinal(pointer(AClass)+vmtTypeInfo)^);
Result:=Result+' vmtInitTable='+DbgS(pcardinal(pointer(AClass)+vmtInitTable)^);
Result:=Result+' vmtAutoTable='+DbgS(pcardinal(pointer(AClass)+vmtAutoTable)^);
Result:=Result+' vmtIntfTable='+DbgS(pcardinal(pointer(AClass)+vmtIntfTable)^);
Result:=Result+' vmtMsgStrPtr='+DbgS(pcardinal(pointer(AClass)+vmtMsgStrPtr)^);
Result:=Result+LineEnding;
Result:=Result+' MethodTable=['+ClassMethodTableAsString(AClass)+']';
Result:=Result+LineEnding;
@ -412,7 +412,7 @@ begin
for i:=0 to MethodTable^.Count-1 do begin
if i>0 then Result:=Result+',';
Result:=Result+IntToStr(i)+':"'+(MethodTable^.Entries[i].Name^)+'"'
+':'+HexStr(Cardinal(MethodTable^.Entries[i].Addr),8);
+':'+DbgS(MethodTable^.Entries[i].Addr);
end;
end;
@ -432,17 +432,17 @@ begin
// read all property infos of current class
TypeData:=GetTypeData(TypeInfo);
if TypeData=nil then exit;
Result:=Result+' ClassType='+HexStr(Cardinal(TypeData^.ClassType),8);
Result:=Result+' ClassType='+DbgS(TypeData^.ClassType);
if TypeData^.ClassType<>AClass then
Result:=Result+LineEnding
+' WARNING: ClassType<>AClass('+HexStr(Cardinal(AClass),8)+')'+LineEnding;
Result:=Result+' ParentInfo='+HexStr(Cardinal(TypeData^.ParentInfo),8);
+' WARNING: ClassType<>AClass('+DbgS(AClass)+')'+LineEnding;
Result:=Result+' ParentInfo='+DbgS(TypeData^.ParentInfo);
if (AClass.ClassParent<>nil)
and (TypeData^.ParentInfo<>AClass.ClassParent.ClassInfo) then
Result:=Result+LineEnding
+' WARNING: TypeData^.ParentInfo<>AClass.ClassParent.ClassInfo('
+HexStr(Cardinal(TypeData^.ParentInfo),8)+'<>'+
+HexStr(Cardinal(AClass.ClassParent.ClassInfo),8)+'<>'+')'+LineEnding;
+DbgS(TypeData^.ParentInfo)+'<>'+
+DbgS(AClass.ClassParent.ClassInfo)+'<>'+')'+LineEnding;
Result:=Result+' PropCount='+IntToStr(TypeData^.PropCount);
Result:=Result+' UnitName="'+TypeData^.UnitName+'"';
@ -479,7 +479,7 @@ begin
if FieldTable=nil then exit;
Result:=Result+'FieldCount='+IntToStr(FieldTable^.FieldCount);
ClassTable:=FieldTable^.ClassTable;
Result:=Result+' ClassTable='+HexStr(Cardinal(ClassTable),8);
Result:=Result+' ClassTable='+DbgS(ClassTable);
if ClassTable<>nil then begin
Result:=Result+'={';
for i:=0 to ClassTable^.Count-1 do begin
@ -753,7 +753,7 @@ begin
NewUnitName);
//debugln('[TJITForms.DoCreateJITComponent] Creating an instance of JIT class "'+NewClassName+'" = class('+ParentClass.ClassName+') ...');
Instance:=TComponent(FCurReadClass.NewInstance);
//debugln('[TJITForms.DoCreateJITComponent] Initializing new instance ... ',HexStr(Cardinal(Instance),8));
//debugln('[TJITForms.DoCreateJITComponent] Initializing new instance ... ',DbgS(Instance));
TComponent(FCurReadJITComponent):=Instance;
ok:=false;
try
@ -1111,7 +1111,7 @@ begin
{$R-}
//for a:=0 to NewMethodTable^.Count-2 do
// writeln(a,'=',NewMethodTable^.Entries[a].Name^,' $'
// ,HexStr(Integer(NewMethodTable^.Entries[a].Name),8));
// ,DbgS(Integer(NewMethodTable^.Entries[a].Name),8));
with NewMethodTable^.Entries[NewMethodTable^.Count-1] do begin
GetMem(Name,256);
Name^:=AName;
@ -1119,7 +1119,7 @@ begin
end;
//for a:=0 to NewMethodTable^.Count-1 do
// writeln(a,'=',NewMethodTable^.Entries[a].Name^,' $'
// ,HexStr(Integer(NewMethodTable^.Entries[a].Name),8));
// ,DbgS(Integer(NewMethodTable^.Entries[a].Name),8));
{$IFDEF RangeCheckOn}{$R+}{$ENDIF}
PMethodNameTable((Pointer(JITClass)+vmtMethodTable)^):=NewMethodTable;
if Assigned(OldMethodTable) then
@ -1213,7 +1213,7 @@ procedure TJITComponentList.ReaderFindMethod(Reader: TReader;
var NewMethod: TMethod;
begin
{$IFDEF IDE_DEBUG}
writeln('[TJITComponentList.ReaderFindMethod] A "'+FindMethodName+'" Address=',HexStr(Cardinal(Address),8));
writeln('[TJITComponentList.ReaderFindMethod] A "'+FindMethodName+'" Address=',DbgS(Address));
{$ENDIF}
if Address=nil then begin
// there is no method in the ancestor class with this name

2
examples/treeview/tv_add_remove_u1.pas
View File

@ -52,7 +52,7 @@ begin
with tv_eg1.Items.AddFirst( nil, 'Root' ) do
begin
Selected := true;
writeln('tv_eg1.Selected=',HexStr(Cardinal(tv_eg1.Selected),8));
writeln('tv_eg1.Selected=',DbgS(tv_eg1.Selected));
end;
end
else begin

4
ide/charactermapdlg.pas
View File

@ -37,7 +37,7 @@ interface
uses
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, Buttons,
SynEdit, StdCtrls, LCLType, GraphType, LazarusIDEStrConsts, EditorOptions,
SynEdit, StdCtrls, LCLType, LCLProc, GraphType, LazarusIDEStrConsts, EditorOptions,
SynEditHighlighter, SynHighlighterPosition;
type
@ -159,7 +159,7 @@ var
begin
if RowColValid(Row,Col) then begin
CharOrd:=GetCharOrd(Row,Col);
Result:='Dezimal='+IntToStr(CharOrd)+' Hex='+HexStr(CharOrd,2);
Result:='Decimal='+IntToStr(CharOrd)+' Hex='+HexStr(CharOrd,2);
end else begin
Result:='-';
end;

2
ide/customformeditor.pp
View File

@ -1330,7 +1330,7 @@ Begin
CompTop:=Max(1,Min(250,Screen.Height-CompHeight-50));
DesignOffset:=Point(CompLeft,CompTop);
DesignSize:=Point(CompWidth,CompHeight);
//debugln('TCustomFormEditor.CreateComponent TDataModule Bounds ',dbgsName(Temp.Component),' ',dbgs(DesignOffset.X),',',dbgs(DesignOffset.Y),' ',HexStr(Cardinal(Temp.Component),8),' ',HexStr(Cardinal(@DesignOffset),8));
//debugln('TCustomFormEditor.CreateComponent TDataModule Bounds ',dbgsName(Temp.Component),' ',dbgs(DesignOffset.X),',',dbgs(DesignOffset.Y),' ',DbgS(Temp.Component),8),' ',DbgS(Cardinal(@DesignOffset));
end;
end
else begin

8
ide/uniteditor.pp
View File

@ -2651,10 +2651,10 @@ Begin
clSelect:=FActiveEditSelectedBGColor;
TextColor:=FActiveEditDefaultFGColor;
TextSelectedColor:=FActiveEditSelectedFGColor;
//writeln('TSourceNotebook.ccExecute A Color=',HexStr(Cardinal(Color),8),
// ' clSelect=',HexStr(Cardinal(clSelect),8),
// ' TextColor=',HexStr(Cardinal(TextColor),8),
// ' TextSelectedColor=',HexStr(Cardinal(TextSelectedColor),8),
//writeln('TSourceNotebook.ccExecute A Color=',DbgS(Color),
// ' clSelect=',DbgS(clSelect),
// ' TextColor=',DbgS(TextColor),
// ' TextSelectedColor=',DbgS(TextSelectedColor),
// '');
end;
end;

40
ideintf/propedits.pp
View File

@ -1482,7 +1482,7 @@ var
begin
TypeInfo:=Instance.ClassInfo;
TypeData:=GetTypeData(TypeInfo);
debugln('WritePublishedProperties Instance=',HexStr(Cardinal(Instance),8),' ',Instance.ClassName,' TypeData^.PropCount=',dbgs(TypeData^.PropCount));
debugln('WritePublishedProperties Instance=',DbgS(Instance),' ',Instance.ClassName,' TypeData^.PropCount=',dbgs(TypeData^.PropCount));
if Instance is TComponent then
debugln(' TComponent(Instance).Name=',TComponent(Instance).Name);
@ -1495,20 +1495,20 @@ begin
PropInfo:=(@TypeData^.UnitName+Length(TypeData^.UnitName)+1);
// read property count
CurCount:=PWord(PropInfo)^;
inc(Longint(PropInfo),SizeOf(Word));
inc(PtrInt(PropInfo),SizeOf(Word));
debugln(' UnitName=',TypeData^.UnitName,' Type=',TypeInfo^.Name,' CurPropCount=',dbgs(CurCount));
{writeln('TPropInfoList.Create D ',CurCount,' TypeData^.ClassType=',HexStr(Cardinal(TypeData^.ClassType),8));
{writeln('TPropInfoList.Create D ',CurCount,' TypeData^.ClassType=',DbgS(TypeData^.ClassType));
writeln('TPropInfoList.Create E ClassName="',TypeData^.ClassType.ClassName,'"',
' TypeInfo=',HexStr(Cardinal(TypeInfo),8),
' TypeData^.ClassType.ClassInfo=',HexStr(Cardinal(TypeData^.ClassType.ClassInfo),8),
' TypeData^.ClassType.ClassParent=',HexStr(Cardinal(TypeData^.ClassType.ClassParent),8),
' TypeData^.ParentInfo=',HexStr(Cardinal(TypeData^.ParentInfo),8),
' TypeInfo=',DbgS(TypeInfo),
' TypeData^.ClassType.ClassInfo=',DbgS(TypeData^.ClassType.ClassInfo),
' TypeData^.ClassType.ClassParent=',DbgS(TypeData^.ClassType.ClassParent),
' TypeData^.ParentInfo=',DbgS(TypeData^.ParentInfo),
'');
CurParent:=TypeData^.ClassType.ClassParent;
if CurParent<>nil then begin
writeln('TPropInfoList.Create F CurParent.ClassName=',CurParent.ClassName,
' CurParent.ClassInfo=',HexStr(Cardinal(CurParent.ClassInfo),8),
' CurParent.ClassInfo=',DbgS(CurParent.ClassInfo),
'');
end;}
@ -1636,19 +1636,19 @@ begin
PropInfo:=(@TypeData^.UnitName+Length(TypeData^.UnitName)+1);
// read property count
CurCount:=PWord(PropInfo)^;
inc(Longint(PropInfo),SizeOf(Word));
inc(PtrInt(PropInfo),SizeOf(Word));
{writeln('TPropInfoList.Create D ',CurCount,' TypeData^.ClassType=',HexStr(Cardinal(TypeData^.ClassType),8));
{writeln('TPropInfoList.Create D ',CurCount,' TypeData^.ClassType=',DbgS(TypeData^.ClassType));
writeln('TPropInfoList.Create E ClassName="',TypeData^.ClassType.ClassName,'"',
' TypeInfo=',HexStr(Cardinal(TypeInfo),8),
' TypeData^.ClassType.ClassInfo=',HexStr(Cardinal(TypeData^.ClassType.ClassInfo),8),
' TypeData^.ClassType.ClassParent=',HexStr(Cardinal(TypeData^.ClassType.ClassParent),8),
' TypeData^.ParentInfo=',HexStr(Cardinal(TypeData^.ParentInfo),8),
' TypeInfo=',DbgS(TypeInfo),
' TypeData^.ClassType.ClassInfo=',DbgS(TypeData^.ClassType.ClassInfo),
' TypeData^.ClassType.ClassParent=',DbgS(TypeData^.ClassType.ClassParent),
' TypeData^.ParentInfo=',DbgS(TypeData^.ParentInfo),
'');
CurParent:=TypeData^.ClassType.ClassParent;
if CurParent<>nil then begin
writeln('TPropInfoList.Create F CurParent.ClassName=',CurParent.ClassName,
' CurParent.ClassInfo=',HexStr(Cardinal(CurParent.ClassInfo),8),
' CurParent.ClassInfo=',DbgS(CurParent.ClassInfo),
'');
end;}
@ -2284,7 +2284,7 @@ begin
case (PropInfo^.PropProcs) and 3 of
ptfield:
begin
Value:=PMethod(Pointer(Instance)+Longint(PropInfo^.GetProc));
Value:=PMethod(Pointer(Instance)+PtrInt(PropInfo^.GetProc));
if Value<>nil then
Result:=Value^;
end;
@ -2294,7 +2294,7 @@ begin
if (PropInfo^.PropProcs and 3)=ptStatic then
AMethod.Code:=PropInfo^.GetProc
else
AMethod.Code:=PPointer(Pointer(Instance.ClassType)+Longint(PropInfo^.GetProc))^;
AMethod.Code:=PPointer(Pointer(Instance.ClassType)+Ptrint(PropInfo^.GetProc))^;
AMethod.Data:=Instance;
if ((PropInfo^.PropProcs shr 6) and 1)<>0 then
Result:=TGetMethodProcIndex(AMethod)(PropInfo^.Index)
@ -4114,7 +4114,7 @@ begin
begin
Result := TPersistentSelectionList.Create;
for I := 0 to PropCount - 1 do
Result.Add(TPersistent(GetOrdValueAt(I)));
Result.Add(TPersistent(PtrInt(GetOrdValueAt(I))));
end;
end;
@ -4127,7 +4127,7 @@ begin
LInstance := TPersistent(GetObjectValue);
if PropCount > 1 then
for I := 1 to PropCount - 1 do
if TPersistent(GetOrdValueAt(I)) <> LInstance then
if TPersistent(PtrInt(GetOrdValueAt(I))) <> LInstance then
Exit;
Result := LInstance<>nil;
end;
@ -4221,7 +4221,7 @@ begin
end;
end;
end;
SetOrdValue(Longint(Component));
SetOrdValue(Ptrint(Component));
end;
{ TComponentPropertyEditor }

20
lcl/dynhasharray.pp
View File

@ -296,7 +296,7 @@ begin
if HashItem<>nil then begin
DbgOut(' Index=',IntToStr(i));
while HashItem<>nil do begin
DbgOut(' ',HexStr(Cardinal(HashItem^.Item),8));
DbgOut(' ',Dbgs(HashItem^.Item));
RealHashIndex:=IndexOf(HashItem^.Item);
if RealHashIndex<>i then DbgOut('(H='+dbgs(RealHashIndex)+')');
HashItem:=HashItem^.Next;
@ -307,10 +307,10 @@ begin
end;
HashItem:=FFirstItem;
while HashItem<>nil do begin
DebugLn(' ',HexStr(Cardinal(HashItem^.Prior),8),'<-'
,HexStr(Cardinal(HashItem),8)
,'(',HexStr(Cardinal(HashItem^.Item),8),')'
,'->',HexStr(Cardinal(HashItem^.Next),8));
DebugLn(' ',Dbgs(HashItem^.Prior),'<-'
,Dbgs(HashItem)
,'(',Dbgs(HashItem^.Item),')'
,'->',Dbgs(HashItem^.Next));
HashItem:=HashItem^.Next;
end;
end;
@ -440,14 +440,14 @@ begin
exit(FHashCacheIndex);
if not Assigned(FCustomHashFunction) then begin
if not Assigned(FOwnerHashFunction) then begin
Result:=Integer((Cardinal(Key)+(Cardinal(Key) mod 17)) mod Cardinal(FCapacity));
Result:=Integer((PtrUInt(Key)+(PtrUint(Key) mod 17)) mod Cardinal(FCapacity));
end else
Result:=FOwnerHashFunction(Key);
end else
Result:=FCustomHashFunction(Self,Key);
{if (Key=FHashCacheItem) and (FHashCacheIndex>=0)
and (Result<>FHashCacheIndex) then begin
DebugLn(' DAMN: ',HexStr(Cardinal(Key),8),' ',FHashCacheIndex,'<>',Result);
DebugLn(' DAMN: ',HexStr(PtrInt(Key),8),' ',FHashCacheIndex,'<>',Result);
raise Exception.Create('GROSSER MIST');
end;}
// Check if the owner or custon function has returned something valid
@ -505,9 +505,9 @@ end;
function TDynHashArray.SlowAlternativeHashMethod(Sender: TDynHashArray;
Item: Pointer): integer;
begin
Result:=integer((Cardinal(Item) mod Cardinal(PrimeNumber))
+(Cardinal(Item) mod 17)+(Cardinal(Item) mod 173)
+(Cardinal(Item) mod 521)
Result:=integer((PtrUInt(Item) mod Cardinal(PrimeNumber))
+(PtrUInt(Item) mod 17)+(PtrUInt(Item) mod 173)
+(PtrUInt(Item) mod 521)
) mod FCapacity;
end;

2
lcl/forms.pp
View File

@ -1309,7 +1309,7 @@ end;
procedure RestoreFocusState(FocusState: TFocusState);
begin
FocusCount := Integer(FocusState);
FocusCount := PtrInt(FocusState);
end;
{function SendFocusMessage(Window: HWnd; Msg: Word): Boolean;

1
lcl/fpcadds.pas
View File

@ -58,5 +58,6 @@ begin
end;
end;
end.

31
lcl/graphtype.pp
View File

@ -282,7 +282,7 @@ begin
if p^<>$ff then begin
// not all bits set -> transparent pixels found -> Mask needed
{$IFDEF VerboseRawImage}
DebugLn('RawImageMaskIsEmpty FullByte y=',dbgs(y),' x=',dbgs(x),' Byte=',HexStr(Cardinal(p^),2));
DebugLn('RawImageMaskIsEmpty FullByte y=',dbgs(y),' x=',dbgs(x),' Byte=',DbgS(p^));
{$ENDIF}
exit;
end;
@ -471,7 +471,7 @@ begin
ExtractRawImageDataRect(@SrcRawImage^.Description,SrcRect,SrcRawImage^.Data,
@DestRawImage^.Description,DestRawImage^.Data,DestRawImage^.DataSize);
// extract rectangle from separate Alpha
//DebugLn'ExtractRawImageDataRect data=',HexStr(Cardinal(DestRawImage^.Data),8),' Size=',DestRawImage^.DataSize);
//DebugLn'ExtractRawImageDataRect data=',DbgS(DestRawImage^.Data),' Size=',DestRawImage^.DataSize);
if SrcRawImage^.Description.AlphaSeparate
and (SrcRawImage^.Mask<>nil) then begin
@ -527,10 +527,10 @@ begin
// allocate Data
DestRawImageDesc^.Width:=SrcWidth;
DestRawImageDesc^.Height:=SrcHeight;
//DebugLn'ExtractRawImageDataRect Src=',SrcWidth,',',SrcHeight,' DestData=',HexStr(Cardinal(DestData),8));
//DebugLn'ExtractRawImageDataRect Src=',SrcWidth,',',SrcHeight,' DestData=',DbgS(DestData));
CreateRawImageData(SrcWidth,SrcHeight,BitsPerPixel,LineEnd,
DestData,DestDataSize);
//DebugLn'ExtractRawImageDataRect data=',HexStr(Cardinal(DestData),8),' Size=',DestDataSize);
//DebugLn'ExtractRawImageDataRect data=',DbgS(DestData),' Size=',DestDataSize);
if (SrcWidth=TotalWidth) and (TotalHeight=SrcHeight) then begin
// copy whole source
System.Move(SrcData^,DestData^,DestDataSize);
@ -565,15 +565,15 @@ begin
inc(ByteCount);
//DebugLn'ExtractRawImageDataRect B ByteCount=',ByteCount);
System.Move(
Pointer(Cardinal(SrcData)+SrcLineStartPosition.Byte)^,
Pointer(Cardinal(DestData)+DestLineStartPosition.Byte)^,
Pointer(PtrUInt(SrcData)+SrcLineStartPosition.Byte)^,
Pointer(PtrUInt(DestData)+DestLineStartPosition.Byte)^,
ByteCount);
end else if (DestLineStartPosition.Bit=0) then begin
// copy and move bits
ByteCount:=((SrcWidth*BitsPerPixel)+7) shr 3;
Shift:=8-SrcLineStartPosition.Bit;
SrcPos:=PByte(Cardinal(SrcData)+SrcLineStartPosition.Byte);
DestPos:=PByte(Cardinal(DestData)+DestLineStartPosition.Byte);
SrcPos:=PByte(PtrUInt(SrcData)+SrcLineStartPosition.Byte);
DestPos:=PByte(PtrUInt(DestData)+DestLineStartPosition.Byte);
for x:=0 to ByteCount-1 do begin
w:=PWord(SrcPos)^;
w:=w shr Shift;
@ -699,8 +699,8 @@ begin
Bits:=Bits shr (16-Prec);
{DebugLn'WriteDataBits WRITE Position=',Position.Byte,'/',Position.Bit,
' Shift=',Shift,' Prec=',Prec,' BitsPerPixel=',BitsPerPixel,
' PrecMask=',HexStr(Cardinal(PrecMask),4),
' Bits=',HexStr(Cardinal(Bits),4),
' PrecMask=',DbgS(PrecMask),
' Bits=',DbgS(Bits),
'');}
case BitsPerPixel of
1,2,4:
@ -714,7 +714,7 @@ begin
OneByte:=OneByte and PrecMask; // clear old
OneByte:=OneByte or (Bits shl ShiftLeft); // set new
P^:=OneByte;
//DebugLn'WriteDataBits 1,2,4 Result=',HexStr(Cardinal(OneByte),2));
//DebugLn'WriteDataBits 1,2,4 Result=',DbgS(OneByte));
end;
8: begin
OneByte:=P^;
@ -722,7 +722,7 @@ begin
OneByte:=OneByte and PrecMask; // clear old
OneByte:=OneByte or (Bits shl Shift); // set new
P^:=OneByte;
//DebugLn'WriteDataBits 8 Result=',HexStr(Cardinal(OneByte),2));
//DebugLn'WriteDataBits 8 Result=',DbgS(OneByte));
end;
16: begin
TwoBytes:=PWord(P)^;
@ -730,7 +730,7 @@ begin
TwoBytes:=TwoBytes and PrecMask; // clear old
TwoBytes:=TwoBytes or (Bits shl Shift); // set new
PWord(P)^:=TwoBytes;
//DebugLn'WriteDataBits 16 Result=',HexStr(Cardinal(TwoBytes),4));
//DebugLn'WriteDataBits 16 Result=',DbgS(TwoBytes));
end;
32: begin
FourBytes:=PDWord(P)^;
@ -738,7 +738,7 @@ begin
FourBytes:=FourBytes and PrecMask; // clear old
FourBytes:=FourBytes or cardinal(Bits shl Shift); // set new
PDWord(P)^:=FourBytes;
//DebugLn'WriteDataBits 32 Result=',HexStr(Cardinal(FourBytes),8));
//DebugLn'WriteDataBits 32 Result=',DbgS(FourBytes));
end;
end;
end;
@ -788,6 +788,9 @@ end.
{ =============================================================================
$Log$
Revision 1.40 2005/03/07 21:59:44 vincents
changed hexstr(cardinal()) for pointers to dbgs() and other 64-bits fixes from Peter Vreman
Revision 1.39 2005/03/05 13:09:27 mattias
added BitOrder test for RawImageMaskEmpty

60
lcl/grids.pas
View File

@ -1340,7 +1340,7 @@ end;
function TCustomGrid.GetRowHeights(Arow: Integer): Integer;
begin
if (aRow<RowCount) and (aRow>=0) then
Result:=Integer(FRows[aRow])
Result:=PtrInt(FRows[aRow])
else
Result:=-1;
if Result<0 then Result:=fDefRowHeight;
@ -1463,7 +1463,7 @@ end;
procedure TCustomGrid.InternalSetColWidths(aCol, aValue: Integer);
begin
if AValue<0 then Avalue:=-1;
if Avalue<>Integer(FCols[ACol]) then begin
if Avalue<>PtrInt(FCols[ACol]) then begin
SetRawColWidths(ACol, Avalue);
VisualChange;
if (FEditor<>nil)and(Feditor.Visible)and(ACol<=FCol) then
@ -1520,7 +1520,7 @@ var
begin
if not Columns.Enabled or (aCol<FixedCols) then begin
if (aCol<ColCount) and (aCol>=0) then
Result:=Integer(FCols[aCol])
Result:=PtrInt(FCols[aCol])
else
Result:=-1;
if result<0 then
@ -1624,7 +1624,7 @@ end;
procedure TCustomGrid.Setrowheights(Arow: Integer; Avalue: Integer);
begin
if AValue<0 then AValue:=-1;
if AValue<>Integer(FRows[ARow]) then begin
if AValue<>PtrInt(FRows[ARow]) then begin
FRows[ARow]:=Pointer(PtrInt(AValue));
VisualChange;
if (FEditor<>nil)and(Feditor.Visible)and(ARow<=FRow) then EditorPos;
@ -1943,7 +1943,7 @@ var
if HSbVisible then begin
HsbRange:=GridWidth + 2 - Integer(BorderStyle){+ dv};
if not (goSmoothScroll in Options) then begin
TW:= Integer(AccumWidth[MaxTopLeft.X])-(HsbRange-ClientWidth);
TW:= PtrInt(AccumWidth[MaxTopLeft.X])-(HsbRange-ClientWidth);
HsbRange:=HsbRange + TW - FixedWidth + 1;
end;
end;
@ -1954,7 +1954,7 @@ var
if VSbVisible then begin
VSbRange:= GridHeight + 2 - Integer(BorderStyle){ + dh};
if not (goSmoothScroll in Options) then begin
TH:= Integer(accumHeight[MaxTopLeft.Y])-(VsbRange-ClientHeight);
TH:= PtrInt(accumHeight[MaxTopLeft.Y])-(VsbRange-ClientHeight);
VsbRange:=VsbRange + TH -FixedHeight + 1;
end;
end;
@ -2795,8 +2795,8 @@ begin
if FEditor<>nil then
EditorGetValue;
TL:= Integer(FGCache.AccumWidth[ FGCache.MaxTopLeft.X ]) - FGCAche.FixedWidth;
CTL:= Integer(FGCache.AccumWidth[ FtopLeft.X ]) - FGCache.FixedWidth;
TL:= PtrInt(FGCache.AccumWidth[ FGCache.MaxTopLeft.X ]) - FGCAche.FixedWidth;
CTL:= PtrInt(FGCache.AccumWidth[ FtopLeft.X ]) - FGCache.FixedWidth;
case message.ScrollCode of
// Scrolls to start / end of the text
@ -2872,8 +2872,8 @@ begin
if FEditor<>nil then EditorGetValue;
TL:= Integer(FGCache.AccumHeight[ FGCache.MaxTopLeft.Y ]) - FGCache.FixedHeight;
CTL:= Integer(FGCache.AccumHeight[ FtopLeft.Y ]) - FGCache.FixedHeight;
TL:= PtrInt(FGCache.AccumHeight[ FGCache.MaxTopLeft.Y ]) - FGCache.FixedHeight;
CTL:= PtrInt(FGCache.AccumHeight[ FtopLeft.Y ]) - FGCache.FixedHeight;
case message.ScrollCode of
// Scrolls to start / end of the text
@ -2997,7 +2997,7 @@ begin
if ScrollBarAutomatic(ssHorizontal) then begin
with FGCache do
ScrollBarPosition(SB_HORZ,
Integer(AccumWidth[FTopLeft.x])-TLColOff-FixedWidth );
PtrInt(AccumWidth[FTopLeft.x])-TLColOff-FixedWidth );
end;
end;
@ -3005,7 +3005,7 @@ begin
if ScrollBarAutomatic(ssVertical) then begin
with FGCache do
ScrollBarPosition(SB_VERT,
Integer(AccumHeight[FTopLeft.y])-TLRowOff-FixedHeight);
PtrInt(AccumHeight[FTopLeft.y])-TLRowOff-FixedHeight);
end;
end;
end; {if FUpd...}
@ -3094,8 +3094,8 @@ begin
with FTopleft do
if CheckCols and (X>FixedCols) then begin
W := FGCache.ScrollWidth-ColWidths[aCol]-Integer(FGCache.AccumWidth[aCol]);
while (x>FixedCols)and(W+Integer(FGCache.AccumWidth[x])>=ColWidths[x-1]) do
W := FGCache.ScrollWidth-ColWidths[aCol]-PtrInt(FGCache.AccumWidth[aCol]);
while (x>FixedCols)and(W+PtrInt(FGCache.AccumWidth[x])>=ColWidths[x-1]) do
begin
Dec(x);
end;
@ -3103,8 +3103,8 @@ begin
with FTopleft do
if CheckRows and (Y > FixedRows) then begin
W := FGCache.ScrollHeight-RowHeights[aRow]-Integer(FGCache.AccumHeight[aRow]);
while (y>FixedRows)and(W+Integer(FGCache.AccumHeight[y])>=RowHeights[y-1]) do
W := FGCache.ScrollHeight-RowHeights[aRow]-PtrInt(FGCache.AccumHeight[aRow]);
while (y>FixedRows)and(W+PtrInt(FGCache.AccumHeight[y])>=RowHeights[y-1]) do
begin
Dec(y);
end;
@ -3447,30 +3447,30 @@ begin
// begin to count Cols from 0 but ...
if Fisical and (Offset>FixedWidth-1) then begin
Result:=FTopLeft.X; // In scrolled view, then begin from FtopLeft col
Offset:=Offset-FixedWidth+Integer(AccumWidth[Result])+TLColOff;
Offset:=Offset-FixedWidth+PtrInt(AccumWidth[Result])+TLColOff;
if Offset>GridWidth-1 then begin
Result:=ColCount-1;
Exit;
end;
end;
while Offset>(Integer(AccumWidth[Result])+GetColWidths(Result)-1) do Inc(Result);
while Offset>(PtrInt(AccumWidth[Result])+GetColWidths(Result)-1) do Inc(Result);
Rest:=Offset;
if Result<>0 then Rest:=Offset-Integer(AccumWidth[Result]);
if Result<>0 then Rest:=Offset-PtrInt(AccumWidth[Result]);
end else begin
if Fisical and (Offset>FixedHeight-1) then begin
Result:=FTopLeft.Y;
Offset:=Offset-FixedHeight+Integer(AccumHeight[Result])+TLRowOff;
Offset:=Offset-FixedHeight+PtrInt(AccumHeight[Result])+TLRowOff;
if Offset>GridHeight-1 then begin
Result:=RowCount-1;
Exit; // Out of Range
end;
end;
while Offset>(Integer(AccumHeight[Result])+GetRowHeights(Result)-1) do Inc(Result);
while Offset>(PtrInt(AccumHeight[Result])+GetRowHeights(Result)-1) do Inc(Result);
Rest:=Offset;
if Result<>0 then Rest:=Offset-Integer(AccumHeight[Result]);
if Result<>0 then Rest:=Offset-PtrInt(AccumHeight[Result]);
end;
end;
@ -3485,10 +3485,10 @@ var
begin
with FGCache do begin
if IsCol then begin
Ini:=Integer(AccumWidth[index]);
Ini:=PtrInt(AccumWidth[index]);
Dim:=GetColWidths(index);
end else begin
Ini:=Integer(AccumHeight[index]);
Ini:=PtrInt(AccumHeight[index]);
Dim:= GetRowHeights(index);
end;
Ini := Ini + Integer(BorderStyle);
@ -3498,10 +3498,10 @@ begin
end;
if IsCol then begin
if index>=FFixedCols then
Ini:=Ini-Integer(AccumWidth[FTopLeft.X]) + FixedWidth - TLColOff;
Ini:=Ini-PtrInt(AccumWidth[FTopLeft.X]) + FixedWidth - TLColOff;
end else begin
if index>=FFixedRows then
Ini:=Ini-Integer(AccumHeight[FTopLeft.Y]) + FixedHeight - TLRowOff;
Ini:=Ini-PtrInt(AccumHeight[FTopLeft.Y]) + FixedHeight - TLRowOff;
end;
Fin:=Ini + Dim;
end;
@ -3839,9 +3839,9 @@ procedure TCustomGrid.DefineProperties(Filer: TFiler);
Result := True;
for i:=0 to L1.Count-1 do begin
if IsColumn then
Result := Integer(L1[i]) = DefaultColWidth
Result := PtrInt(L1[i]) = DefaultColWidth
else
Result := Integer(L1[i]) = DefaultRowHeight;
Result := PtrInt(L1[i]) = DefaultRowHeight;
if not Result then break;
end;
end;
@ -4978,7 +4978,7 @@ begin
j:=0;
For i:=0 to ColCount-1 do begin
k:=Integer(FCols[i]);
k:=PtrInt(FCols[i]);
if (k>=0)and(k<>DefaultColWidth) then begin
inc(j);
cfg.SetValue('grid/design/columns/columncount',j);
@ -4988,7 +4988,7 @@ begin
end;
j:=0;
For i:=0 to RowCount-1 do begin
k:=Integer(FRows[i]);
k:=PtrInt(FRows[i]);
if (k>=0)and(k<>DefaultRowHeight) then begin
inc(j);
cfg.SetValue('grid/design/rows/rowcount',j);

5
lcl/include/application.inc
View File

@ -161,7 +161,7 @@ begin
DebugLn('WARNING: TApplication.MessageBox: no MessageBoxFunction');
DebugLn(' Caption="',Caption,'"');
DebugLn(' Text="',Text,'"');
DebugLn(' Flags=',HexStr(Cardinal(Flags),8));
DebugLn(' Flags=',DbgS(Flags));
Result:=0;
end;
end;
@ -1448,6 +1448,9 @@ end;
{ =============================================================================
$Log$
Revision 1.108 2005/03/07 21:59:44 vincents
changed hexstr(cardinal()) for pointers to dbgs() and other 64-bits fixes from Peter Vreman
Revision 1.107 2005/03/02 15:16:55 mattias
fixed fpc 1.9.9 compilation

27
lcl/include/bitmap.inc
View File

@ -361,7 +361,7 @@ begin
if UseWidth<1 then UseWidth:=1;
if UseHeight<1 then UseHeight:=1;
FImage.FHandle:= CreateBitmap(UseWidth, UseHeight, 1, n, nil);
//DebugLn('TBitMap.HandleNeeded Self=',HexStr(Cardinal(Self),8),' FImage.FHandle=',HexStr(Cardinal(FImage.FHandle),8),' n=',n);
//DebugLn('TBitMap.HandleNeeded Self=',DbgS(Self),' FImage.FHandle=',DbgS(FImage.FHandle),' n=',n);
FImage.FDIB.dsbm.bmWidth := Width;
FImage.FDIB.dsbm.bmHeight := Height;
end;
@ -462,7 +462,7 @@ var
{$ENDIF}
begin
if (FImage.RefCount>1) then begin
//DebugLn('TBitmap.UnshareImage ',ClassName,' ',Width,',',Height,' ',HexStr(Cardinal(Self),8));
//DebugLn('TBitmap.UnshareImage ',ClassName,' ',Width,',',Height,' ',DbgS(Self));
// release old FImage and create a new one
NewImage:=TBitmapImage.Create;
try
@ -486,14 +486,14 @@ begin
FreeCanvasContext;
OldImage:=FImage;
FImage:=NewImage;
//DebugLn('TBitMap.UnshareImage Self=',HexStr(Cardinal(Self),8),' FImage.FHandle=',HexStr(Cardinal(FImage.FHandle),8));
//DebugLn('TBitMap.UnshareImage Self=',DbgS(Self),' FImage.FHandle=',DbgS(FImage.FHandle));
NewImage:=nil; // transaction sucessful
OldImage.Release;
finally
// in case something goes wrong, keep old and free new
NewImage.Free;
end;
//DebugLn('TBitmap.UnshareImage END ',ClassName,' ',Width,',',Height,' ',HexStr(Cardinal(Self),8));
//DebugLn('TBitmap.UnshareImage END ',ClassName,' ',Width,',',Height,' ',DbgS(Self));
end;
end;
@ -1024,7 +1024,7 @@ var
IntfImg: TLazIntfImage;
ImgWriter: TFPCustomImageWriter;
begin
//DebugLn('WriteStreamWithFPImage Self=',HexStr(Cardinal(Self),8),' ',Width,',',Height,' Using SaveStream=',(FImage.SaveStream<>nil) and (FImage.SaveStream.Size>0));
//DebugLn('WriteStreamWithFPImage Self=',DbgS(Self),' ',Width,',',Height,' Using SaveStream=',(FImage.SaveStream<>nil) and (FImage.SaveStream.Size>0));
if (FImage.SaveStream<>nil) and (FImage.SaveStream.Size>0) then begin
DoWriteOriginal;
exit;
@ -1098,7 +1098,7 @@ begin
FImage.FreeHandle;
// get the properties from new bitmap
FImage.FHandle:=Value;
//DebugLn('TBitMap.SetHandle Self=',HexStr(Cardinal(Self),8),' FImage.FHandle=',HexStr(Cardinal(FImage.FHandle),8));
//DebugLn('TBitMap.SetHandle Self=',DbgS(Self),' FImage.FHandle=',DbgS(FImage.FHandle));
FillChar(FImage.FDIB, SizeOf(FImage.FDIB), 0);
if FImage.FHandle <> 0 then
GetObject(FImage.FHandle, SizeOf(FImage.FDIB), @FImage.FDIB);
@ -1119,16 +1119,16 @@ begin
FImage.FreeMaskHandle;
// combine (depending on the interface we will end with one or two handles)
{$IFDEF VerboseImgMasks}
DebugLn('TBitmap.SetMaskHandle Before Replace FImage.FHandle=',HexStr(Cardinal(FImage.FHandle),8),
' FImage.FMaskHandle=',HexStr(Cardinal(FImage.FMaskHandle),8),
' NewMaskHandle=',HexStr(Cardinal(NewMaskHandle),8));
DebugLn('TBitmap.SetMaskHandle Before Replace FImage.FHandle=',DbgS(FImage.FHandle),
' FImage.FMaskHandle=',DbgS(FImage.FMaskHandle),
' NewMaskHandle=',DbgS(NewMaskHandle));
{$ENDIF}
ReplaceBitmapMask(FImage.FHandle,FImage.FMaskHandle,NewMaskHandle);
FTransparent := FImage.FMaskHandle <> 0;
{$IFDEF VerboseImgMasks}
DebugLn('TBitmap.SetMaskHandle After Replace FImage.FHandle=',HexStr(Cardinal(FImage.FHandle),8),
' FImage.FMaskHandle=',HexStr(Cardinal(FImage.FMaskHandle),8),
' NewMaskHandle=',HexStr(Cardinal(NewMaskHandle),8));
DebugLn('TBitmap.SetMaskHandle After Replace FImage.FHandle=',DbgS(FImage.FHandle),
' FImage.FMaskHandle=',DbgS(FImage.FMaskHandle),
' NewMaskHandle=',DbgS(NewMaskHandle));
{$ENDIF}
Changed(Self);
end;
@ -1278,6 +1278,9 @@ end;
{ =============================================================================
$Log$
Revision 1.96 2005/03/07 21:59:44 vincents
changed hexstr(cardinal()) for pointers to dbgs() and other 64-bits fixes from Peter Vreman
Revision 1.95 2005/01/18 22:26:10 mattias
added workaround for bug 3574

9
lcl/include/bitmapcanvas.inc
View File

@ -63,8 +63,8 @@ begin
end;
Handle := DC;
//DebugLn('TBitmapCanvas.CreateHandle END Self=',HexStr(Cardinal(Self),8),' DC=',HexStr(Cardinal(DC),8),
// ' Handle=',HexStr(Cardinal(GetUpdatedHandle([csHandleValid])),8));
//DebugLn('TBitmapCanvas.CreateHandle END Self=',DbgS(Self),' DC=',DbgS(DC),
// ' Handle=',DbgS(GetUpdatedHandle([csHandleValid])));
end;
procedure TBitmapCanvas.DeselectHandles;
@ -109,7 +109,7 @@ var
OldHandle: HBITMAP;
begin
if not HandleAllocated then exit;
//DebugLn('TBitmapCanvas.FreeDC START Self=',HexStr(Cardinal(Self),8),' FBitmap=',HexStr(Cardinal(FBitmap),8));
//DebugLn('TBitmapCanvas.FreeDC START Self=',DbgS(Self),' FBitmap=',DbgS(FBitmap));
if FBitmap<>nil then begin
OldHandle := FHandle;
Handle := 0;
@ -124,6 +124,9 @@ end;
{ =============================================================================
$Log$
Revision 1.14 2005/03/07 21:59:44 vincents
changed hexstr(cardinal()) for pointers to dbgs() and other 64-bits fixes from Peter Vreman
Revision 1.13 2004/10/01 13:16:44 mattias
fixed unselecting TCanvas objects

21
lcl/include/canvas.inc
View File

@ -125,10 +125,10 @@ end;
procedure TCanvas.CreateBrush;
var OldHandle: HBRUSH;
begin
//DebugLn('[TCanvas.CreateBrush] ',Classname,' Self=',HexStr(Cardinal(Self),8)
// ,' Brush=',HexStr(Cardinal(Pointer(Brush)),8));
//DebugLn('[TCanvas.CreateBrush] ',Classname,' Self=',DbgS(Self)
// ,' Brush=',DbgS(Brush));
OldHandle:=SelectObject(FHandle, Brush.Handle);
//debugln('TCanvas.CreateBrush ',ClassName,' Self=',HexStr(Cardinal(Self),8),' OldHandle=',HexStr(Cardinal(OldHandle),8),' NewHandle=',HexStr(Cardinal(Brush.Handle),8),' FSavedBrushHandle=',HexStr(Cardinal(FSavedBrushHandle),8));
//debugln('TCanvas.CreateBrush ',ClassName,' Self=',DbgS(Self),' OldHandle=',DbgS(OldHandle),8),' NewHandle=',DbgS(Brush.Handle),' FSavedBrushHandle=',DbgS(Cardinal(FSavedBrushHandle));
if (OldHandle<>Brush.Handle) and (FSavedBrushHandle=0) then
FSavedBrushHandle:=OldHandle;
Include(FState, csBrushValid);
@ -154,8 +154,8 @@ const PenModes:Array[TPenMode] of Integer =
pmMask, pmNotMask, pmXor, pmNotXor
}
begin
//DebugLn('[TCanvas.CreatePen] ',Classname,' Self=',HexStr(Cardinal(Pointer(Self)),8)
// ,' Pen=',HexStr(Cardinal(Pointer(Pen)),8));
//DebugLn('[TCanvas.CreatePen] ',Classname,' Self=',DbgS(Self)
// ,' Pen=',DbgS(Pen));
OldHandle:=SelectObject(FHandle, Pen.Handle);
if (OldHandle<>Pen.Handle) and (FSavedPenHandle=0) then
FSavedPenHandle:=OldHandle;
@ -1298,7 +1298,7 @@ end;
------------------------------------------------------------------------------}
destructor TCanvas.Destroy;
begin
//DebugLn('[TCanvas.Destroy] ',ClassName,' Self=',HexStr(Cardinal(Pointer(Self)),8));
//DebugLn('[TCanvas.Destroy] ',ClassName,' Self=',DbgS(Self));
Handle := 0;
{$IFNDEF UseFPCanvas}
FreeThenNil(FFont);
@ -1341,7 +1341,7 @@ end;
procedure TCanvas.SetHandle(NewHandle: HDC);
begin
if FHandle<>NewHandle then begin
//DebugLn('[TCanvas.SetHandle] Self=',HexStr(Cardinal(Self),8),' Old=',HexStr(FHandle,8),' New=',HexStr(NewHandle,8));
//DebugLn('[TCanvas.SetHandle] Self=',DbgS(Self),' Old=',DbgS(FHandle,8),' New=',DbgS(NewHandle,8));
if FHandle <> 0 then
begin
DeselectHandles;
@ -1353,7 +1353,7 @@ begin
Include(FState, csHandleValid);
FHandle := NewHandle;
end;
//DebugLn('[TCanvas.SetHandle] END Self=',HexStr(Cardinal(Self),8),' Handle=',HexStr(FHandle,8));
//DebugLn('[TCanvas.SetHandle] END Self=',DbgS(Self),' Handle=',DbgS(FHandle,8));
end;
end;
@ -1366,7 +1366,7 @@ end;
------------------------------------------------------------------------------}
procedure TCanvas.DeselectHandles;
begin
//debugln('TCanvas.DeselectHandles ',ClassName,' Self=',HexStr(Cardinal(Self),8),' Handle=',HexStr(Cardinal(FHandle),8),' FSavedBrushHandle=',HexStr(Cardinal(FSavedBrushHandle),8));
//debugln('TCanvas.DeselectHandles ',ClassName,' Self=',DbgS(Self),' Handle=',DbgS(FHandle),8),' FSavedBrushHandle=',DbgS(Cardinal(FSavedBrushHandle));
if (FHandle<>0) then begin
// select default sub handles in the device context without deleting owns
if FSavedBrushHandle<>0 then begin
@ -1535,6 +1535,9 @@ end;
{ =============================================================================
$Log$
Revision 1.92 2005/03/07 21:59:44 vincents
changed hexstr(cardinal()) for pointers to dbgs() and other 64-bits fixes from Peter Vreman
Revision 1.91 2005/03/04 13:50:08 mattias
fixed Arc and changed x,y to Left,Top to make meaning more clear

7
lcl/include/clipbrd.inc
View File

@ -32,14 +32,14 @@ end;
constructor TClipboard.Create(AClipboardType: TClipboardType);
begin
//DebugLn('[TClipboard.Create] A ',ClipboardTypeName[AClipboardType],' Self=',HexStr(Cardinal(Self),8));
//DebugLn('[TClipboard.Create] A ',ClipboardTypeName[AClipboardType],' Self=',DbgS(Self));
inherited Create;
FClipboardType:=AClipboardType;
end;
destructor TClipboard.Destroy;
begin
//DebugLn('[TClipboard.Destroy] A ',ClipboardTypeName[ClipboardType],' Self=',HexStr(Cardinal(Self),8));
//DebugLn('[TClipboard.Destroy] A ',ClipboardTypeName[ClipboardType],' Self=',DbgS(Self));
OnRequest:=nil; // this will notify the owner
if FAllocated then begin
ClipboardGetOwnership(ClipboardType,nil,0,nil);
@ -704,6 +704,9 @@ end;
{
$Log$
Revision 1.21 2005/03/07 21:59:44 vincents
changed hexstr(cardinal()) for pointers to dbgs() and other 64-bits fixes from Peter Vreman
Revision 1.20 2005/01/03 22:44:31 mattias
implemented TControl.AnchorSide

5
lcl/include/control.inc
View File

@ -266,7 +266,7 @@ end;
procedure TControl.SetAction(Value: TBasicAction);
begin
if (Value=Action) then exit;
//debugln('TControl.SetAction A ',Name,':',ClassName,' Old=',HexStr(Cardinal(Action),8),' New=',HexStr(Cardinal(Value),8));
//debugln('TControl.SetAction A ',Name,':',ClassName,' Old=',DbgS(Action),' New=',DbgS(Value));
if Value = nil then begin
ActionLink.Free;
ActionLink:=nil;
@ -3497,6 +3497,9 @@ end;
{ =============================================================================
$Log$
Revision 1.250 2005/03/07 21:59:44 vincents
changed hexstr(cardinal()) for pointers to dbgs() and other 64-bits fixes from Peter Vreman
Revision 1.249 2005/03/07 18:46:36 mattias
fixed unsetting ItemIndex on changing TComboBox.Text

5
lcl/include/controlcanvas.inc
View File

@ -79,7 +79,7 @@ end;
------------------------------------------------------------------------------}
procedure TControlCanvas.CreateHandle;
begin
//DebugLn('[TControlCanvas.CreateHandle] ',FControl<>nil,' DC=',HexStr(FDeviceContext,8),' WinHandle=',HexStr(FWindowHandle,8));
//DebugLn('[TControlCanvas.CreateHandle] ',FControl<>nil,' DC=',DbgS(FDeviceContext,8),' WinHandle=',DbgS(FWindowHandle,8));
if FControl = nil
then inherited CreateHandle
else begin
@ -113,6 +113,9 @@ end;
{ =============================================================================
$Log$
Revision 1.9 2005/03/07 21:59:44 vincents
changed hexstr(cardinal()) for pointers to dbgs() and other 64-bits fixes from Peter Vreman
Revision 1.8 2004/07/15 10:43:38 mattias
added TCustomButton, TCustomBitBtn, TCustomSpeedButton

5
lcl/include/customform.inc
View File

@ -728,7 +728,7 @@ begin
// FCanvas.Lock;
try
FCanvas.Handle := DC;
//DebugLn('[TCustomForm.PaintWindow] ',ClassName,' DC=',HexStr(DC,8),' ',HexStr(FCanvas.Handle,8));
//DebugLn('[TCustomForm.PaintWindow] ',ClassName,' DC=',DbgS(DC,8),' ',DbgS(FCanvas.Handle,8));
try
if FDesigner <> nil then FDesigner.PaintGrid else Paint;
finally
@ -1897,6 +1897,9 @@ end;
{ =============================================================================
$Log$
Revision 1.179 2005/03/07 21:59:44 vincents
changed hexstr(cardinal()) for pointers to dbgs() and other 64-bits fixes from Peter Vreman
Revision 1.178 2005/03/04 13:50:08 mattias
fixed Arc and changed x,y to Left,Top to make meaning more clear

2
lcl/include/dragobject.inc
View File

@ -100,7 +100,7 @@ end;
destructor TDragObject.Destroy;
begin
{$IFDEF VerboseDrag}
DebugLn('TDragObject.Destroy ',ClassName,' Self=',HexStr(Cardinal(Self),8));
DebugLn('TDragObject.Destroy ',ClassName,' Self=',DbgS(Self));
{$ENDIF}
inherited Destroy;
end;

5
lcl/include/font.inc
View File

@ -30,7 +30,7 @@ type
function CompareLogFontAndNameWithResDesc(Key: PLogFontAndName; Desc: TFontHandleCacheDescriptor): integer;
begin
Result:=CompareStr(Key^.LongFontName,Desc.LongFontName);
//writeln('CompareLogFontAndNameWithResDesc A ',Key^.LongFontName,' ',Desc.LongFontName,' ',HexStr(Cardinal(Desc),8),' Result=',Result);
//writeln('CompareLogFontAndNameWithResDesc A ',Key^.LongFontName,' ',Desc.LongFontName,' ',DbgS(Desc),' Result=',Result);
if Result=0 then
Result:=CompareMemRange(@Key^.LogFont,@Desc.LogFont,SizeOf(Desc.LogFont));
//writeln('CompareLogFontAndNameWithResDesc END Result=',Result);
@ -1098,6 +1098,9 @@ end;
{ =============================================================================
$Log$
Revision 1.30 2005/03/07 21:59:44 vincents
changed hexstr(cardinal()) for pointers to dbgs() and other 64-bits fixes from Peter Vreman
Revision 1.29 2005/03/05 14:44:00 mattias
fixed gtk1 font rotating from C Western

7
lcl/include/imglist.inc
View File

@ -466,7 +466,7 @@ end;
procedure TCustomImageList.GetBitmap(Index: Integer; Image: TBitmap);
begin
if (FCount = 0) or (Image = nil) then Exit;
//DebugLn('TCustomImageList.GetBitmap Index=',Index,' Image=',HexStr(Cardinal(Image),8),' Bitmap=',HexStr(Cardinal(FImageList.Items[Index]),8));
//DebugLn('TCustomImageList.GetBitmap Index=',Index,' Image=',DbgS(Image),' Bitmap=',DbgS(FImageList.Items[Index]));
Image.Assign(TBitMap(FImageList.Items[Index]));
end;
@ -899,7 +899,7 @@ var
false)
then
raise EInvalidGraphicOperation.Create('TCustomImageList.CreateImagesFromRawImage Create bitmaps');
//DebugLn('CreateImagesFromRawImage A ',HexStr(Cardinal(SubRawImage.Data),8),' ',SubRawImage.DataSize);
//DebugLn('CreateImagesFromRawImage A ',DbgS(SubRawImage.Data),' ',SubRawImage.DataSize);
FreeRawImageData(@SubRawImage);
Img := TBitmap.Create;
Img.Handle:=ImgHandle;
@ -1262,6 +1262,9 @@ end;
{
$Log$
Revision 1.41 2005/03/07 21:59:44 vincents
changed hexstr(cardinal()) for pointers to dbgs() and other 64-bits fixes from Peter Vreman
Revision 1.40 2004/08/15 17:00:58 mattias
improved DefineProperties to read/write endian independent

5
lcl/include/intfbaselcl.inc
View File

@ -105,7 +105,7 @@ var
Clip: hRGN;
begin
// If the interface has a better way to check a region it can override this
//debugln('TWidgetSet.DCClipRegionValid DC=',HexStr(Cardinal(DC),8));
//debugln('TWidgetSet.DCClipRegionValid DC=',DbgS(DC));
Clip:=CreateEmptyRegion;
Result:=GetClipRGN(DC,Clip)>=0;
DeleteObject(Clip);
@ -633,6 +633,9 @@ end;
{ =============================================================================
$Log$
Revision 1.33 2005/03/07 21:59:44 vincents
changed hexstr(cardinal()) for pointers to dbgs() and other 64-bits fixes from Peter Vreman
Revision 1.32 2005/01/16 11:40:10 mattias
fixed TGtkWidgetSet.ExtSelectClipRGN for DCOrigin

13
lcl/include/intfbasewinapi.inc
View File

@ -294,7 +294,7 @@ var
exit;
If Breaks.IndexOf(Pointer(PtrInt(Index))) >= Breaks.Count - 1 then
exit;
Result := Longint(Breaks[Breaks.IndexOf(Pointer(PtrInt(Index))) + 1]);
Result := Ptrint(Breaks[Breaks.IndexOf(Pointer(PtrInt(Index))) + 1]);
end;
Function GetBreakablePoints(const Source : String) : TList;
@ -680,7 +680,7 @@ var
RRGN : hRGN;
begin
If DCClipRegionValid(DC) then begin
//DebugLn('TWidgetSet.ExcludeClipRect A DC=',HexStr(Cardinal(DC),8),' Rect=',Left,',',Top,',',Right,',',Bottom);
//DebugLn('TWidgetSet.ExcludeClipRect A DC=',DbgS(DC),' Rect=',Left,',',Top,',',Right,',',Bottom);
// create the rectangle region, that should be excluded
RRGN := CreateRectRgn(Left,Top,Right,Bottom);
Result := ExtSelectClipRGN(DC, RRGN, RGN_DIFF);
@ -703,8 +703,8 @@ begin
OldC := CreateEmptyRegion;
GetClipRGN(DC, OldC);
Clip := CreateEmptyRegion;
//DebugLn('TWidgetSet.ExtSelectClipRGN A OldC=',HexStr(Cardinal(OldC),8),
// ' Clip=',HexStr(Cardinal(Clip),8),' RGn=',HexStr(Cardinal(RGN),8),' Mode=',dbgs(Mode));
//DebugLn('TWidgetSet.ExtSelectClipRGN A OldC=',DbgS(OldC),
// ' Clip=',DbgS(Clip),8),' RGn=',DbgS(Cardinal(RGN),' Mode=',dbgs(Mode));
Result := CombineRGN(Clip, OldC, RGN, Mode);
//DebugLn('TWidgetSet.ExtSelectClipRGN B Result=',Result);
If Result <> ERROR then
@ -962,7 +962,7 @@ var
RRGN : hRGN;
begin
RRGN := CreateRectRgn(Left, Top, Right, Bottom);
//DebugLn('TWidgetSet.IntersectClipRect A RGN=',HexStr(Cardinal(RRGN),8),
//DebugLn('TWidgetSet.IntersectClipRect A RGN=',DbgS(RRGN),
// ' ',dbgs(Left),',',dbgs(Top),',',dbgs(Right),',',dbgs(Bottom));
If not DCClipRegionValid(DC) then
Result := SelectClipRGN(DC, RRGN)
@ -1426,6 +1426,9 @@ end;
{ =============================================================================
$Log$
Revision 1.22 2005/03/07 21:59:44 vincents
changed hexstr(cardinal()) for pointers to dbgs() and other 64-bits fixes from Peter Vreman
Revision 1.21 2005/03/04 13:50:09 mattias
fixed Arc and changed x,y to Left,Top to make meaning more clear

5
lcl/include/toolbutton.inc
View File

@ -164,7 +164,7 @@ var
ImgList: TCustomImageList;
ImgIndex: integer;
begin
//DebugLn('TToolButton.Paint A ',Name,' FToolBar=',HexStr(Cardinal(FToolBar),8),' ',ClientWidth,',',ClientHeight,' ',ord(Style));
//DebugLn('TToolButton.Paint A ',Name,' FToolBar=',DbgS(FToolBar),' ',ClientWidth,',',ClientHeight,' ',ord(Style));
if (FToolBar<>nil) and (ClientWidth>0) and (ClientHeight>0) then begin
PaintRect:=ClientRect; // the whole paint area
@ -737,6 +737,9 @@ end;
{
$Log$
Revision 1.24 2005/03/07 21:59:44 vincents
changed hexstr(cardinal()) for pointers to dbgs() and other 64-bits fixes from Peter Vreman
Revision 1.23 2004/11/28 00:55:44 mattias
deactivated sending SYSKey messages in gtk intf - they are not used anyway

37
lcl/include/treeview.inc
View File

@ -194,7 +194,7 @@ end;
destructor TTreeNode.Destroy;
begin
{$IFDEF TREEVIEW_DEBUG}
DebugLn('[TTreeNode.Destroy] Self=',HexStr(Cardinal(Self),8),' Self.Text=',Text);
DebugLn('[TTreeNode.Destroy] Self=',DbgS(Self),' Self.Text=',Text);
{$ENDIF}
FDeleting := True;
// delete childs
@ -400,7 +400,7 @@ end;
procedure TTreeNode.DoExpand(ExpandIt: Boolean);
begin
//DebugLn('[TTreeNode.DoExpand] Self=',HexStr(Cardinal(Self),8),' Text=',Text,
//DebugLn('[TTreeNode.DoExpand] Self=',DbgS(Self),' Text=',Text,
//' HasChildren=',HasChildren,' ExpandIt=',ExpandIt,' Expanded=',Expanded);
if HasChildren and (Expanded<>ExpandIt) then begin
if (TreeView<>nil) then begin
@ -603,8 +603,7 @@ procedure TTreeNode.SetHasChildren(AValue: Boolean);
//var Item: TTVItem;
begin
if AValue=HasChildren then exit;
//DebugLn('[TTreeNode.SetHasChildren] Self=',HexStr(Cardinal(Self),8),
//' Self.Text=',Text,' AValue=',AValue);
//DebugLn('[TTreeNode.SetHasChildren] Self=',DbgS(Self),' Self.Text=',Text,' AValue=',AValue);
if AValue then
Include(FStates,nsHasChildren)
else begin
@ -932,7 +931,7 @@ var OldIndex, i: integer;
TheTreeView: TCustomTreeView;
begin
{$IFDEF TREEVIEW_DEBUG}
DebugLn('[TTreeNode.Unbind] Self=',HexStr(Cardinal(Self),8),' Self.Text=',Text);
DebugLn('[TTreeNode.Unbind] Self=',DbgS(Self),' Self.Text=',Text);
{$ENDIF}
// remove single select
Selected:=false;
@ -1019,7 +1018,7 @@ var HigherNode: TTreeNode;
NewIndex, NewParentItemSize, i: integer;
begin
{$IFDEF TREEVIEW_DEBUG}
DbgOut('[TTreeNode.InternalMove] Self=',HexStr(Cardinal(Self),8),' Self.Text=',Text
DbgOut('[TTreeNode.InternalMove] Self=',DbgS(Self),' Self.Text=',Text
,' ANode=',ANode<>nil,' AddMode=',AddModeNames[AddMode]);
if ANode<>nil then DbgOut(' ANode.Text=',ANode.Text);
DebugLn('');
@ -1101,7 +1100,7 @@ begin
taInsert:
begin
// insert node in front of ANode
//DebugLn('[TTreeNode.InternalMove] ANode.Index=',ANode.Index,' ANode=',HexStr(Cardinal(ANode),8));
//DebugLn('[TTreeNode.InternalMove] ANode.Index=',ANode.Index,' ANode=',DbgS(ANode));
FNextBrother:=ANode;
FPrevBrother:=ANode.GetPrevSibling;
if Owner<>nil then begin
@ -1118,7 +1117,7 @@ begin
tvsTopsNeedsUpdate,tvsTopItemNeedsUpdate,tvsBottomItemNeedsUpdate];
{$IFDEF TREEVIEW_DEBUG}
DbgOut('[TTreeNode.InternalMove] END Self=',HexStr(Cardinal(Self),8),' Self.Text=',Text
DbgOut('[TTreeNode.InternalMove] END Self=',DbgS(Self),' Self.Text=',Text
,' ANode=',DbgS(ANode<>nil),' AddMode=',AddModeNames[AddMode]);
if ANode<>nil then DbgOut(' ANode.Text=',ANode.Text);
DebugLn('');
@ -3222,27 +3221,27 @@ end;
function TCustomTreeView.IsNodeVisible(ANode: TTreeNode): Boolean;
begin
Result:=(ANode<>nil) and (ANode.AreParentsExpanded);
//DebugLn('[TCustomTreeView.IsNodeVisible] A Node=',HexStr(Cardinal(ANode),8),
//DebugLn('[TCustomTreeView.IsNodeVisible] A Node=',DbgS(ANode),
//' ANode.AreParentsExpanded=',ANode.AreParentsExpanded);
if Result then begin
//DebugLn('[TCustomTreeView.IsNodeVisible] B Node=',HexStr(Cardinal(ANode),8),
//DebugLn('[TCustomTreeView.IsNodeVisible] B Node=',DbgS(ANode),
// ' ',dbgs(FScrolledTop)+'>=',dbgs(ANode.Top+ANode.Height)+' or =',dbgs(FScrolledTop),'+'+dbgs(ClientHeight)+'<',dbgs(ANode.Top));
if (FScrolledTop>=ANode.Top+ANode.Height)
or (FScrolledTop+(ClientHeight-ScrollBarWidth)-2*BorderWidth<ANode.Top)
then
Result:=false;
end;
//DebugLn('[TCustomTreeView.IsNodeVisible] END Node=',HexStr(Cardinal(ANode),8),
//DebugLn('[TCustomTreeView.IsNodeVisible] END Node=',DbgS(ANode),
//' Node.Text=',ANode.Text,' Visible=',Result);
end;
function TCustomTreeView.IsNodeHeightFullVisible(ANode: TTreeNode): Boolean;
begin
Result:=(ANode<>nil) and (ANode.AreParentsExpanded);
//DebugLn('[TCustomTreeView.IsNodeVisible] A Node=',HexStr(Cardinal(ANode),8),
//DebugLn('[TCustomTreeView.IsNodeVisible] A Node=',DbgS(ANode),
//' ANode.AreParentsExpanded=',ANode.AreParentsExpanded);
if Result then begin
//DebugLn('[TCustomTreeView.IsNodeVisible] B Node=',HexStr(Cardinal(ANode),8),
//DebugLn('[TCustomTreeView.IsNodeVisible] B Node=',DbgS(ANode),
//' ',FScrolledTop,'>=',ANode.Top,'+',ANode.Height,' or ',FScrolledTop,'+',ClientHeight,'<',ANode.Top);
if (FScrolledTop>ANode.Top)
or (FScrolledTop+(ClientHeight-ScrollBarWidth)-2*BorderWidth
@ -3250,7 +3249,7 @@ begin
then
Result:=false;
end;
//DebugLn('[TCustomTreeView.IsNodeVisible] END Node=',HexStr(Cardinal(ANode),8),
//DebugLn('[TCustomTreeView.IsNodeVisible] END Node=',DbgS(ANode),
//' Node.Text=',ANode.Text,' Visible=',Result);
end;
@ -3666,12 +3665,12 @@ begin
end;
// draw nodes
Node:=TopItem;
//write('[TCustomTreeView.DoPaint] A Node=',HexStr(Cardinal(Node),8));
//write('[TCustomTreeView.DoPaint] A Node=',DbgS(Node));
//if Node<>nil then DebugLn(' Node.Text=',Node.Text) else DebugLn('');
while Node<>nil do begin
DoPaintNode(Node);
Node:=Node.GetNextVisible;
//write('[TCustomTreeView.DoPaint] B Node=',HexStr(Cardinal(Node),8));
//write('[TCustomTreeView.DoPaint] B Node=',DbgS(Node));
//if Node<>nil then DebugLn(' Node.Text=',Node.Text) else DebugLn('');
end;
// draw insert mark for new root node
@ -3924,7 +3923,7 @@ begin
PaintImages:=true;
end;
VertMid:=(NodeRect.Top+NodeRect.Bottom) shr 1;
//DebugLn('[TCustomTreeView.DoPaintNode] Node=',HexStr(Cardinal(Node),8),' Node.Text=',Node.Text,' NodeRect=',NodeRect.Left,',',NodeRect.Top,',',NodeRect.Right,',',NodeRect.Bottom,' VertMid=',VertMid);
//DebugLn('[TCustomTreeView.DoPaintNode] Node=',DbgS(Node),' Node.Text=',Node.Text,' NodeRect=',NodeRect.Left,',',NodeRect.Top,',',NodeRect.Right,',',NodeRect.Bottom,' VertMid=',VertMid);
with Canvas do begin
// draw background
if (tvoRowSelect in FOptions) and NodeSelected then
@ -4499,8 +4498,8 @@ begin
Include(FStates,tvsTopsNeedsUpdate);
UpdateAllTops;
if OldLastTop<>Items.GetLastSubNode.Top then
RaiseGDBException('OldLastTop='+HexStr(Cardinal(OldLastTop),8)
+'<>Items.GetLastSubNode.Top='+HexStr(Cardinal(Items.GetLastSubNode.Top),8));
RaiseGDBException('OldLastTop='+DbgS(OldLastTop)
+'<>Items.GetLastSubNode.Top='+DbgS(Items.GetLastSubNode.Top));
end;
end;
if not (tvsMaxRightNeedsUpdate in FStates) then begin

17
lcl/include/wincontrol.inc
View File

@ -1661,7 +1661,7 @@ var
ControlsNeedsClipping: boolean;
CurControl: TControl;
begin
//DebugLn('[TWinControl.PaintHandler] ',Name,':',ClassName,' DC=',HexStr(TheMessage.DC,8));
//DebugLn('[TWinControl.PaintHandler] ',Name,':',ClassName,' DC=',DbgS(TheMessage.DC,8));
if (csDestroying in ComponentState) or (not HandleAllocated) then exit;
{$IFDEF VerboseDsgnPaintMsg}
@ -1711,7 +1711,7 @@ begin
if TheMessage.DC = 0 then EndPaint(Handle, PS);
end;
Assert(False, Format('Trace:< [TWinControl.PaintHandler] %s', [ClassName]));
//DebugLn('[TWinControl.PaintHandler] END ',Name,':',ClassName,' DC=',HexStr(Message.DC,8));
//DebugLn('[TWinControl.PaintHandler] END ',Name,':',ClassName,' DC=',DbgS(Message.DC,8));
end;
procedure TWinControl.PaintControls(DC: HDC; First: TControl);
@ -1724,7 +1724,7 @@ var
P: TPoint;
{$ENDIF}
begin
//DebugLn('[TWinControl.PaintControls] ',Name,':',ClassName,' DC=',HexStr(DC,8));
//DebugLn('[TWinControl.PaintControls] ',Name,':',ClassName,' DC=',DbgS(DC,8));
if (csDestroying in ComponentState)
or ((DC=0) and (not HandleAllocated)) then
exit;
@ -1799,14 +1799,14 @@ begin
DeleteObject(FrameBrush);
}
end;
//DebugLn('[TWinControl.PaintControls] END ',Name,':',ClassName,' DC=',HexStr(DC,8));
//DebugLn('[TWinControl.PaintControls] END ',Name,':',ClassName,' DC=',DbgS(DC,8));
end;
procedure TWinControl.PaintWindow(DC: HDC);
var
Message: TLMessage;
begin
//DebugLn('[TWinControl.PaintWindow] ',Name,':',Classname,' DC=',HexStr(DC,8));
//DebugLn('[TWinControl.PaintWindow] ',Name,':',Classname,' DC=',DbgS(DC,8));
if (csDestroying in ComponentState)
or ((DC=0) and (not HandleAllocated)) then
exit;
@ -3299,7 +3299,7 @@ var
PS : TPaintStruct;
ClientBoundRect: TRect;
begin
//DebugLn('[TWinControl.WMPaint] ',Name,':',ClassName,' ',HexStr(Msg.DC,8));
//DebugLn('[TWinControl.WMPaint] ',Name,':',ClassName,' ',DbgS(Msg.DC,8));
if ([csDestroying,csLoading]*ComponentState<>[]) or (not HandleAllocated) then
exit;
@ -4383,7 +4383,7 @@ end;
function TWinControl.GetDeviceContext(var WindowHandle: HWnd): HDC;
begin
Result := GetDC(Handle);
//DebugLn('[TWinControl.GetDeviceContext] ',ClassName,' DC=',HexStr(Cardinal(Result),8),' Handle=',HexStr(Cardinal(FHandle),8));
//DebugLn('[TWinControl.GetDeviceContext] ',ClassName,' DC=',DbgS(Result,8),' Handle=',DbgS(FHandle));
if Result = 0
then raise EOutOfResources.CreateFmt(rsErrorCreatingDeviceContext, [Name,
ClassName]);
@ -4486,6 +4486,9 @@ end;
{ =============================================================================
$Log$
Revision 1.317 2005/03/07 21:59:45 vincents
changed hexstr(cardinal()) for pointers to dbgs() and other 64-bits fixes from Peter Vreman
Revision 1.316 2005/02/26 17:08:41 marc
* Reworked listviews to match new interface

89
lcl/interfaces/gtk/gtkcallback.inc
View File

@ -206,8 +206,8 @@ begin
// set extra signal masks after the widget window is created
// define extra events we're interrested in
//write('GTKRealizeAfterCB ');
//if TheWinControl<>nil then DbgOut(' ',TheWinControl.Name,':',TheWinControl.ClassName,' ',HexStr(Cardinal(TheWinControl.Handle),8));
//DebugLn(' Widget=',HexStr(Cardinal(Widget),8),' Fixed=',HexStr(Cardinal(GetFixedWidget(Widget)),8),' Main=',HexStr(Cardinal(GetMainWidget(Widget)),8));
//if TheWinControl<>nil then DbgOut(' ',TheWinControl.Name,':',TheWinControl.ClassName,' ',DbgS(TheWinControl.Handle));
//DebugLn(' Widget=',DbgS(Widget),' Fixed=',DbgS(GetFixedWidget(Widget)),' Main=',DbgS(GetMainWidget(Widget)));
if (TheWinControl<>nil) then begin
{$IFDEF DebugGDK}BeginGDKErrorTrap;{$ENDIF}
@ -220,7 +220,7 @@ begin
or WinWidgetInfo^.EventMask;
gdk_window_set_events(GetControlWindow(ClientWidget),NewEventMask);
end;
//DebugLn('BBB1 ',HexStr(Cardinal(NewEventMask),8),' ',HexStr(Cardinal(gdk_window_get_events(Widget^.Window)),8));
//DebugLn('BBB1 ',DbgS(NewEventMask),8),' ',DbgS(Cardinal(gdk_window_get_events(Widget^.Window)));
{$IFDEF DebugGDK}EndGDKErrorTrap;{$ENDIF}
end;
@ -396,7 +396,7 @@ begin
end else begin
{$IFDEF VerboseDesignerDraw}
DebugLn('gtkDrawAfter',
' Widget=',HexStr(Cardinal(Widget),8),'=',GetWidgetClassName(Widget),
' Widget=',DbgS(Widget),'=',GetWidgetClassName(Widget),
' ',TComponent(Data).Name,
' ',area^.x,',',area^.y,',',area^.width,',',area^.height,
'');
@ -422,7 +422,7 @@ begin
end else begin
{$IFDEF VerboseDesignerDraw}
DebugLn('gtkExposeAfter',
' Widget=',HexStr(Cardinal(Widget),8),'=',GetWidgetClassName(Widget),
' Widget=',DbgS(Widget),'=',GetWidgetClassName(Widget),
' ',TComponent(Data).Name,
' ',Event^.area.x,',',Event^.area.y,',',Event^.area.width,',',Event^.area.height,
'');
@ -447,7 +447,7 @@ begin
if (Widget=nil) or (Event=nil) then ;
FillChar(Mess,SizeOf(Mess),#0);
{$IFDEF VerboseFocus}
write('gtkfrmactivateAfter Widget=',HexStr(Cardinal(Widget),8),' Event^.theIn=',Event^.theIn);
write('gtkfrmactivateAfter Widget=',DbgS(Widget),' Event^.theIn=',Event^.theIn);
LCLObject:=TObject(data);
if LCLObject<>nil then begin
if LCLObject is TComponent then begin
@ -460,7 +460,7 @@ begin
DebugLn(''); DbgOut(' ');
CurFocusWidget:=PGtkWidget(GetFocus);
if CurFocusWidget<>nil then begin
write(' GetFocus=',HexStr(Cardinal(CurFocusWidget),8));
write(' GetFocus=',DbgS(CurFocusWidget));
LCLObject:=GetNearestLCLObject(CurFocusWidget);
if LCLObject<>nil then begin
if LCLObject is TComponent then begin
@ -500,8 +500,8 @@ begin
EventTrace('deactivate after', data);
if (Widget=nil) or (Event=nil) then ;
{$IFDEF VerboseFocus}
write('gtkfrmdeactivate Widget=',HexStr(Cardinal(Widget),8),' ',Event^.theIn,
' GetFocus=',HexStr(Cardinal(Widget),8));
write('gtkfrmdeactivate Widget=',DbgS(Widget),' ',Event^.theIn,
' GetFocus=',DbgS(Widget));
LCLObject:=TControl(GetLCLObject(Widget));
if LCLObject<>nil then
DebugLn(' LCLObject=',LCLObject.Name,':',LCLObject.ClassName)
@ -546,7 +546,7 @@ begin
EventTrace('focus', data);
if (Widget=nil) or (Event=nil) then ;
{$IFDEF VerboseFocus}
write('GTKFocusCB Widget=',HexStr(Cardinal(Widget),8),' Event^.theIn=',Event^.theIn);
write('GTKFocusCB Widget=',DbgS(Widget),' Event^.theIn=',Event^.theIn);
LCLObject:=TObject(data);
if LCLObject<>nil then begin
if LCLObject is TComponent then begin
@ -559,7 +559,7 @@ begin
DebugLn(''); DbgOut(' ');
CurFocusWidget:=PGtkWidget(GetFocus);
if CurFocusWidget<>nil then begin
write(' GetFocus=',HexStr(Cardinal(CurFocusWidget),8));
write(' GetFocus=',DbgS(CurFocusWidget));
LCLObject:=GetNearestLCLObject(CurFocusWidget);
if LCLObject<>nil then begin
if LCLObject is TComponent then begin
@ -590,7 +590,7 @@ begin
EventTrace('focus', data);
if (Widget=nil) or (Event=nil) then ;
{$IFDEF VerboseFocus}
write('GTKFocusCBAfter Widget=',HexStr(Cardinal(Widget),8),' Event^.theIn=',Event^.theIn);
write('GTKFocusCBAfter Widget=',DbgS(Widget),' Event^.theIn=',Event^.theIn);
LCLObject:=TObject(data);
if LCLObject<>nil then begin
if LCLObject is TComponent then begin
@ -603,7 +603,7 @@ begin
DebugLn(''); DbgOut(' ');
CurFocusWidget:=PGtkWidget(GetFocus);
if CurFocusWidget<>nil then begin
write(' GetFocus=',HexStr(Cardinal(CurFocusWidget),8));
write(' GetFocus=',DbgS(CurFocusWidget));
LCLObject:=GetNearestLCLObject(CurFocusWidget);
if LCLObject<>nil then begin
if LCLObject is TComponent then begin
@ -640,7 +640,7 @@ begin
EventTrace('killfocus', data);
if (Widget=nil) or (Event=nil) then ;
{$IFDEF VerboseFocus}
write('GTKillFocusCB Widget=',HexStr(Cardinal(Widget),8),' Event^.theIn=',Event^.theIn);
write('GTKillFocusCB Widget=',DbgS(Widget),' Event^.theIn=',Event^.theIn);
LCLObject:=TObject(data);
if LCLObject<>nil then begin
if LCLObject is TComponent then begin
@ -653,7 +653,7 @@ begin
DebugLn(''); DbgOut(' ');
CurFocusWidget:=PGtkWidget(GetFocus);
if CurFocusWidget<>nil then begin
write(' GetFocus=',HexStr(Cardinal(CurFocusWidget),8));
write(' GetFocus=',DbgS(CurFocusWidget));
LCLObject:=GetNearestLCLObject(CurFocusWidget);
if LCLObject<>nil then begin
if LCLObject is TComponent then begin
@ -684,7 +684,7 @@ begin
if (Widget=nil) or (Event=nil) then ;
EventTrace('killfocus', data);
{$IFDEF VerboseFocus}
write('GTKillFocusCBAfter Widget=',HexStr(Cardinal(Widget),8),' Event^.theIn=',Event^.theIn);
write('GTKillFocusCBAfter Widget=',DbgS(Widget),' Event^.theIn=',Event^.theIn);
LCLObject:=TObject(data);
if LCLObject<>nil then begin
if LCLObject is TComponent then begin
@ -697,7 +697,7 @@ begin
DebugLn(''); DbgOut(' ');
CurFocusWidget:=PGtkWidget(GetFocus);
if CurFocusWidget<>nil then begin
write(' GetFocus=',HexStr(Cardinal(CurFocusWidget),8));
write(' GetFocus=',DbgS(CurFocusWidget));
LCLObject:=GetNearestLCLObject(CurFocusWidget);
if LCLObject<>nil then begin
if LCLObject is TComponent then begin
@ -875,7 +875,7 @@ begin
DesignOnlySignal:=GetDesignOnlySignalFlag(Widget,dstMouseMotion);
DebugLn('[GTKMotionNotify] ',
DbgSName(TControl(Data)),
' Widget=',HexStr(Cardinal(Widget),8),
' Widget=',DbgS(Widget),
' DSO=',dbgs(DesignOnlySignal),
' Event^.X=',dbgs(TruncToInt(Event^.X)),' Event^.Y=',dbgs(TruncToInt(Event^.Y))
);
@ -1157,20 +1157,20 @@ begin
DesignOnlySignal:=GetDesignOnlySignalFlag(Widget,dstMousePress);
WriteLn('[gtkMouseBtnPress] ',
DbgSName(TObject(Data)),
' Widget=',HexStr(Cardinal(Widget),8),
' ControlWidget='+HexStr(Cardinal(TWinControl(Data).Handle),8),
' Widget=',DbgS(Widget),
' ControlWidget=',DbgS(TWinControl(Data).Handle),
' DSO='+dbgs(DesignOnlySignal),
' '+dbgs(TruncToInt(Event^.X)),',',dbgs(TruncToInt(Event^.Y)),
' Type='+dbgs(gdk_event_get_type(Event)));
{$ENDIF}
//DebugLn('DDD1 MousePress Widget=',HexStr(Cardinal(Widget),8),
//' ClientWidget=',HexStr(Cardinal(GetFixedWidget(Widget)),8),
//' EventMask=',HexStr(Cardinal(gdk_window_get_events(Widget^.Window)),8),
//' GDK_BUTTON_RELEASE_MASK=',HexStr(Cardinal(GDK_BUTTON_RELEASE_MASK),8),
//' Window=',HexStr(Cardinal(Widget^.Window),8)
//DebugLn('DDD1 MousePress Widget=',DbgS(Widget),
//' ClientWidget=',DbgS(GetFixedWidget(Widget)),
//' EventMask=',DbgS(gdk_window_get_events(Widget^.Window)),
//' GDK_BUTTON_RELEASE_MASK=',DbgS(GDK_BUTTON_RELEASE_MASK),
//' Window=',DbgS(Widget^.Window)
//);
//if GetFixedWidget(Widget)<>nil then
// DebugLn('DDD2 ClientWindow=',HexStr(Cardinal(PGtkWidget(GetFixedWidget(Widget))^.Window),8));
// DebugLn('DDD2 ClientWindow=',DbgS(PGtkWidget(GetFixedWidget(Widget))^.Window));
EventTrace('Mouse button Press', data);
@ -1214,7 +1214,7 @@ begin
{$IFDEF VerboseMouseBugfix}
debugln('[gtkMouseBtnPressAfter] ',
DbgSName(TObject(Data)),
' Widget=',HexStr(Cardinal(Widget),8),
' Widget=',DbgS(Widget),
' ',dbgs(TruncToInt(Event^.X)),',',dbgs(TruncToInt(Event^.Y)));
{$ENDIF}
@ -1333,14 +1333,14 @@ begin
{$IFDEF VerboseMouseBugfix}
DesignOnlySignal:=GetDesignOnlySignalFlag(Widget,dstMouseRelease);
DebugLn('[gtkMouseBtnRelease] A ',DbgSName(TObject(Data)),' ',
' Widget=',HexStr(Cardinal(Widget),8),
' Widget=',DbgS(Widget),
' DSO=',dbgs(DesignOnlySignal),
' ',dbgs(TruncToInt(Event^.X)),',',dbgs(TruncToInt(Event^.Y)),' Btn=',dbgs(event^.Button));
{$ENDIF}
//DebugLn('EEE1 MouseRelease Widget=',HexStr(Cardinal(Widget),8),
//' EventMask=',HexStr(Cardinal(gdk_window_get_events(Widget^.Window)),8),
//' GDK_BUTTON_RELEASE_MASK=',HexStr(Cardinal(GDK_BUTTON_RELEASE_MASK),8));
//DebugLn('EEE1 MouseRelease Widget=',DbgS(Widget),
//' EventMask=',DbgS(gdk_window_get_events(Widget^.Window)),
//' GDK_BUTTON_RELEASE_MASK=',DbgS(GDK_BUTTON_RELEASE_MASK));
UpdateMouseCaptureControl;
@ -1377,7 +1377,7 @@ begin
{$IFDEF VerboseMouseBugfix}
DebugLn('[gtkMouseBtnReleaseAfter] ',DbgSName(TObject(Data)),' ',
' Widget=',HexStr(Cardinal(Widget),8),
' Widget=',DbgS(Widget),
' ',dbgs(TruncToInt(Event^.X)),',',dbgs(TruncToInt(Event^.Y)),' Btn=',dbgs(event^.Button));
{$ENDIF}
@ -1602,7 +1602,7 @@ begin
gtk_color_selection_get_current_color(colorsel, @newColor);
TColorDialog(theDialog).Color := TGDKColorToTColor(newcolor);
{$IFDEF VerboseColorDialog}
DebugLn('gtkDialogOKclickedCB ',HexStr(Cardinal(TColorDialog(theDialog).Color),8));
DebugLn('gtkDialogOKclickedCB ',DbgS(TColorDialog(theDialog).Color));
{$ENDIF}
end
else if theDialog is TFontDialog then
@ -1990,7 +1990,7 @@ begin
if not (TObject(Data) is TControl) then begin
// owner is not TControl -> ignore
DebugLn('WARNING: gtksize_allocateCB: Data is not TControl. Data=',
HexStr(Cardinal(Data),8),' ',GetWidgetClassName(Widget));
DbgS(Data),' ',GetWidgetClassName(Widget));
if Data<>nil then
DebugLn(' Data=',TObject(Data).ClassName);
RaiseException('');
@ -2007,8 +2007,8 @@ begin
{$IFDEF VerboseSizeMsg}
DebugLn('gtksize_allocateCB: ',
TControl(Data).Name+':'+TControl(Data).ClassName,
' widget='+HexStr(Cardinal(Widget),8)+WidgetFlagsToString(widget)+
' fixwidget=',HexStr(Cardinal(GetFixedWidget(Widget)),8),
' widget='+DbgS(Widget)+WidgetFlagsToString(widget)+
' fixwidget=',DbgS(GetFixedWidget(Widget)),
' GtkPos=',dbgs(Widget^.allocation.x)+','+dbgs(Widget^.allocation.y),
','+dbgs(Widget^.allocation.width)+'x'+dbgs(Widget^.allocation.width)+
' LCLPos='+dbgs(TControl(Data).Left)+','+dbgs(TControl(Data).Top),
@ -2035,7 +2035,7 @@ begin
{$IFDEF VerboseSizeMsg}
DebugLn('gtksize_allocate_client: ',
TControl(Data).Name,':',TControl(Data).ClassName,
' widget=',HexStr(Cardinal(Widget),8),
' widget=',DbgS(Widget),
' NewSize=',dbgs(Size^.Width),',',dbgs(Size^.Height),
' Allocation='+dbgs(widget^.Allocation.Width)+'x'+dbgs(Widget^.Allocation.Height),
' Requisiton='+dbgs(widget^.Requisition.Width)+'x'+dbgs(Widget^.Requisition.Height)
@ -2051,7 +2051,7 @@ begin
end else begin
// owner is not TWinControl -> ignore
DebugLn('WARNING: gtksize_allocate_client: Data is not TWinControl. Data=',
HexStr(Cardinal(Data),8));
DbgS(Data));
exit;
end;
end;
@ -2077,7 +2077,7 @@ begin
Mess.Msg := LM_NOTIFY;
FillChar(NMHdr,SizeOf(NMHdr),0);
NMHdr.code := TCN_SELCHANGING;
NMHdr.hwndfrom := longint(widget);
NMHdr.hwndfrom := PtrInt(widget);
NMHdr.idfrom := pagenum; //use this to set pageindex to the correct page.
Mess.NMHdr := @NMHdr;
Mess.Result := 0;
@ -2317,13 +2317,13 @@ begin
if (FTimerData=nil) or (FTimerData.IndexOf(Data)<0) then begin
{$IFDEF VerboseTimer}
DebugLn('gtkTimerCB Timer was killed: TimerInfo=',HexStr(Cardinal(TimerInfo),8));
DebugLn('gtkTimerCB Timer was killed: TimerInfo=',DbgS(TimerInfo));
{$ENDIF}
// timer was killed
Result:=GdkFalse; // stop timer
end else begin
{$IFDEF VerboseTimer}
DebugLn('gtkTimerCB Timer Event: TimerInfo=',HexStr(Cardinal(TimerInfo),8));
DebugLn('gtkTimerCB Timer Event: TimerInfo=',DbgS(TimerInfo));
{$ENDIF}
if TimerInfo^.TimerFunc <> nil
then begin
@ -2344,7 +2344,7 @@ begin
if Result=GdkFalse then begin
{$IFDEF VerboseTimer}
DebugLn('gtkTimerCB Timer was STOPPED: TimerInfo=',HexStr(Cardinal(TimerInfo),8));
DebugLn('gtkTimerCB Timer was STOPPED: TimerInfo=',DbgS(TimerInfo));
{$ENDIF}
// timer will be stopped
// -> free timer data, if not already done
@ -2909,7 +2909,7 @@ function ClipboardSelectionLostOwnershipHandler(TargetWidget: PGtkWidget;
var ClipboardType: TClipboardType;
begin
if (Data=nil) or (TargetWidget=nil) then ;
//DebugLn('*** [ClipboardSelectionLostOwnershipHandler] ',hexstr(cardinal(targetwidget),8));
//DebugLn('*** [ClipboardSelectionLostOwnershipHandler] ',DbgS(targetwidget));
for ClipboardType:=Low(TClipboardType) to High(TClipboardType) do
if EventSelection^.Selection=ClipboardTypeAtoms[ClipboardType] then begin
{$IFDEF DEBUG_CLIPBOARD}
@ -2976,6 +2976,9 @@ end;
{ =============================================================================
$Log$
Revision 1.274 2005/03/07 21:59:45 vincents
changed hexstr(cardinal()) for pointers to dbgs() and other 64-bits fixes from Peter Vreman
Revision 1.273 2005/03/04 12:28:11 mattias
fixed gtk2 intf scrollbar handling from Danny Milosavljevic

7
lcl/interfaces/gtk/gtkdef.pp
View File

@ -419,7 +419,7 @@ end;
procedure TGDIObjectMemManager.DisposeGDIObject(AGDIObject: PGDIObject);
begin
//DebugLn('TGDIObjectMemManager.DisposeGDIObject ',HexStr(Cardinal(AGDIObject),8));
//DebugLn('TGDIObjectMemManager.DisposeGDIObject ',DbgS(AGDIObject));
if AGDIObject^.RefCount>0 then
RaiseGDBException('');
if (FFreeCount<FMinFree) or (FFreeCount<((FCount shr 3)*FMaxFreeRatio)) then
@ -456,7 +456,7 @@ begin
end;
FillChar(Result^, SizeOf(TGDIObject), 0);
inc(FCount);
//DebugLn('TGDIObjectMemManager.NewGDIObject ',HexStr(Cardinal(Result),8));
//DebugLn('TGDIObjectMemManager.NewGDIObject ',DbgS(Result));
end;
@ -582,6 +582,9 @@ end.
{ =============================================================================
$Log$
Revision 1.66 2005/03/07 21:59:45 vincents
changed hexstr(cardinal()) for pointers to dbgs() and other 64-bits fixes from Peter Vreman
Revision 1.65 2005/03/04 12:21:55 mattias
fixed TShape FPCanvas issue

6
lcl/interfaces/gtk/gtkfontcache.pas
View File

@ -106,7 +106,7 @@ begin
+' Width='+dbgs(LogFont.lfWidth)
+#13#10;
for i:=0 to SizeOf(LogFont)-1 do
Result:=Result+hexstr(ord(PChar(@LogFont)[i]),2);
Result:=Result+HexStr(ord(PChar(@LogFont)[i]),2);
Result:=Result+#13#10;
end;
@ -123,7 +123,7 @@ function CompareLogFontAndNameWithResDesc(Key: PLogFontAndName;
Desc: TGdkFontCacheDescriptor): integer;
begin
Result:=CompareStr(Key^.LongFontName,Desc.LongFontName);
//debugln('CompareLogFontAndNameWithResDesc A ',Key^.LongFontName,' ',Desc.LongFontName,' ',HexStr(Cardinal(Desc),8),' Result=',Result);
//debugln('CompareLogFontAndNameWithResDesc A ',Key^.LongFontName,' ',Desc.LongFontName,' ',DbgS(Desc),' Result=',Result);
if Result=0 then
Result:=CompareMemRange(@Key^.LogFont,@Desc.LogFont,SizeOf(Desc.LogFont));
//debugln('CompareLogFontAndNameWithResDesc END Result=',Result);
@ -275,7 +275,7 @@ end;
procedure TGdkFontCacheItem.WarnReferenceHigh;
begin
inherited WarnReferenceHigh;
debugln(' GdkFont='+HexStr(Cardinal(GdkFont),8));
debugln(' GdkFont='+DbgS(GdkFont));
if FirstDescriptor<>nil then
debugln(' '+TGdkFontCacheDescriptor(FirstDescriptor).LongFontName
+' '+LogFontToString(TGdkFontCacheDescriptor(FirstDescriptor).LogFont));

21
lcl/interfaces/gtk/gtklistsl.inc
View File

@ -100,8 +100,8 @@ begin
DC:=GetDC(HWnd(Widget));
ItemState:=State;
end;
//DebugLn('gtkListItemDrawCB A LCLList=',HexStr(Cardinal(LCLList),8),' Widget=',HexStr(Cardinal(Widget),8),' ',HexStr(Cardinal(Data),8));
//DebugLn('gtkListItemDrawCB B ',LCLList.ClassName,' ',HexStr(Cardinal(LCLList.Owner),8));
//DebugLn('gtkListItemDrawCB A LCLList=',DbgS(LCLList),' Widget=',DbgS(Widget),' ',DbgS(Data));
//DebugLn('gtkListItemDrawCB B ',LCLList.ClassName,' ',DbgS(LCLList.Owner);
//DebugLn('gtkListItemDrawCB C ',LCLList.Owner.ClassName);
Result := DeliverMessage(LCLList.Owner, Msg)=0;
ReleaseDC(HWnd(Widget),Msg.DrawListItemStruct^.DC);
@ -143,7 +143,7 @@ begin
'TGtkListStringList.Create Unspecified owner');
FOwner:=TheOwner;
FWithCheckBox := AWithCheckBox;
//DebugLn('TGtkListStringList.Create Self=',HexStr(Cardinal(Self),8),' List=',HexStr(Cardinal(List),8),' Owner=',HexStr(Cardinal(Owner),8));
//DebugLn('TGtkListStringList.Create Self=',DbgS(Self),' List=',DbgS(List),' Owner=',DbgS(Owner));
Include(FStates,glsItemCacheNeedsUpdate);
ConnectAllCallbacks;
{$IFDEF CheckGtkList}
@ -159,7 +159,7 @@ begin
FCachedItems:=nil;
FCachedCount:=0;
FCachedCapacity:=0;
//DebugLn('TGtkListStringList.Destroy Self=',HexStr(Cardinal(Self),8),' List=',HexStr(Cardinal(FGtkList),8),' Owner=',HexStr(Cardinal(Owner),8));
//DebugLn('TGtkListStringList.Destroy Self=',DbgS(Self),' List=',DbgS(FGtkList),' Owner=',DbgS(Owner));
inherited Destroy;
end;
@ -204,10 +204,10 @@ procedure TGtkListStringList.ConnectItemCallbacks(Li: PGtkListItem);
begin
gtk_object_set_data(PGtkObject(li),GtkListItemLCLListTag,Self);
gtk_object_set_data(PGtkObject(li),GtkListItemGtkListTag,FGtkList);
//DebugLn('TGtkListStringList.ConnectItemCallbacks Self=',HexStr(Cardinal(Self),8),
//' GtkList=',HexStr(Cardinal(FGtkList),8),
//' Owner=',HexStr(Cardinal(Owner),8),'=',Owner.ClassName,
//' LI=',HexStr(Cardinal(LI),8),
//DebugLn('TGtkListStringList.ConnectItemCallbacks Self=',DbgS(Self),
//' GtkList=',DbgS(FGtkList),
//' Owner=',DbgS(Owner),'=',Owner.ClassName,
//' LI=',DbgS(LI),
//' ');
{$ifdef GTK2}
g_signal_connect_after(G_OBJECT(li), 'expose_event',
@ -438,7 +438,7 @@ begin
then
RaiseException('TGtkListStringList.Assign: There 2 lists with the same FGtkList');
BeginUpdate;
//DebugLn('[TGtkListStringList.Assign] A ',Source.Classname,' Self=',HexStr(Cardinal(Self),8),' Source=',HexStr(Cardinal(Source),8));
//DebugLn('[TGtkListStringList.Assign] A ',Source.Classname,' Self=',DbgS(Self),' Source=',DbgS(Source));
try
if Source is TStrings then begin
// clearing and resetting can change other properties of the widget,
@ -964,6 +964,9 @@ end;
{ =============================================================================
$Log$
Revision 1.29 2005/03/07 21:59:45 vincents
changed hexstr(cardinal()) for pointers to dbgs() and other 64-bits fixes from Peter Vreman
Revision 1.28 2005/02/05 16:09:52 marc
* first 64bit changes

93
lcl/interfaces/gtk/gtkobject.inc
View File

@ -325,7 +325,7 @@ begin
HashItem:=FDeviceContexts.FirstHashItem;
while (n<7) and (HashItem<>nil) do
begin
DbgOut(' ',HexStr(Cardinal(HashItem^.Item),8));
DbgOut(' ',DbgS(HashItem^.Item));
HashItem:=HashItem^.Next;
inc(n);
end;
@ -345,7 +345,7 @@ begin
while (HashItem <> nil) do
begin
if n < 7
then DbgOut(' ',HexStr(Cardinal(HashItem^.Item),8));
then DbgOut(' ',DbgS(HashItem^.Item));
Inc(GDITypeCount[PGdiObject(HashItem^.Item)^.GDIType]);
HashItem := HashItem^.Next;
@ -597,11 +597,11 @@ begin
ParentTransientWindow^.Component.Name,':',
ParentTransientWindow^.Component.ClassName,
' Index=',ParentTransientWindow^.SortIndex,
' Wnd=',HexStr(Cardinal(ParentTransientWindow^.GtkWindow),8),
' Wnd=',DbgS(ParentTransientWindow^.GtkWindow),
' Child=',ATransientWindow^.Component.Name,':',
ATransientWindow^.Component.ClassName,
' Index=',ATransientWindow^.SortIndex,
' Wnd=',HexStr(Cardinal(ATransientWindow^.GtkWindow),8),
' Wnd=',DbgS(ATransientWindow^.GtkWindow),
'');
{$ENDIF}
ATransientWindow^.TransientParent:=ParentTransientWindow^.GtkWindow;
@ -621,11 +621,11 @@ begin
if (OldTransientParent<>ATransientWindow^.TransientParent) then begin
{$IFDEF VerboseTransient}
DebugLn('Break old TRANSIENT i=',i,'/',AllWindows.Count,
' OldTransientParent=',HexStr(Cardinal(OldTransientParent),8),
' OldTransientParent=',DbgS(OldTransientParent),
' Child=',ATransientWindow^.Component.Name,':',
ATransientWindow^.Component.ClassName,
' Index=',ATransientWindow^.SortIndex,
' Wnd=',HexStr(Cardinal(ATransientWindow^.GtkWindow),8),
' Wnd=',DbgS(ATransientWindow^.GtkWindow),
'');
{$ENDIF}
gtk_window_set_transient_for(ATransientWindow^.GtkWindow,nil);
@ -641,8 +641,8 @@ begin
' Child=',ATransientWindow^.Component.Name,':',
ATransientWindow^.Component.ClassName,
' Index=',ATransientWindow^.SortIndex,
' Wnd=',HexStr(Cardinal(ATransientWindow^.GtkWindow),8),
' Parent=',HexStr(Cardinal(ATransientWindow^.TransientParent),8),
' Wnd=',DbgS(ATransientWindow^.GtkWindow),
' Parent=',DbgS(ATransientWindow^.TransientParent),
'');
{$ENDIF}
gtk_window_set_transient_for(ATransientWindow^.GtkWindow,
@ -671,7 +671,7 @@ var
{$ENDIF}
begin
{$IFDEF VerboseTransient}
DbgOut('TGtkWidgetSet.UntransientWindow ',HexStr(Cardinal(GtkWindow),8));
DbgOut('TGtkWidgetSet.UntransientWindow ',DbgS(GtkWindow));
LCLObject:=GetLCLObject(PGtkWidget(GtkWindow));
if LCLObject<>nil then
DbgOut(' LCLObject=',LCLObject.ClassName)
@ -719,7 +719,7 @@ procedure TGtkWidgetSet.SendCachedLCLMessages;
procedure RaiseWidgetWithoutControl;
begin
RaiseException('ERROR: TGtkWidgetSet.SendCachedLCLMessages Widget '
+HexStr(Cardinal(Widget),8)+' without LCL control');
+DbgS(Widget)+' without LCL control');
end;
procedure WriteWarningParentWidgetNotFound;
@ -728,7 +728,7 @@ procedure TGtkWidgetSet.SendCachedLCLMessages;
,'Parent''s Fixed Widget not found');
DebugLn(' Control=',LCLControl.Name,':',LCLControl.ClassName,
' Parent=',LCLControl.Parent.Name,':',LCLControl.Parent.ClassName,
' ParentWidget=',HexStr(Cardinal(ParentWidget),8),
' ParentWidget=',DbgS(ParentWidget),
'');
end;
@ -1119,13 +1119,13 @@ begin
{$IFDEF VerboseSizeMsg}
LCLObject:=GetNearestLCLObject(Widget);
DbgOut('TGtkWidgetSet.RealizeWidgetSize Widget='+HexStr(Cardinal(Widget),8)+WidgetFlagsToString(Widget)+
DbgOut('TGtkWidgetSet.RealizeWidgetSize Widget='+DbgS(Widget)+WidgetFlagsToString(Widget)+
' New='+dbgs(NewWidth)+','+dbgs(NewHeight));
if (LCLObject<>nil) and (LCLObject is TControl) then begin
with TControl(LCLObject) do
DebugLn(' LCL=',Name,':',ClassName,' ',dbgs(Left),',',dbgs(Top),',',dbgs(Width),',',dbgs(Height));
end else begin
DebugLn(' LCL=',HexStr(Cardinal(LCLObject),8));
DebugLn(' LCL=',DbgS(LCLObject));
end;
{$ENDIF}
@ -1234,7 +1234,7 @@ var
gdk_window_get_origin(PaintWindow,@Left,@Top);
DebugLn('SendInternalPaintMessage ',
AWinControl.Name,':',AWinControl.ClassName,
' InternalWindow=',HexStr(Cardinal(PaintWindow),8),
' InternalWindow=',DbgS(PaintWindow),
' ',Left,',',Top,',',Width,',',Height,
' visible=',gdk_window_is_visible(PaintWindow),
' viewable=',gdk_window_is_viewable(PaintWindow),
@ -1342,10 +1342,10 @@ begin
end;
{DebugLn('TGtkWidgetSet.SendPaintMessagesForInternalWidgets START ',
' ',AWinControl.Name,':',AWinControl.ClassName,
' ',HexStr(Cardinal(Context.MainWidget),8),
' ',HexStr(Cardinal(Context.MainWindow),8),
' ',HexStr(Cardinal(Context.ClientWidget),8),
' ',HexStr(Cardinal(Context.ClientWindow),8),
' ',DbgS(Context.MainWidget),
' ',DbgS(Context.MainWindow),
' ',DbgS(Context.ClientWidget),
' ',DbgS(Context.ClientWindow),
'');}
ForAllChilds(Context.MainWidget);
@ -1636,7 +1636,7 @@ begin
if (TimerInfo^.TimerHandle=guint(TimerHandle)) then
begin
{$IFDEF VerboseTimer}
DebugLn('TGtkWidgetSet.KillTimer TimerInfo=',HexStr(Cardinal(TimerInfo),8),' TimerHandle=',TimerHandle,' CurTimerCount=',FTimerData.Count,' OldTimerCount=',FOldTimerData.Count);
DebugLn('TGtkWidgetSet.KillTimer TimerInfo=',DbgS(TimerInfo),' TimerHandle=',TimerHandle,' CurTimerCount=',FTimerData.Count,' OldTimerCount=',FOldTimerData.Count);
{$ENDIF}
gtk_timeout_remove(TimerInfo^.TimerHandle);
FTimerData.Delete(n);
@ -2013,7 +2013,7 @@ begin
{DebugLn('TGtkWidgetSet.InternalGetDIBits A BitSize=',BitSize,
' biSizeImage=',biSizeImage,' biHeight=',biHeight,' biWidth=',biWidth,
' NumScans=',NumScans,' StartScan=',StartScan,
' Bits=',HexStr(Cardinal(Bits),8),' MemSize(Bits)=',MemSize(Bits),
' Bits=',DbgS(Bits),' MemSize(Bits)=',MemSize(Bits),
' biBitCount=',biBitCount);}
If BitSize <= 0 then
BitSize := longint(SizeOf(Byte))
@ -2243,7 +2243,7 @@ begin
// get raw image description
{$IFDEF VerboseRawImage}
DebugLn('TGtkWidgetSet.GetRawImageFromGdkWindow Get Desc GdkWindow=',HexStr(Cardinal(GdkWindow),8));
DebugLn('TGtkWidgetSet.GetRawImageFromGdkWindow Get Desc GdkWindow=',DbgS(GdkWindow));
{$ENDIF}
if not GetWindowRawImageDescription(GdkWindow,@NewRawImage.Description) then
begin
@ -2267,7 +2267,7 @@ begin
{$IFDEF VerboseRawImage}
DebugLn('TGtkWidgetSet.GetRawImageFromGdkWindow get image ',
dbgs(SourceRect.Left),',',dbgs(SourceRect.Top),',',dbgs(SourceRect.Right),',',dbgs(SourceRect.Bottom),
' GDKWindow=',HexStr(Cardinal(GDkWindow),8));
' GDKWindow=',DbgS(GDkWindow));
{$ENDIF}
if (NewRawImage.Description.Width<=0) or (NewRawImage.Description.Height<=0)
then begin
@ -2313,7 +2313,7 @@ begin
for x:=0 to AnImage^.Width-1 do begin
AColor:=gdk_image_get_pixel(AnImage,x,y);
pGuint(NewRawImage.Data)[i]:=AColor;
if (y=5) then DbgOut(' ',HexStr(Cardinal(AColor),8),'@',HexStr(Cardinal(@pGuint(NewRawImage.Data)[i]),8));
if (y=5) then DbgOut(' ',DbgS(AColor),8),'@',DbgS(Cardinal(@pGuint(NewRawImage.Data)[i]));
inc(i);
end;
end;
@ -2336,7 +2336,7 @@ begin
if MaskBitmap<>nil then begin
// get mask
{$IFDEF VerboseRawImage}
DebugLn('TGtkWidgetSet.GetRawImageFromGdkWindow get mask ',dbgs(SourceRect.Left),',',dbgs(SourceRect.Top),',',dbgs(SourceRect.Right),',',dbgs(SourceRect.Bottom),' MaskBitmap=',HexStr(Cardinal(MaskBitmap),8));
DebugLn('TGtkWidgetSet.GetRawImageFromGdkWindow get mask ',dbgs(SourceRect.Left),',',dbgs(SourceRect.Top),',',dbgs(SourceRect.Right),',',dbgs(SourceRect.Bottom),' MaskBitmap=',DbgS(MaskBitmap));
{$ENDIF}
if not GetRawImageMaskFromGdkBitmap(MaskBitmap,SourceRect,NewRawImage) then
exit;
@ -2475,9 +2475,9 @@ var
begin
{$IFDEF VerboseStretchCopyArea}
DebugLn('ScaleAndROP START DestGC=',HexStr(Cardinal(DestGC),8),
' SrcPixmap=',HexStr(Cardinal(SrcPixmap),8),
' SrcMaskPixmap=',HexStr(Cardinal(SrcMaskPixmap),8));
DebugLn('ScaleAndROP START DestGC=',DbgS(DestGC),
' SrcPixmap=',DbgS(SrcPixmap),
' SrcMaskPixmap=',DbgS(SrcMaskPixmap));
{$ENDIF}
Result := False;
@ -2626,7 +2626,7 @@ var
exit;
end;
{$IFDEF VerboseStretchCopyArea}
DebugLn('SrcDevBitmapToDrawable TempPixmap=',HexStr(Cardinal(TempPixmap),8),' TempMaskPixmap=',HexStr(Cardinal(TempMaskPixmap),8));
DebugLn('SrcDevBitmapToDrawable TempPixmap=',DbgS(TempPixmap),' TempMaskPixmap=',DbgS(TempMaskPixmap));
{$ENDIF}
if TempPixmap<>nil then begin
SrcPixmap:=TempPixmap;
@ -2650,9 +2650,9 @@ var
{$IFDEF VerboseStretchCopyArea}
DebugLn('SrcDevBitmapToDrawable ',
' SrcPixmap=',HexStr(Cardinal(SrcPixmap),8),
' SrcPixmap=',DbgS(SrcPixmap),
' XSrc=',XSrc,' YSrc=',YSrc,' SrcWidth=',SrcWidth,' SrcHeight=',SrcHeight,
' MaskPixmap=',HexStr(Cardinal(MaskPixmap),8),
' MaskPixmap=',DbgS(MaskPixmap),
' XMask=',XMask,' YMask=',YMask,
'');
{$ENDIF}
@ -2831,11 +2831,11 @@ begin
{$IFDEF VerboseStretchCopyArea}
DebugLn('TGtkWidgetSet.StretchCopyArea BEFORE CLIPPING X=',X,' Y=',Y,' Width=',Width,' Height=',Height,
' XSrc=',XSrc,' YSrc=',YSrc,' SrcWidth=',SrcWidth,' SrcHeight=',SrcHeight,
' SrcDrawable=',HexStr(Cardinal(TDeviceContext(SrcDC).Drawable),8),
' SrcDrawable=',DbgS(TDeviceContext(SrcDC).Drawable),
' SrcOrigin=',SrcDCOrigin.X,',',SrcDCOrigin.Y,
' DestDrawable=',HexStr(Cardinal(TDeviceContext(DestDC).Drawable),8),
' DestDrawable=',DbgS(TDeviceContext(DestDC).Drawable),
' DestOrigin=',DestDCOrigin.X,',',DestDCOrigin.Y,
' Mask=',HexStr(Cardinal(Mask),8),' XMask=',XMask,' YMask=',YMask,
' Mask=',DbgS(Mask),' XMask=',XMask,' YMask=',YMask,
' SizeChange=',SizeChange,' ROpIsSpecial=',ROpIsSpecial,
' DestWhole=',DestWholeWidth,',',DestWholeHeight,
' SrcWhole=',SrcWholeWidth,',',SrcWholeHeight,
@ -2920,9 +2920,9 @@ begin
{$IFDEF VerboseStretchCopyArea}
write('TGtkWidgetSet.StretchCopyArea AFTER CLIPPING X=',X,' Y=',Y,' Width=',Width,' Height=',Height,
' XSrc=',XSrc,' YSrc=',YSrc,' SrcWidth=',SrcWidth,' SrcHeight=',SrcHeight,
' SrcDrawable=',HexStr(Cardinal(TDeviceContext(SrcDC).Drawable),8),
' DestDrawable=',HexStr(Cardinal(TDeviceContext(DestDC).Drawable),8),
' Mask=',HexStr(Cardinal(Mask),8),' XMask=',XMask,' YMask=',YMask,
' SrcDrawable=',DbgS(TDeviceContext(SrcDC).Drawable),
' DestDrawable=',DbgS(TDeviceContext(DestDC).Drawable),
' Mask=',DbgS(Mask),' XMask=',XMask,' YMask=',YMask,
' SizeChange=',SizeChange,' ROpIsSpecial=',ROpIsSpecial,
' CopyingWholeSrc=',CopyingWholeSrc);
write(' ROp=');
@ -5872,7 +5872,7 @@ begin
BuildColorRefFromGDKColor(CurrentBackColor);
end;
FDeviceContexts.Add(Result);
//DebugLn('[TGtkWidgetSet.NewDC] ',HexStr(Cardinal(Result),8),' ',FDeviceContexts.Count);
//DebugLn('[TGtkWidgetSet.NewDC] ',DbgS(Result),' ',FDeviceContexts.Count);
// Assert(False, Format('Trace:< [TGtkWidgetSet.NewDC] FDeviceContexts[%d] --> 0x%p', [n, Result]));
end;
@ -5901,7 +5901,7 @@ function TGtkWidgetSet.CreateDCForWidget(TheWidget: PGtkWidget;
procedure RaiseWidgetWithoutClientArea;
begin
RaiseException('TGtkWidgetSet.CreateWindowDC widget '
+HexStr(Cardinal(TheWidget),8)+' has no client area');
+DbgS(TheWidget)+' has no client area');
end;
var
@ -6068,7 +6068,7 @@ begin
Widget^.Window,0,0,Width,Height);
{LCLObject:=GetParentLCLObject(Widget);
DebugLn('TGtkWidgetSet.GetDoubleBufferedDC ',HexStr(Cardinal(Widget),8),'=',GetWidgetClassName(Widget),' ',HexStr(Cardinal(LCLObject),8));
DebugLn('TGtkWidgetSet.GetDoubleBufferedDC ',DbgS(Widget),8),'=',GetWidgetClassName(Widget),' ',DbgS(Cardinal(LCLObject));
if (LCLObject is TPanel)
and (csDesigning in TPanel(LCLObject).ComponentState) then begin
gdk_window_get_origin(Widget^.Window,@x,@y);
@ -6083,7 +6083,7 @@ begin
GTKAPIWidget_ShowCaret(PGTKAPIWidget(MainWidget));
end;
{$IFDEF VerboseDoubleBuffer}
DebugLn('TGtkWidgetSet.GetDoubleBufferedDC DC=',HexStr(Cardinal(Result),8));
DebugLn('TGtkWidgetSet.GetDoubleBufferedDC DC=',DbgS(Result));
{$ENDIF}
end;
@ -6101,7 +6101,7 @@ begin
Result^.GDIType := GDIType;
inc(Result^.RefCount);
FGDIObjects.Add(Result);
//DebugLn('[TGtkWidgetSet.NewGDIObject] ',HexStr(Cardinal(Result),8),' ',FGDIObjects.Count);
//DebugLn('[TGtkWidgetSet.NewGDIObject] ',DbgS(Result),' ',FGDIObjects.Count);
Assert(False, Format('Trace:< [TGtkWidgetSet.NewGDIObject] FGDIObjects --> 0x%p', [Result]));
end;
@ -6134,7 +6134,7 @@ begin
//debugln(' TGtkWidgetSet.CreateDefaultBrush ->');
Result := NewGDIObject(gdiBrush);
{$IFDEF DebugGDIBrush}
debugln('TGtkWidgetSet.CreateDefaultBrush Created: ',HexStr(Cardinal(Result),8));
debugln('TGtkWidgetSet.CreateDefaultBrush Created: ',DbgS(Result));
{$ENDIF}
Result^.GDIBrushFill := GDK_SOLID;
Result^.GDIBrushColor.ColorRef := 0;
@ -6221,7 +6221,7 @@ var
2, @lBearing, @rBearing, @CurWidth,
@tmAscent, @tmDescent);
debugln('UseWidthHeuristic i=',dbgs(i),' lBearing=',dbgs(lBearing),
' rBearing=',dbgs(rBearing),' CurWidth=',dbgs(CurWidth),' ',HexStr(ord(PC^),8));
' rBearing=',dbgs(rBearing),' CurWidth=',dbgs(CurWidth),' ',DbgS(ord(PC^),8));
end;
end;}
@ -6367,7 +6367,7 @@ begin
GObject := NewGDIObject(gdiRegion);
GObject^.GDIRegionObject := gdk_region_new;
Result := HRGN(GObject);
//DebugLn('TGtkWidgetSet.CreateEmptyRgn A RGN=',HexStr(Cardinal(Result),8));
//DebugLn('TGtkWidgetSet.CreateEmptyRgn A RGN=',DbgS(Result));
end;
{------------------------------------------------------------------------------
@ -6443,7 +6443,7 @@ var
begin
{$IFDEF VerboseSizeMsg}
LCLControl:=TWinControl(GetLCLObject(Widget));
DbgOut('PPP TGtkWidgetSet.SetResizeRequest Widget=',HexStr(Cardinal(Widget),8));
DbgOut('PPP TGtkWidgetSet.SetResizeRequest Widget=',DbgS(Widget));
if (LCLControl<>nil) then begin
if LCLControl is TWinControl then
DebugLn(' ',LCLControl.Name,':',LCLControl.ClassName)
@ -6895,6 +6895,9 @@ end;
{ =============================================================================
$Log$
Revision 1.641 2005/03/07 21:59:45 vincents
changed hexstr(cardinal()) for pointers to dbgs() and other 64-bits fixes from Peter Vreman
Revision 1.640 2005/03/07 18:46:36 mattias
fixed unsetting ItemIndex on changing TComboBox.Text

4
lcl/interfaces/gtk/gtkpagecallback.inc
View File

@ -44,7 +44,7 @@ var
ThePage: TPage;
begin
Result := false;
//DebugLn('PageIconWidgetExposeAfter ',HexStr(Cardinal(Widget),8));
//DebugLn('PageIconWidgetExposeAfter ',DbgS(Widget));
EventTrace('PageIconWidgetExposeAfter', Data);
if (Event^.Count > 0) then exit;
ThePage:=TObject(Data) as TPage;
@ -58,7 +58,7 @@ var
ThePage: TPage;
begin
Result := false;
//DebugLn('PageIconWidgetDrawAfter ',HexStr(Cardinal(Widget),8),' ',Area^.x,',',Area^.y);
//DebugLn('PageIconWidgetDrawAfter ',DbgS(Widget),' ',Area^.x,',',Area^.y);
EventTrace('PageIconWidgetDrawAfter', Data);
ThePage:=TObject(Data) as TPage;
DrawNotebookPageIcon(ThePage,Widget);

133
lcl/interfaces/gtk/gtkproc.inc
View File

@ -230,9 +230,9 @@ begin
Color^.blue := gushort(TruncToCardinal(colorArray[2] * $FFFF));
{$IFDEF VerboseColorDialog}
DebugLn('gtk_color_selection_get_current_color ',
' Red=',HexStr(Cardinal(Color^.Red),8),
' Green=',HexStr(Cardinal(Color^.Green),8),
' Blue=',HexStr(Cardinal(Color^.Blue),8),
' Red=',DbgS(Color^.Red),
' Green=',DbgS(Color^.Green),
' Blue=',DbgS(Color^.Blue),
'');
{$ENDIF}
end;
@ -244,9 +244,9 @@ var
begin
{$IFDEF VerboseColorDialog}
DebugLn('gtk_color_selection_set_current_color ',
' Red=',HexStr(Cardinal(Color^.Red),8),
' Green=',HexStr(Cardinal(Color^.Green),8),
' Blue=',HexStr(Cardinal(Color^.Blue),8),
' Red=',DbgS(Color^.Red),
' Green=',DbgS(Color^.Green),
' Blue=',DbgS(Color^.Blue),
'');
{$ENDIF}
GetMem(SelectionColor,4*SizeOf(GDouble));
@ -688,7 +688,7 @@ var
{$endif}
TypeAsStr: String;
begin
Result:=HexStr(Cardinal(AWindow),8);
Result:=DbgS(AWindow);
if AWindow=nil then exit;
// window type
@ -718,7 +718,7 @@ begin
Widget:=PGTKWidget(p);
Result:=Result+'<Widget['+GetWidgetDebugReport(Widget)+']>';
end else begin
Result:=Result+'<UserData='+HexStr(Cardinal(p),8)+']>';
Result:=Result+'<UserData='+DbgS(p)+']>';
end;
end;
@ -745,7 +745,7 @@ begin
else begin
Result:=Result+'FG[N]:='+GdkColorToStr(@AStyle^.fg[GTK_STATE_NORMAL])+' ';
Result:=Result+'BG[N]:='+GdkColorToStr(@AStyle^.bg[GTK_STATE_NORMAL])+' ';
Result:=Result+'BG_Pixmap[N]:='+HexStr(Cardinal(AStyle^.bg_pixmap[GTK_STATE_NORMAL]),8)+' ';
Result:=Result+'BG_Pixmap[N]:='+DbgS(AStyle^.bg_pixmap[GTK_STATE_NORMAL])+' ';
Result:=Result+'rc_style='+GetRCStyleDebugReport(AStyle^.rc_style);
end;
Result:=Result+']';
@ -766,7 +766,7 @@ begin
{$ENDIF GTK1}
Result:=Result+'bg_pixmap_name[N]="'+AStyle^.bg_pixmap_name[GTK_STATE_NORMAL]+'" ';
{$IFDEF GTK1}
Result:=Result+'engine='+HexStr(Cardinal(AStyle^.engine),8);
Result:=Result+'engine='+DbgS(AStyle^.engine);
{$ELSE GTK1}
{$WARNING TODO find GTK2 theme engine}
{$ENDIF GTK1}
@ -913,12 +913,12 @@ end;
------------------------------------------------------------------------------}
procedure SetComboBoxText(ComboWidget: PGtkCombo; NewText: PChar);
begin
//DebugLn('SetComboBoxText ',HexStr(Cardinal(ComboWidget),8),' "',NewText,'"');
//DebugLn('SetComboBoxText ',DbgS(ComboWidget),' "',NewText,'"');
// lock combobox, so that no OnChange event is fired
LockOnChange(PGtkObject(ComboWidget^.entry),+1);
// set text
if NewText = nil then NewText:=#0; // gtk expects at least a #0
//DebugLn('SetComboBoxText A ',HexStr(Cardinal(NewText),8));
//DebugLn('SetComboBoxText A ',DbgS(NewText));
gtk_entry_set_text(PGtkEntry(ComboWidget^.entry), NewText);
// unlock combobox
LockOnChange(PGtkObject(ComboWidget^.entry),-1);
@ -1104,10 +1104,10 @@ var
//ClipMergeMaskWidth, ClipMergeMaskHeight: integer;
begin
{$IFDEF VerboseStretchCopyArea}
DebugLn('MergeClipping START DestinationDC=',HexStr(Cardinal(DestinationDC),8),
' DestinationGC=',HexStr(Cardinal(DestinationGC),8),
DebugLn('MergeClipping START DestinationDC=',DbgS(DestinationDC),
' DestinationGC=',DbgS(DestinationGC),
' X=',X,' Y=',Y,' Width=',Width,' Height=',Height,
' ClipMergeMask=',HexStr(Cardinal(ClipMergeMask),8),
' ClipMergeMask=',DbgS(ClipMergeMask),
' ClipMergeMaskX=',ClipMergeMaskX,' ClipMergeMaskY=',ClipMergeMaskY);
{$ENDIF}
@ -1201,7 +1201,7 @@ var
{$ENDIF}
begin
{$IFDEF VerboseStretchCopyArea}
DebugLn('ScalePixmap ScaleGC=',HexStr(Cardinal(ScaleGC),8),
DebugLn('ScalePixmap ScaleGC=',DbgS(ScaleGC),
' SrcPixmap=[',GetWindowDebugReport(SrcPixmap),']',
' SrcX=',SrcX,' SrcY=',SrcY,' SrcWidth=',SrcWidth,' SrcHeight=',SrcHeight,
' NewPixmap=[',GetWindowDebugReport(NewPixmap),']',
@ -1287,8 +1287,8 @@ begin
// clean up
{$IFDEF VerboseStretchCopyArea}
gdk_window_get_size(PGDKWindow(NewPixmap),@NewWholeWidth,@NewWholeHeight);
DebugLn('ScalePixmap RESULT NewPixmap=',HexStr(Cardinal(NewPixmap),8),
' DummyMask=',HexStr(Cardinal(DummyMask),8),
DebugLn('ScalePixmap RESULT NewPixmap=',DbgS(NewPixmap),
' DummyMask=',DbgS(DummyMask),
' NewWidth=',NewWholeWidth,' NewHeight=',NewWholeHeight,
'');
{$ENDIF}
@ -1540,7 +1540,7 @@ function GDKRegionAsString(RGN: PGDKRegion): string;
var
aRect: TGDKRectangle;
begin
Result:=HexStr(Cardinal(RGN),8);
Result:=DbgS(RGN);
BeginGDKErrorTrap;
gdk_region_get_clipbox(RGN,@aRect);
EndGDKErrorTrap;
@ -1643,10 +1643,10 @@ var
then begin
DebugLn('NOTE: EnsureGCColor.EnsureAsGCValues gdk_colormap_alloc_color failed ',
' Foreground=',
HexStr(Cardinal(Foreground.red),4),',',
HexStr(Cardinal(Foreground.green),4),',',
HexStr(Cardinal(Foreground.blue),4),
' GDIColor^.ColorRef=',HexStr(Cardinal(GDIColor^.ColorRef),8)
DbgS(Foreground.red),',',
DbgS(Foreground.green),',',
DbgS(Foreground.blue),
' GDIColor^.ColorRef=',DbgS(GDIColor^.ColorRef)
);
end;
gdk_gc_set_foreground(GC, @foreground);
@ -1674,7 +1674,7 @@ var
Procedure EnsureAsColor;
begin
AllocGDIColor(DC, GDIColor);
//DebugLn('EnsureAsColor ',HexStr(Cardinal(GDIColor^.ColorRef),8),' AsBackground=',AsBackground);
//DebugLn('EnsureAsColor ',DbgS(GDIColor^.ColorRef),' AsBackground=',AsBackground);
{$IFDEF DebugGDK}BeginGDKErrorTrap;{$ENDIF}
If AsBackground then
gdk_gc_set_background(GC, @(GDIColor^.Color))
@ -3235,7 +3235,7 @@ function DeliverMessage(const Target: Pointer; var AMessage): Integer;
begin
if Target=nil then DebugLn('[DeliverMessage] Target = nil');
{$IFDEF VerboseDeliverMessage}
DebugLn('DeliverMessage ',HexStr(Cardinal(Target),8),
DebugLn('DeliverMessage ',DbgS(Target),
' ',TComponent(Target).Name,':',TObject(Target).ClassName,
' Message=',GetMessageName(TLMessage(AMessage).Msg));
{$ENDIF}
@ -3473,8 +3473,8 @@ Procedure FixedPutControl(Parent, Child : PGTKWidget; Left, Top : Longint);
begin
// this is in a separate procedure for optimisation
DebugLn('[FixedPutControl] WARNING: Invalid Fixed Widget.',
' Parent=',HexStr(Cardinal(Parent),8),
' Child=',HexStr(Cardinal(Child),8)
' Parent=',DbgS(Parent),
' Child=',DbgS(Child)
);
end;
@ -3678,7 +3678,7 @@ begin
Result^.CoreWidget := AWidget;
Result^.Style := AParams.Style;
Result^.ExStyle := AParams.ExStyle;
Result^.WndProc := Integer(AParams.WindowClass.lpfnWndProc);
Result^.WndProc := PtrInt(AParams.WindowClass.lpfnWndProc);
end;
function GetWidgetInfo(const AWidget: Pointer {; const Create: Boolean = False}): PWidgetInfo;
@ -4418,8 +4418,8 @@ end;
function GetDesignSignalMask(Widget: PGtkWidget): TDesignSignalMask;
begin
Result:=TDesignSignalMask(gtk_object_get_data(PGtkObject(Widget),
'LCLDesignMask'));
Result:=TDesignSignalMask(PtrInt(gtk_object_get_data(PGtkObject(Widget),
'LCLDesignMask')));
end;
procedure SetDesignSignalMask(Widget: PGtkWidget; NewMask: TDesignSignalMask);
@ -4512,7 +4512,7 @@ begin
// if we are here, then no handler was defined yet
// -> register handler
//if (Msg=LM_LBUTTONUP) then DebugLn('CONNECT ',ReqSignalMask,' Widget=',HexStr(Cardinal(AnObject),8));
//if (Msg=LM_LBUTTONUP) then DebugLn('CONNECT ',ReqSignalMask,' Widget=',DbgS(AnObject));
//debugln('ConnectSignal ',DbgSName(ALCLObject),' ',ASignal,' After=',dbgs(csfAfter in ASFlags));
if csfAfter in ASFlags then
g_signal_connect_after(AnObject, ASignal,
@ -4623,7 +4623,7 @@ procedure ConnectInternalWidgetsSignals(AWidget: PGtkWidget;
{$ENDIF}
ChildWidget: PGtkWidget;
begin
//if AWinControl is TListView then DebugLn('ConnectChilds A ',HexStr(Cardinal(TheWidget),8));
//if AWinControl is TListView then DebugLn('ConnectChilds A ',DbgS(TheWidget));
if GtkWidgetIsA(TheWidget,GTK_TYPE_CONTAINER) then begin
//if AWinControl is TListView then DebugLn('ConnectChilds B ');
// this is a container widget -> connect all childs
@ -4668,7 +4668,7 @@ procedure ConnectInternalWidgetsSignals(AWidget: PGtkWidget;
DesignSignalType: TDesignSignalType;
DesignFlags: TConnectSignalFlags;
begin
//if AWinControl is TListView then DebugLn('ConnectSignals A ',HexStr(Cardinal(TheWidget),8));
//if AWinControl is TListView then DebugLn('ConnectSignals A ',DbgS(TheWidget));
if TheWidget=nil then exit;
// check if TheWidget belongs to another LCL object
@ -4681,7 +4681,7 @@ procedure ConnectInternalWidgetsSignals(AWidget: PGtkWidget;
exit;
end;
//if AWinControl is TListView then DebugLn('ConnectSignals B ',HexStr(Cardinal(TheWidget),8));
//if AWinControl is TListView then DebugLn('ConnectSignals B ',DbgS(TheWidget));
// connect signals needed for design mode:
for DesignSignalType:=Low(TDesignSignalType) to High(TDesignSignalType) do
begin
@ -4721,7 +4721,7 @@ begin
Result := PGTKAccelGroup(gtk_object_get_data(PGtkObject(Widget),'AccelGroup'));
if (Result=nil) and CreateIfNotExists then begin
{$IFDEF VerboseAccelerator}
DebugLn('GetAccelGroup CREATING Widget=',HexStr(Cardinal(Widget),8),' CreateIfNotExists=',CreateIfNotExists);
DebugLn('GetAccelGroup CREATING Widget=',DbgS(Widget),' CreateIfNotExists=',CreateIfNotExists);
{$ENDIF}
Result:=gtk_accel_group_new;
SetAccelGroup(Widget,Result);
@ -4738,7 +4738,7 @@ begin
if AnAccelGroup<>nil then begin
// attach group to widget
{$IFDEF VerboseAccelerator}
DebugLn('SetAccelGroup AnAccelGroup=',HexStr(Cardinal(AnAccelGroup),8),' IsMenu=',GtkWidgetIsA(Widget,GTK_MENU_TYPE));
DebugLn('SetAccelGroup AnAccelGroup=',DbgS(AnAccelGroup),' IsMenu=',GtkWidgetIsA(Widget,GTK_MENU_TYPE));
{$ENDIF}
if GtkWidgetIsA(Widget,GTK_TYPE_MENU) then
gtk_menu_set_accel_group(PGtkMenu(Widget), AnAccelGroup)
@ -4760,7 +4760,7 @@ begin
AccelGroup:=GetAccelGroup(Widget,false);
if AccelGroup<>nil then begin
{$IFDEF VerboseAccelerator}
DebugLn('FreeAccelGroup AccelGroup=',HexStr(Cardinal(AccelGroup),8));
DebugLn('FreeAccelGroup AccelGroup=',DbgS(AccelGroup));
{$ENDIF}
gtk_accel_group_unref(AccelGroup);
SetAccelGroup(Widget,nil);
@ -4922,7 +4922,7 @@ begin
end;
end;
{$IFDEF VerboseAccelerator}
DebugLn('GetAccelGroupForComponent END ',Component.Name,':',Component.ClassName,' Result=',HexStr(Cardinal(Result),8));
DebugLn('GetAccelGroupForComponent END ',Component.Name,':',Component.ClassName,' Result=',DbgS(Result));
{$ENDIF}
end;
@ -4954,9 +4954,9 @@ begin
Result^.Realized:=false;
end;
{$IFDEF VerboseAccelerator}
DebugLn('SetAccelKey Widget=',HexStr(Cardinal(Widget),8),
' Key=',Key,' Mods=',HexStr(Cardinal(Mods),8),
' Signal="',Signal,'" Result=',HexStr(Cardinal(Result),8));
DebugLn('SetAccelKey Widget=',DbgS(Widget),
' Key=',Key,' Mods=',DbgS(Mods),
' Signal="',Signal,'" Result=',DbgS(Result));
{$ENDIF}
gtk_object_set_data(PGtkObject(Widget), 'AccelKey', Result);
end;
@ -4984,7 +4984,7 @@ begin
{$IFDEF VerboseAccelerator}
DebugLn('RealizeAccelerator Add Accelerator ',
Component.Name,':',Component.ClassName,
' Widget=',HexStr(Cardinal(Widget),8),
' Widget=',DbgS(Widget),
' Signal=',AccelKey^.Signal,
' Key=',AccelKey^.Key,' Mods=',AccelKey^.Mods,
'');
@ -5013,7 +5013,7 @@ begin
if AccelKey^.Signal<>'' then begin
{$IFDEF VerboseAccelerator}
DebugLn('UnrealizeAccelerator ',
' Widget=',HexStr(Cardinal(Widget),8),
' Widget=',DbgS(Widget),
' Signal=',AccelKey^.Signal,
' Key=',AccelKey^.Key,' Mods=',AccelKey^.Mods,
'');
@ -5041,7 +5041,7 @@ begin
if (Component=nil) or (Widget=nil) or (Signal='') then
RaiseException('Accelerate: invalid input');
{$IFDEF VerboseAccelerator}
DebugLn('Accelerate ',Component.Name,':',Component.ClassName,' Key=',Key,' Mods=',HexStr(Cardinal(Mods),8),' Signal=',Signal);
DebugLn('Accelerate ',Component.Name,':',Component.ClassName,' Key=',Key,' Mods=',DbgS(Mods),' Signal=',Signal);
{$ENDIF}
// delete old accelerator key
@ -5625,7 +5625,7 @@ var
i: Integer;
ExpandItem: boolean;
begin
//DebugLn('UpdateStatusBarPanels ',HexStr(Cardinal(StatusBar),8));
//DebugLn('UpdateStatusBarPanels ',DbgS(StatusBar));
AStatusBar:=StatusBar as TStatusBar;
HBox:=PGtkWidget(StatusBarWidget);
@ -5656,7 +5656,7 @@ begin
// check new panel count
CurPanelCount:=integer(g_list_length(PGtkBox(HBox)^.children));
//DebugLn('TGtkWidgetSet.UpdateStatusBarPanels B ',HexStr(Cardinal(StatusBar),8),' NewPanelCount=',dbgs(NewPanelCount),' CurPanelCount=',dbgs(CurPanelCount));
//DebugLn('TGtkWidgetSet.UpdateStatusBarPanels B ',Dbgs(StatusBar),' NewPanelCount=',dbgs(NewPanelCount),' CurPanelCount=',dbgs(CurPanelCount));
if CurPanelCount<>NewPanelCount then
RaiseGDBException('');
@ -5686,7 +5686,7 @@ var
NewShadowType: TGtkShadowType;
NewJustification: TGtkJustification;
begin
//DebugLn('UpdateStatusBarPanel ',HexStr(Cardinal(StatusBar),8),' Index=',dbgs(Index));
//DebugLn('UpdateStatusBarPanel ',DbgS(StatusBar),' Index=',dbgs(Index));
AStatusBar:=StatusBar as TStatusBar;
CurPanel:=nil;
@ -5767,7 +5767,7 @@ var
{$ENDIF}
begin
{$IFDEF VerboseSizeMsg}
DbgOut('SaveSizeNotification Widget=',HexStr(Cardinal(Widget),8));
DbgOut('SaveSizeNotification Widget=',DbgS(Widget));
LCLControl:=TWinControl(GetLCLObject(Widget));
if (LCLControl<>nil) then begin
if LCLControl is TWinControl then
@ -5804,25 +5804,25 @@ begin
{$IFDEF VerboseSizeMsg}
MainWidget:=GetMainWidget(FixWidget);
//write('SaveClientSizeNotification',
// ' FixWidget=',HexStr(Cardinal(FixWidget),8),
// ' MainWIdget=',HexStr(Cardinal(MainWidget),8));
// ' FixWidget=',DbgS(FixWidget),
// ' MainWIdget=',DbgS(MainWidget));
LCLControl:=TWinControl(GetLCLObject(MainWidget));
if (LCLControl<>nil) then begin
if LCLControl is TWinControl then begin
//DebugLn('SaveClientSizeNotification ',LCLControl.Name,':',LCLControl.ClassName,
// ' FixWidget=',HexStr(Cardinal(FixWidget),8),
// ' MainWidget=',HexStr(Cardinal(MainWidget),8));
// ' FixWidget=',DbgS(FixWidget),
// ' MainWidget=',DbgS(MainWidget));
end else begin
DbgOut('ERROR: SaveClientSizeNotification ',
' LCLControl=',LCLControl.ClassName,
' FixWidget=',HexStr(Cardinal(FixWidget),8),
' MainWidget=',HexStr(Cardinal(MainWidget),8));
' FixWidget=',DbgS(FixWidget),
' MainWidget=',DbgS(MainWidget));
RaiseGDBException('SaveClientSizeNotification');
end;
end else begin
DbgOut('ERROR: SaveClientSizeNotification LCLControl=nil',
' FixWidget=',HexStr(Cardinal(FixWidget),8),
' MainWIdget=',HexStr(Cardinal(MainWidget),8));
' FixWidget=',DbgS(FixWidget),
' MainWIdget=',DbgS(MainWidget));
RaiseGDBException('SaveClientSizeNotification');
end;
{$ENDIF}
@ -5874,7 +5874,7 @@ begin
//DebugLn(' KKK1 HashArray.Count=',HashArray.Count);
while HashItem<>nil do begin
TopologicalList[i].Widget:=HashItem^.Item;
//DebugLn(' KKK21 i=',i,' Widget=',HexStr(Cardinal(TopologicalList[i].Widget),8));
//DebugLn(' KKK21 i=',i,' Widget=',DbgS(TopologicalList[i].Widget));
LCLControl:=TControl(GetLCLObject(TopologicalList[i].Widget));
if (LCLControl=nil) or (not (LCLControl is TControl)) then
RaiseException('CreateTopologicalSortedWidgets: '
@ -5909,7 +5909,7 @@ begin
Lvl:=TopologicalList[i].ParentLevel;
dec(LevelCounts[Lvl]);
//DebugLn(' KKK5 i=',i,' Lvl=',Lvl,' LevelCounts[Lvl]=',LevelCounts[Lvl],
// ' Widget=',HexStr(Cardinal(TopologicalList[i].Widget),8));
// ' Widget=',DbgS(TopologicalList[i].Widget));
Result[LevelCounts[Lvl]]:=TopologicalList[i].Widget;
end;
@ -5985,11 +5985,11 @@ procedure UpdateSysColorMap(Widget: PGtkWidget);
{$IFDEF VerboseUpdateSysColorMap}
function GdkColorAsString(c: TgdkColor): string;
begin
Result:='LCL='+HexStr(Cardinal(TGDKColorToTColor(c)),8)
+' Pixel='+HexStr(Cardinal(c.Pixel),8)
+' Red='+HexStr(Cardinal(c.Red),8)
+' Green='+HexStr(Cardinal(c.Green),8)
+' Blue='+HexStr(Cardinal(c.Blue),8)
Result:='LCL='+DbgS(TGDKColorToTColor(c))
+' Pixel='+DbgS(c.Pixel)
+' Red='+DbgS(c.Red)
+' Green='+DbgS(c.Green)
+' Blue='+DbgS(c.Blue)
;
end;
{$ENDIF}
@ -7408,7 +7408,7 @@ begin
RCStyle^.color_flags[i] or GTK_RC_BG;
end;}
//DebugLn('UpdateWidgetStyleOfControl ',DbgSName(AWinControl),' Color=',HexStr(Cardinal(AWinControl.Color),8));
//DebugLn('UpdateWidgetStyleOfControl ',DbgSName(AWinControl),' Color=',DbgS(AWinControl.Color));
end;
{if (AWinControl is TCustomForm) then begin
@ -7451,7 +7451,7 @@ begin
RCStyle^.color_flags[GTK_STATE_NORMAL]:=
RCStyle^.color_flags[GTK_STATE_NORMAL] or GTK_RC_TEXT;
//DebugLn('UpdateWidgetStyleOfControl Font Color ',DbgSName(AWinControl),' Color=',HexStr(Cardinal(AWinControl.Font.Color),8));
//DebugLn('UpdateWidgetStyleOfControl Font Color ',DbgSName(AWinControl),' Color=',DbgS(AWinControl.Font.Color));
end;
// set font (currently only TCustomLabel)
@ -8099,6 +8099,9 @@ end;
{ =============================================================================
$Log$
Revision 1.350 2005/03/07 21:59:45 vincents
changed hexstr(cardinal()) for pointers to dbgs() and other 64-bits fixes from Peter Vreman
Revision 1.349 2005/03/05 23:00:16 mattias
adding panels to statusbar during designing now sets SimplePanel:=false

103
lcl/interfaces/gtk/gtkwinapi.inc
View File

@ -193,7 +193,7 @@ var
AForm: TCustomForm;
begin
{$IFDEF VerboseFocus}
DbgOut('TGtkWidgetSet.BringWindowToTop hWnd=',HexStr(Cardinal(hWnd),8));
DbgOut('TGtkWidgetSet.BringWindowToTop hWnd=',DbgS(hWnd));
LCLObject:=TControl(GetLCLObject(Pointer(hWnd)));
if LCLObject<>nil then
DebugLn(' LCLObject=',LCLObject.Name,':',LCLObject.ClassName)
@ -348,7 +348,7 @@ var FormatAtom, FormatTry: Cardinal;
Result:=false;
AllID:=gdk_atom_intern('TARGETS',GdkFalse);
SelData:=RequestSelectionData(ClipboardWidget,ClipboardType,AllID);
{DebugLn('IsFormatSupported A ',HexStr(Cardinal(SelData.Selection),8),
{DebugLn('IsFormatSupported A ',Dbgs(SelData.Selection),
' ',HexStr(Cardinal(ClipboardTypeAtoms[ClipboardType]),8),
' SelData.Target='+dbgs(SelData.Target),' AllID='+dbgs(AllID),
' SelData.TheType='+dbgs(SelData.TheType),' '+dbgs(gdk_atom_intern('ATOM',0)),
@ -377,7 +377,7 @@ var FormatAtom, FormatTry: Cardinal;
begin
{$IfDef DEBUG_CLIPBOARD}
DebugLn('[TGtkWidgetSet.ClipboardGetData] A ClipboardWidget=',HexStr(Cardinal(ClipboardWidget),8),' FormatID=',ClipboardFormatToMimeType(FormatID),' Now=',dbgs(Now));
DebugLn('[TGtkWidgetSet.ClipboardGetData] A ClipboardWidget=',Dbgs(ClipboardWidget),' FormatID=',ClipboardFormatToMimeType(FormatID),' Now=',dbgs(Now));
{$EndIf}
Result:=false;
if (FormatID=0) or (Stream=nil) then exit;
@ -532,7 +532,7 @@ var AllID: cardinal;
begin
{$IfDef DEBUG_CLIPBOARD}
DebugLn('[TGtkWidgetSet.ClipboardGetFormats] A ClipboardWidget=',HexStr(Cardinal(ClipboardWidget),8),' Now=',dbgs(Now));
DebugLn('[TGtkWidgetSet.ClipboardGetFormats] A ClipboardWidget=',Dbgs(ClipboardWidget),' Now=',dbgs(Now));
{$EndIf}
Result:=false;
Count:=0;
@ -555,7 +555,7 @@ begin
' "'+gdk_atom_name(SelData.theType)+'"',
' Length='+dbgs(SelData.Length),
' Format='+dbgs(SelData.Format),
' Data='+HexStr(Cardinal(SelData.Data),8),
' Data='+Dbgs(SelData.Data),
' Now='+dbgs(Now)
);
{$EndIf}
@ -876,7 +876,7 @@ begin
end;}
Result := HBITMAP(GdiObject);
//DebugLn('[TGtkWidgetSet.CreateBitmap] ',HexStr(Result,8));
//DebugLn('[TGtkWidgetSet.CreateBitmap] ',DbgS(Result,8));
Assert(False, Format('Trace:< [TGtkWidgetSet.CreateBitmap] --> 0x%x', [Integer(Result)]));
end;
@ -915,11 +915,11 @@ begin
' Depth='+dbgs(RawImage.Description.Depth),
' Width='+dbgs(RawImage.Description.Width),
' Height='+dbgs(RawImage.Description.Height),
' Data='+HexStr(Cardinal(RawImage.Data),8),
' Data='+DbgS(RawImage.Data),
' DataSize='+dbgs(RawImage.DataSize)+
' Mask='+HexStr(Cardinal(RawImage.Mask),8)+
' Mask='+DbgS(RawImage.Mask)+
' MaskSize='+dbgs(RawImage.MaskSize)+
' Palette='+HexStr(Cardinal(RawImage.Palette),8)+
' Palette='+DbgS(RawImage.Palette)+
' PaletteSize='+dbgs(RawImage.PaletteSize)+
' BitsPerPixel='+dbgs(RawImage.Description.BitsPerPixel)+
'');
@ -1046,7 +1046,7 @@ begin
GObject := NewGDIObject(gdiBrush);
try
{$IFDEF DebugGDIBrush}
DebugLn('[TGtkWidgetSet.CreateBrushIndirect] ',HexStr(Cardinal(GObject),8));
DebugLn('[TGtkWidgetSet.CreateBrushIndirect] ',DbgS(GObject));
{$ENDIF}
GObject^.IsNullBrush := False;
with LogBrush do
@ -1743,7 +1743,7 @@ begin
if GdiObject^.GDIFontObject = nil
then begin
{$IFDEF VerboseFonts}
DebugLn('[TGtkWidgetSet.CreateFontIndirect] ',HexStr(Cardinal(GdiObject),8),' ',FGDIObjects.Count);
DebugLn('[TGtkWidgetSet.CreateFontIndirect] ',DbgS(GdiObject),' ',FGDIObjects.Count);
{$ENDIF}
DisposeGDIObject(GdiObject);
Result := 0;
@ -2226,7 +2226,7 @@ function TGtkWidgetSet.DeleteObject(GDIObject: HGDIOBJ): Boolean;
procedure RaiseInvalidGDIObject;
begin
RaiseGDBException('TGtkWidgetSet.DeleteObject invalid GdiObject='+HexStr(Cardinal(GdiObject),8));
RaiseGDBException('TGtkWidgetSet.DeleteObject invalid GdiObject='+DbgS(GdiObject));
end;
var
@ -2261,7 +2261,7 @@ begin
BeginGDKErrorTrap;
{$ENDIF}
{$IFDEF DebugGDIBrush}
debugln('TGtkWidgetSet.DeleteObject gdiBrush: ',HexStr(Cardinal(GdiObject),8));
debugln('TGtkWidgetSet.DeleteObject gdiBrush: ',DbgS(GdiObject));
//if Cardinal(GdiObject)=$404826F4 then RaiseGDBException('');
{$ENDIF}
if (GDIBrushPixmap <> nil)
@ -2321,7 +2321,7 @@ begin
end;
{ Dispose of the GDI object }
//DebugLn('[TGtkWidgetSet.DeleteObject] ',Result,' ',HexStr(GDIObject,8),' ',FGDIObjects.Count);
//DebugLn('[TGtkWidgetSet.DeleteObject] ',Result,' ',DbgS(GDIObject,8),' ',FGDIObjects.Count);
DisposeGDIObject(PGDIObject(GDIObject));
end;
@ -2630,7 +2630,7 @@ Var
R: TRect;
DCOrigin: TPoint;
begin
//DebugLn('TGtkWidgetSet.DrawEdge Edge=',HexStr(Cardinal(Edge),8),' grfFlags=',HexStr(Cardinal(grfFlags),8));
//DebugLn('TGtkWidgetSet.DrawEdge Edge=',DbgS(Edge),8),' grfFlags=',DbgS(Cardinal(grfFlags));
Result := IsValidDC(DC);
if Result
then with TDeviceContext(DC) do
@ -3476,7 +3476,7 @@ begin
CurrentBrush := PGdiObject(Brush);
SelectedColors:=dcscCustom;
end;
//DebugLn('TGtkWidgetSet.FillRect Color=',HexStr(Cardinal(CurrentBrush^.GDIBrushColor.ColorRef),8));
//DebugLn('TGtkWidgetSet.FillRect Color=',DbgS(CurrentBrush^.GDIBrushColor.ColorRef));
SelectGDKBrushProps(DC);
@ -3562,7 +3562,7 @@ begin
if not Result then exit;
if FrameWidth=0 then exit;
TheStyle:=GetStyle(lgsButton);
//DebugLn('TGtkWidgetSet.Frame3d A ',HexStr(Cardinal(TheStyle),8));
//DebugLn('TGtkWidgetSet.Frame3d A ',DbgS(TheStyle));
if TheStyle=nil then exit;
with TDeviceContext(DC) do
@ -3589,8 +3589,8 @@ begin
else
ShadowType:=GTKStrongShadowType[Style];
//DebugLn('ShadowType ',ShadowType,
//' dark_gc=',HexStr(Cardinal(TheStyle^.dark_gc[GTK_STATE_NORMAL]),8),
//' light_gc=',HexStr(Cardinal(TheStyle^.light_gc[GTK_STATE_NORMAL]),8),
//' dark_gc=',DbgS(TheStyle^.dark_gc[GTK_STATE_NORMAL]),
//' light_gc=',DbgS(TheStyle^.light_gc[GTK_STATE_NORMAL]),
//'');
for i:= 1 to FrameWidth do begin
@ -3963,14 +3963,14 @@ begin
end;
{$IfDef VerboseGetClientRect}
if ClientWidget<>nil then begin
DebugLn('GetClientRect Widget=',HexStr(Cardinal(handle),8),
' Client=',HexStr(Cardinal(ClientWidget),8),
DebugLn('GetClientRect Widget=',DbgS(handle),
' Client=',DbgS(ClientWidget),
' WindowSize=',ARect.Right,',',ARect.Bottom,
' Allocation=',ClientWidget^.Allocation.Width,',',ClientWidget^.Allocation.Height
);
end else begin
DebugLn('GetClientRect Widget=',HexStr(Cardinal(handle),8),
' Client=',HexStr(Cardinal(ClientWidget),8),
DebugLn('GetClientRect Widget=',DbgS(handle),
' Client=',DbgS(ClientWidget),
' WindowSize=',ARect.Right,',',ARect.Bottom,
' Allocation=',Widget^.Allocation.Width,',',Widget^.Allocation.Height
);
@ -4149,7 +4149,7 @@ begin
PGdiObject(RGN)^.GDIRegionObject := ClipRegionWithDCOffset;
Result := RegionType(ClipRegionWithDCOffset);
//DebugLn('TGtkWidgetSet.GetClipRGN B DC=',HexStr(Cardinal(DC),8),
//DebugLn('TGtkWidgetSet.GetClipRGN B DC=',DbgS(DC),
// ' DCOrigin=',dbgs(DCOrigin),' RGN=',GDKRegionAsString(ClipRegionWithDCOffset),' Result=',dbgs(Result));
If Result = NULLREGION then
Result := 0
@ -4390,8 +4390,8 @@ begin
RaiseException('TGtkWidgetSet.GetDeviceSize Window=nil');
{$ENDIF}
DebugLn('TGtkWidgetSet.GetDeviceSize:',
' WARNING: DC ',HexStr(Cardinal(DC),8),' without gdkwindow.',
' Widget=',HexStr(Cardinal(wnd),8));
' WARNING: DC ',DbgS(DC),' without gdkwindow.',
' Widget=',DbgS(wnd));
end;
end;
end;
@ -4416,8 +4416,8 @@ function TGtkWidgetSet.GetDCOriginRelativeToWindow(PaintDC: HDC;
RaiseException('TGtkWidgetSet.GetDCOriginRelativeToWindow Window=nil');
{$ENDIF}
DebugLn('TGtkWidgetSet.GetDCOriginRelativeToWindow:',
' WARNING: PaintDC ',HexStr(Cardinal(PaintDC),8),' without gdkwindow.',
' Widget=',HexStr(Cardinal(TDeviceContext(PaintDC).wnd),8));
' WARNING: PaintDC ',DbgS(PaintDC),' without gdkwindow.',
' Widget=',DbgS(TDeviceContext(PaintDC).wnd));
end;
var
@ -4749,7 +4749,7 @@ end;
------------------------------------------------------------------------------}
Function TGtkWidgetSet.GetParent(Handle : HWND): HWND;
begin
//DebugLn('TGtkWidgetSet.GetParent ',HexStr(Cardinal(Handle),8));
//DebugLn('TGtkWidgetSet.GetParent ',DbgS(Handle));
Result:=0;
if Handle<>0 then
Result:=HWnd(PGtkWidget(Handle)^.Parent);
@ -4835,7 +4835,7 @@ begin
exit;
end;
{$IFDEF VerboseRawImage}
DebugLn('TGtkWidgetSet.GetRawImageFromBitmap A GdkPixmap=',HexStr(Cardinal(GdkPixmap),8),' SrcMaskBitmap=',HexStr(Cardinal(SrcMaskBitmap),8));
DebugLn('TGtkWidgetSet.GetRawImageFromBitmap A GdkPixmap=',DbgS(GdkPixmap),8),' SrcMaskBitmap=',DbgS(Cardinal(SrcMaskBitmap));
{$ENDIF}
GDIMaskImg:=nil;
@ -6226,7 +6226,7 @@ begin
Result:=IsValidDC(DC);
if Result then
with TDeviceContext(DC) do begin
//DebugLn('[TGtkWidgetSet.MoveWindowOrgEx] B DC=',HexStr(Cardinal(DC),8),
//DebugLn('[TGtkWidgetSet.MoveWindowOrgEx] B DC=',DbgS(DC),
// ' Old=',Origin.X,',',Origin.Y,' d=',dX,',',dY,' ');
inc(Origin.X,dX);
inc(Origin.Y,dY);
@ -6914,7 +6914,7 @@ end;
then begin
Result:=gtk_radio_menu_item_group(
GTK_RADIO_MENU_ITEM(ParentMenuItem[i].Handle));
//DebugLn('TGtkWidgetSet.RegroupMenuItem.GetGroup A i=',i,' ',ParentMenuItem[i].Name,' GrpIndex=',ParentMenuItem[i].GroupIndex,' LastRadioItem=',LastRadioItem,' Result=',HexStr(Cardinal(Result),8));
//DebugLn('TGtkWidgetSet.RegroupMenuItem.GetGroup A i=',i,' ',ParentMenuItem[i].Name,' GrpIndex=',ParentMenuItem[i].GroupIndex,' LastRadioItem=',LastRadioItem,' Result=',DbgS(Result));
exit;
end;
end;
@ -6944,7 +6944,7 @@ begin
//DebugLn('TGtkWidgetSet.RegroupMenuItem B i=',i,' ',ParentMenuItem[i].Name,
//' GrpIndex=',ParentMenuItem[i].GroupIndex,
//' LastRadioGroupStart=',LastRadioGroupStart,
//' LastGroup=',HexStr(Cardinal(gtk_radio_menu_item_group(
//' LastGroup=',DbgS(Cardinal(gtk_radio_menu_item_group(
// GTK_RADIO_MENU_ITEM(ParentMenuItem[i].Handle))),8)
//);
if (ParentMenuItem[i].GroupIndex<>0) then begin
@ -7005,7 +7005,7 @@ function TGtkWidgetSet.ReleaseDC(hWnd: HWND; DC: HDC): Integer;
var
aDC, pSavedDC: TDeviceContext;
begin
//DebugLn('[TGtkWidgetSet.ReleaseDC] ',HexStr(DC,8),' ',FDeviceContexts.Count);
//DebugLn('[TGtkWidgetSet.ReleaseDC] ',DbgS(DC,8),' ',FDeviceContexts.Count);
Assert(False, Format('trace:> [TGtkWidgetSet.ReleaseDC] DC:0x%x', [DC]));
Result := 0;
@ -7386,15 +7386,15 @@ begin
Result := 0;
{if not IsValidDC(DC) then begin
DebugLn('TGtkWidgetSet.SelectObject invalid DC ',HexStr(Cardinal(DC),8));
DebugLn('TGtkWidgetSet.SelectObject invalid DC ',DbgS(DC));
end;
if not IsValidGDIObject(GDIObj) then begin
DebugLn('TGtkWidgetSet.SelectObject invalid GDIObj ',HexStr(Cardinal(GDIObj),8));
DebugLn('TGtkWidgetSet.SelectObject invalid GDIObj ',DbgS(GDIObj));
end;}
if IsValidDC(DC) and IsValidGDIObject(GDIObj)
then begin
//DebugLn('TGtkWidgetSet.SelectObject DC=',HexStr(Cardinal(DC),8),' GDIObj=',HexStr(Cardinal(GDIObj),8),' GDIType=',ord(PGdiObject(GDIObj)^.GDIType),' ',ord(gdiBitmap),' ',ord(gdiRegion));
//DebugLn('TGtkWidgetSet.SelectObject DC=',DbgS(DC),8),' GDIObj=',DbgS(Cardinal(GDIObj),' GDIType=',ord(PGdiObject(GDIObj)^.GDIType),' ',ord(gdiBitmap),' ',ord(gdiRegion));
case PGdiObject(GDIObj)^.GDIType of
gdiBitmap:
@ -7415,8 +7415,8 @@ begin
else
Drawable := nil;
end;
//DebugLn('TGtkWidgetSet.SelectObject DC=',HexStr(Cardinal(DC),8),' GDIBitmap=',HexStr(Cardinal(CurrentBitmap),8),
//' GDIBitmapType=',ord(CurrentBitmap^.GDIBitmapType),' Drawable=',HexStr(Cardinal(Drawable),8));
//DebugLn('TGtkWidgetSet.SelectObject DC=',DbgS(DC),8),' GDIBitmap=',DbgS(Cardinal(CurrentBitmap),
//' GDIBitmapType=',ord(CurrentBitmap^.GDIBitmapType),' Drawable=',DbgS(Drawable));
GC := gdk_gc_new(Drawable);
@ -7482,8 +7482,8 @@ begin
RaiseInvalidGDIType;
end;
end;
//DebugLn('[TGtkWidgetSet.SelectObject] GDI=',HexStr(Cardinal(GDIObj),8)
// ,' Old=',Hexstr(Cardinal(Result),8));
//DebugLn('[TGtkWidgetSet.SelectObject] GDI=',DbgS(GDIObj)
// ,' Old=',DbgS(Result));
end;
{------------------------------------------------------------------------------
@ -7562,7 +7562,7 @@ var
if AMessage.wParam<>0 then begin
with TLMGtkPaintData(AMessage.wParam) do begin
write(' GtkPaintData(',
' Widget=',HexStr(Cardinal(Widget),8),'=',GetWidgetClassName(Widget),
' Widget=',DbgS(Widget),'=',GetWidgetClassName(Widget),
' State=',State,
' Rect=',Rect.Left,',',Rect.Top,',',Rect.Right,',',Rect.Bottom,
' RepaintAll=',RepaintAll,
@ -7881,7 +7881,7 @@ begin
TopLevel := gtk_widget_get_toplevel(Widget);
{$IfDef VerboseFocus}
Debugln('[TGtkWidgetSet.SetFocus] B');
DbgOut(' TopLevel=',HexStr(Cardinal(TopLevel),8));
DbgOut(' TopLevel=',DbgS(TopLevel));
DbgOut(' OldFocus=',GetWidgetDebugReport(PGtkWidget(Result)));
DebugLn('');
if not GTK_WIDGET_VISIBLE(Widget) then
@ -7896,7 +7896,7 @@ begin
{$IfDef VerboseFocus}
AWinControl:=TWinControl(GetNearestLCLObject(PGtkWindow(TopLevel)^.focus_widget));
write(' C TopLevel is a gtkwindow ');
write(' focus_widget=',HexStr(Cardinal(PGtkWindow(TopLevel)^.focus_widget),8));
write(' focus_widget=',DbgS(PGtkWindow(TopLevel)^.focus_widget));
if AWinControl<>nil then
write(' LCLParent=',AWinControl.Name,':',AWinControl.ClassName)
else
@ -7932,7 +7932,7 @@ begin
{$EndIf}
end;
{$IfDef VerboseFocus}
write(' G NewFocusWidget=',HexStr(Cardinal(NewFocusWidget),8));
write(' G NewFocusWidget=',DbgS(NewFocusWidget));
write(' WidVisible=',GTK_WIDGET_VISIBLE(PGtkWidget(NewFocusWidget)));
write(' WidRealized=',GTK_WIDGET_REALIZED(PGtkWidget(NewFocusWidget)));
write(' WidMapped=',GTK_WIDGET_MAPPED(PGtkWidget(NewFocusWidget)));
@ -7944,11 +7944,11 @@ begin
if (PGtkWindow(TopLevel)^.Focus_Widget<>NewFocusWidget)
then begin
{$IfDef VerboseFocus}
DebugLn(' H SETTING NewFocusWidget=',HexStr(Cardinal(NewFocusWidget),8));
DebugLn(' H SETTING NewFocusWidget=',DbgS(NewFocusWidget));
{$EndIf}
gtk_window_set_focus(PGtkWindow(TopLevel),NewFocusWidget);
{$IfDef VerboseFocus}
DebugLn(' I NewTopLevel FocusWidget=',HexStr(Cardinal(PGtkWindow(TopLevel)^.Focus_Widget),8),' Success=',dbgs(PGtkWindow(TopLevel)^.Focus_Widget=NewFocusWidget));
DebugLn(' I NewTopLevel FocusWidget=',DbgS(PGtkWindow(TopLevel)^.Focus_Widget),' Success=',dbgs(PGtkWindow(TopLevel)^.Focus_Widget=NewFocusWidget));
{$EndIf}
end;
end;
@ -7975,9 +7975,9 @@ begin
end;
{$IfDef VerboseFocus}
write('[TGtkWidgetSet.SetFocus] END hWnd=',HexStr(Cardinal(hWnd),8));
write('[TGtkWidgetSet.SetFocus] END hWnd=',DbgS(hWnd));
NewFocusWidget:=PGtkWidget(GetFocus);
write(' NewFocus=',HexStr(Cardinal(NewFocusWidget),8));
write(' NewFocus=',DbgS(NewFocusWidget));
AWinControl:=TWinControl(GetNearestLCLObject(NewFocusWidget));
if AWinControl<>nil then
write(' NewLCLParent=',AWinControl.Name,':',AWinControl.ClassName)
@ -8150,7 +8150,7 @@ begin
' Page_Size=',RoundToInt(Page_Size),
' Page_Increment=',RoundToInt(Page_Increment),
' bRedraw=',bRedraw,
' Handle=',HexStr(Cardinal(Handle),8));}
' Handle=',DbgS(Handle));}
// do we have to set this always ?
if bRedraw then
@ -8952,6 +8952,9 @@ end;
{ =============================================================================
$Log$
Revision 1.406 2005/03/07 21:59:45 vincents
changed hexstr(cardinal()) for pointers to dbgs() and other 64-bits fixes from Peter Vreman
Revision 1.405 2005/03/05 14:44:01 mattias
fixed gtk1 font rotating from C Western

35
lcl/interfaces/gtk/gtkwinapiwindow.pp
View File

@ -536,7 +536,7 @@ function GTKAPIWidgetClient_ButtonPress(Widget: PGTKWidget;
Event: PGDKEventButton): GTKEventResult; cdecl;
begin
{$IFDEF VerboseFocus}
DebugLn('GTKAPIWidgetClient_ButtonPress ',HexStr(Cardinal(Widget),8));
DebugLn('GTKAPIWidgetClient_ButtonPress ',DbgS(Widget));
{$ENDIF}
if Event=nil then ;
if not gtk_widget_has_focus(Widget) then
@ -549,7 +549,7 @@ function GTKAPIWidgetClient_FocusIn(AWidget: PGTKWidget;
Event: PGdkEventFocus): GTKEventResult; cdecl;
begin
{$IFDEF VerboseFocus}
DebugLn('GTKAPIWidgetClient_FocusIn ',HexStr(Cardinal(AWidget),8),' ',dbgs(event^.thein));
DebugLn('GTKAPIWidgetClient_FocusIn ',DbgS(AWidget),' ',dbgs(event^.thein));
{$ENDIF}
gtk_widget_set_flags(AWidget, GTK_HAS_FOCUS);
@ -567,7 +567,7 @@ function GTKAPIWidgetClient_FocusOut(AWidget: PGTKWidget;
Event: PGdkEventFocus): GTKEventResult; cdecl;
begin
{$IFDEF VerboseFocus}
DebugLn('GTKAPIWidgetClient_FocusOut ',HexStr(Cardinal(AWidget),8),' ',dbgs(event^.thein));
DebugLn('GTKAPIWidgetClient_FocusOut ',DbgS(AWidget),' ',dbgs(event^.thein));
{$ENDIF}
gtk_widget_unset_flags(AWidget, GTK_HAS_FOCUS);
@ -583,14 +583,14 @@ end;
procedure GTKAPIWidgetClient_HideCaret(Client: PGTKAPIWidgetClient;
var OldVisible: boolean);
begin
//DebugLn('[GTKAPIWidgetClient_HideCaret] A Client=',HexStr(Cardinal(Client),8));
//DebugLn('[GTKAPIWidgetClient_HideCaret] A Client=',DbgS(Client));
if Client = nil
then begin
DebugLn('WARNING: [GTKAPIWidgetClient_HideCaret] Got nil client');
Exit;
end;
{$IFDEF VerboseCaret}
DebugLn('GTKAPIWidgetClient_HideCaret ',HexStr(Cardinal(Client),8),' ShowHideOnFocus=',Client^.Caret.ShowHideOnFocus);
DebugLn('GTKAPIWidgetClient_HideCaret ',DbgS(Client),' ShowHideOnFocus=',Client^.Caret.ShowHideOnFocus);
{$ENDIF}
OldVisible:=Client^.Caret.Visible;
Client^.Caret.Visible := False;
@ -639,7 +639,7 @@ begin
if IsDrawn and ((not Visible) or (Blinking and CalledByTimer))
then begin
{$IFDEF VerboseCaret}
DebugLn('GTKAPIWidgetClient_DrawCaret ',HexStr(Cardinal(Client),8),
DebugLn('GTKAPIWidgetClient_DrawCaret ',DbgS(Client),
' Hiding Caret IsDrawn=',IsDrawn,' Visible=',Visible,' Blinking=',Blinking);
{$ENDIF}
// hide caret
@ -689,7 +689,7 @@ begin
// draw caret
{$IFDEF VerboseCaret}
DebugLn('GTKAPIWidgetClient_DrawCaret B Client=',HexStr(Cardinal(Client),8)
DebugLn('GTKAPIWidgetClient_DrawCaret B Client=',DbgS(Client)
,' ',cardinal(WidgetStyle)
,' ',cardinal(Widget^.Window)
,' ',Width
@ -702,11 +702,11 @@ begin
and (Height>0)
then begin
// set draw function to xor
ForeGroundGC:=WidgetStyle^.fg_gc[GC_STATE[Integer(Pixmap) <> 1]];
ForeGroundGC:=WidgetStyle^.fg_gc[GC_STATE[PtrInt(Pixmap) <> 1]];
//gdk_gc_get_values(ForeGroundGC,@ForeGroundGCValues);
//OldGdkFunction:=ForeGroundGCValues.thefunction;
{$IFDEF VerboseCaret}
DebugLn('GTKAPIWidgetClient_DrawCaret ',HexStr(Cardinal(Client),8),' Real Drawing Caret ');
DebugLn('GTKAPIWidgetClient_DrawCaret ',DbgS(Client),' Real Drawing Caret ');
{$ENDIF}
gdk_gc_set_function(ForeGroundGC,GDK_invert);
try
@ -724,12 +724,12 @@ begin
gdk_gc_set_function(ForeGroundGC,GDK_COPY);
end;
end else
DebugLn('***: Draw Caret failed: Client=',HexStr(Cardinal(Client),8),
DebugLn('***: Draw Caret failed: Client=',DbgS(Client),
' X='+dbgs(X)+' Y='+dbgs(Y)+' W='+dbgs(Width)+' H='+dbgs(Height),
' ',dbgs(Pixmap<>nil),',',dbgs(Widget^.Window),',',dbgs(WidgetStyle));
IsDrawn := True;
end;
//DebugLn('GTKAPIWidgetClient_DrawCaret A Client=',HexStr(Cardinal(Client),8),' Timer=',Timer,' Blink=',Blinking,' Visible=',Visible,' ShowHideOnFocus=',ShowHideOnFocus,' Focus=',gtk_widget_has_focus(Widget),' IsDrawn=',IsDrawn,' W=',Width,' H=',Height);
//DebugLn('GTKAPIWidgetClient_DrawCaret A Client=',DbgS(Client),' Timer=',Timer,' Blink=',Blinking,' Visible=',Visible,' ShowHideOnFocus=',ShowHideOnFocus,' Focus=',gtk_widget_has_focus(Widget),' IsDrawn=',IsDrawn,' W=',Width,' H=',Height);
if Visible and Blinking and (Timer = 0)
and ((not ShowHideOnFocus) or HasFocus)
then Timer := gtk_timeout_add(500, @GTKAPIWidgetClient_Timer, Client);
@ -738,7 +738,7 @@ end;
procedure GTKAPIWidgetClient_ShowCaret(Client: PGTKAPIWidgetClient);
begin
//DebugLn('[GTKAPIWidgetClient_ShowCaret] A Client=',HexStr(Cardinal(Client),8));
//DebugLn('[GTKAPIWidgetClient_ShowCaret] A Client=',DbgS(Client));
if Client = nil
then begin
DebugLn('WARNING: [GTKAPIWidgetClient_ShowCaret] Got nil client');
@ -746,7 +746,7 @@ begin
end;
{$IFDEF VerboseCaret}
DebugLn('GTKAPIWidgetClient_ShowCaret ',HexStr(Cardinal(Client),8));
DebugLn('GTKAPIWidgetClient_ShowCaret ',DbgS(Client));
{$ENDIF}
// force restarting time
@ -778,7 +778,7 @@ var
WasVisible: boolean;
begin
{$IFDEF VerboseCaret}
DebugLn('********** [GTKAPIWidgetClient_CreateCaret] A Client=',HexStr(Cardinal(Client),8),' Width=',AWidth,' Height=',AHeight,' Bitmap=',ABitmap<>nil);
DebugLn('********** [GTKAPIWidgetClient_CreateCaret] A Client=',DbgS(Client),' Width=',AWidth,' Height=',AHeight,' Bitmap=',ABitmap<>nil);
{$ENDIF}
if Client = nil
then begin
@ -810,7 +810,7 @@ var
WasVisible: boolean;
begin
{$IFDEF VerboseCaret}
DebugLn('********** [GTKAPIWidgetClient_DestroyCaret] A Client=',HexStr(Cardinal(Client),8));
DebugLn('********** [GTKAPIWidgetClient_DestroyCaret] A Client=',DbgS(Client));
{$ENDIF}
if Client = nil
then begin
@ -828,7 +828,7 @@ begin
Pixmap := nil;
end;
{$IFDEF VerboseCaret}
DebugLn('********** B[GTKAPIWidgetClient_DestroyCaret] A Client=',HexStr(Cardinal(Client),8));
DebugLn('********** B[GTKAPIWidgetClient_DestroyCaret] A Client=',DbgS(Client));
{$ENDIF}
end;
@ -1130,6 +1130,9 @@ end.
{ =============================================================================
$Log$
Revision 1.68 2005/03/07 21:59:45 vincents
changed hexstr(cardinal()) for pointers to dbgs() and other 64-bits fixes from Peter Vreman
Revision 1.67 2005/03/04 12:25:13 mattias
fixed gtk2 intf winapiwindow keypress handler result from Danny Milosavljevic

4
lcl/interfaces/gtk/gtkwsbuttons.pp
View File

@ -122,7 +122,7 @@ var
begin
Button := AWinControl as TCustomButton;
Result := THandle(gtk_button_new_with_label('button'));
Result := TLCLIntfHandle(gtk_button_new_with_label('button'));
if Result = 0 then Exit;
WidgetInfo := CreateWidgetInfo(Pointer(Result), Button, AParams);
@ -228,7 +228,7 @@ var
begin
BitBtn := AWinControl as TCustomBitBtn;
Result := THandle(gtk_button_new);
Result := TLCLIntfHandle(gtk_button_new);
if Result = 0 then Exit;
WidgetInfo := CreateWidgetInfo(Pointer(Result), BitBtn, AParams);

4
lcl/interfaces/gtk/gtkwscomctrls.pp
View File

@ -393,7 +393,7 @@ var
StatusPanelWidget: PGtkWidget;
BoxChild: PGtkBoxChild;
begin
//DebugLn('TGtkWidgetSet.StatusBarPanelUpdate ',HexStr(Cardinal(AStatusBar),8),' PanelIndex=',dbgs(PanelIndex));
//DebugLn('TGtkWidgetSet.StatusBarPanelUpdate ',DbgS(AStatusBar),' PanelIndex=',dbgs(PanelIndex));
if PanelIndex>=0 then begin
// update one
HBox:=PGtkWidget(AStatusBar.Handle);
@ -416,7 +416,7 @@ end;
procedure TGtkWSStatusBar.Update(const AStatusBar: TStatusBar);
begin
//DebugLn('TGtkWidgetSet.StatusBarUpdate ',HexStr(Cardinal(AStatusBar),8));
//DebugLn('TGtkWidgetSet.StatusBarUpdate ',DbgS(AStatusBar));
UpdateStatusBarPanels(AStatusBar,PGtkWidget(AStatusBar.Handle));
end;

2
lcl/interfaces/gtk/gtkwscontrols.pp
View File

@ -447,7 +447,7 @@ begin
csComboBox :
begin
//DebugLn('SetLabel: ',TComboBox(Sender).Name,':',TComboBox(Sender).ClassName,
// ' ',HexStr(Cardinal(TComboBox(Sender).Handle),8),' "',PLabel,'"');
// ' ',DbgS(TComboBox(Sender).Handle),' "',PLabel,'"');
SetComboBoxText(PGtkCombo(TComboBox(AWinControl).Handle), PLabel);
end;

4
lcl/interfaces/gtk/gtkwsdialogs.pp
View File

@ -118,11 +118,11 @@ var
colorSel : PGTKCOLORSELECTION;
begin
{$IFDEF VerboseColorDialog}
DebugLn('TGtkWidgetSet.SetColorDialogColor Start Color=',HexStr(Cardinal(Color),8));
DebugLn('TGtkWidgetSet.SetColorDialogColor Start Color=',DbgS(Color));
{$ENDIF}
Color:=ColorToRGB(Color);
{$IFDEF VerboseColorDialog}
DebugLn('TGtkWidgetSet.SetColorDialogColor Converted Color=',HexStr(Cardinal(Color),8));
DebugLn('TGtkWidgetSet.SetColorDialogColor Converted Color=',DbgS(Color));
{$ENDIF}
SelectionColor.Pixel := 0;
SelectionColor.Red := Red(Color) shl 8;

38
lcl/intfgraphics.pas
View File

@ -1802,7 +1802,7 @@ begin
while ArrNode<>nil do begin
Entry:=PXPMPixelToColorEntry(ArrNode.Data);
if Entry<>nil then begin
//DebugLn('TLazReaderXPM.ClearPixelToColorTree A ',HexStr(Cardinal(ArrNode),8),' ',HexStr(Cardinal(Entry),8));
//DebugLn('TLazReaderXPM.ClearPixelToColorTree A ',DbgS(ArrNode),' ',DbgS(Entry));
Dispose(Entry);
end;
ArrNode:=ArrNode.FindNext;
@ -2053,10 +2053,10 @@ var
i: Integer;
begin
{DebugLn('TLazReaderXPM.InternalRead.AddColor A "',PixelString,'"=',
HexStr(Cardinal(AColor.Red),4),',',
HexStr(Cardinal(AColor.Green),4),',',
HexStr(Cardinal(AColor.Blue),4),',',
HexStr(Cardinal(AColor.Alpha),4));}
DbgS(AColor.Red),',',
DbgS(AColor.Green),',',
DbgS(AColor.Blue),',',
DbgS(AColor.Alpha));}
New(NewEntry);
NewEntry^.Color:=AColor;
// add entry to Array Tree
@ -2144,26 +2144,26 @@ var
DebugLn('x=',x,' y=',y,' Pixel=',Entry^.Pixel,
' RefPixel=',CurEntry^.Pixel,
' Color=',
HexStr(Cardinal(CurColor.Red),4),',',
HexStr(Cardinal(CurColor.Green),4),',',
HexStr(Cardinal(CurColor.Blue),4),',',
HexStr(Cardinal(CurColor.Alpha),4));
DbgS(CurColor.Red),',',
DbgS(CurColor.Green),',',
DbgS(CurColor.Blue),',',
DbgS(CurColor.Alpha));
DebugLn('Entry2: Pixel=',CurEntry2^.Pixel,
' RefPixel=',CurEntry2^.Pixel,
' Color=',
HexStr(Cardinal(CurEntry2^.Color.Red),4),',',
HexStr(Cardinal(CurEntry2^.Color.Green),4),',',
HexStr(Cardinal(CurEntry2^.Color.Blue),4),',',
HexStr(Cardinal(CurEntry2^.Color.Alpha),4));
DbgS(CurEntry2^.Color.Red),',',
DbgS(CurEntry2^.Color.Green),',',
DbgS(CurEntry2^.Color.Blue),',',
DbgS(CurEntry2^.Color.Alpha));
end;}
{DebugLn('x=',x,' y=',y,' Pixel=',Entry^.Pixel,
' RefPixel=',PXPMPixelToColorEntry(Node.Data)^.Pixel,
' Color=',
HexStr(Cardinal(CurColor.Red),4),',',
HexStr(Cardinal(CurColor.Green),4),',',
HexStr(Cardinal(CurColor.Blue),4),',',
HexStr(Cardinal(CurColor.Alpha),4));}
DbgS(CurColor.Red),',',
DbgS(CurColor.Green),',',
DbgS(CurColor.Blue),',',
DbgS(CurColor.Alpha));}
Img.Colors[x,y]:=CurColor;
end;
if ProgressCount>0 then begin
@ -2619,7 +2619,7 @@ end;
constructor TArrayNode.Create;
begin
//DebugLn('TArrayNode.Create ',Capacity,' Self=',HexStr(Cardinal(Self),8));
//DebugLn('TArrayNode.Create ',Capacity,' Self=',DbgS(Self));
end;
destructor TArrayNode.Destroy;
@ -2908,7 +2908,7 @@ begin
Root:=TArrayNode.Create;
Result:=Root;
for i:=0 to Count-1 do begin
//DebugLn('TArrayNodesTree.SetNode A ',HexStr(Cardinal(Result),8));
//DebugLn('TArrayNodesTree.SetNode A ',DbgS(Result));
Result:=Result.GetChildNode(IntArray[i],true);
end;
Result.Data:=Data;

12
lcl/lclproc.pas
View File

@ -145,7 +145,8 @@ procedure DbgOut(const s1,s2,s3,s4,s5,s6,s7,s8,s9,s10,s11: string);
procedure DbgOut(const s1,s2,s3,s4,s5,s6,s7,s8,s9,s10,s11,s12: string);
function DbgS(const c: cardinal): string;
function DbgS(const i: integer): string;
function DbgS(const i: longint): string;
function DbgS(const i: int64): string;
function DbgS(const r: TRect): string;
function DbgS(const p: TPoint): string;
function DbgS(const p: pointer): string;
@ -1041,7 +1042,12 @@ begin
Result:=IntToStr(c);
end;
function DbgS(const i: integer): string;
function DbgS(const i: longint): string;
begin
Result:=IntToStr(i);
end;
function DbgS(const i: int64): string;
begin
Result:=IntToStr(i);
end;
@ -1059,7 +1065,7 @@ end;
function DbgS(const p: pointer): string;
begin
Result:=HexStr(Cardinal(p),8);
Result:=HexStr(PtrInt(p),sizeof(PtrInt));
end;
function DbgS(const e: extended): string;

2
lcl/lclrescache.pas
View File

@ -486,7 +486,7 @@ var
begin
Msg:='TBlockResourceCache.AddResource Descriptor Already Added '#13;
for i:=0 to DataSize-1 do
Msg:=Msg+hexstr(ord(PChar(DescPtr)[i]),2);
Msg:=Msg+HexStr(ord(PChar(DescPtr)[i]),2);
raise Exception.Create(Msg);
end;

2
lcl/postscriptcanvas.pas
View File

@ -1805,7 +1805,7 @@ begin
WriteB(Format('/scanline %d 3 mul string def',[ImgWidth]));
WriteB(Format('%d %d %d',[ImgWidth,ImgHeight,8]));
WriteB(Format('[%d %d %d %d %d %d]',[ImgWidth,0,0,-ImgHeight,0,ImgHeight]));
WriteB('{ currentfile scanline readhexstring pop } false 3');
WriteB('{ currentfile scanline readDbgSing pop } false 3');
WriteB('colorimage');
GetRGBImage(SrcGraphic,fBuffer);