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

replaced writeln by debugln

Browse Source 
git-svn-id: trunk@5455 -
This commit is contained in:
mattias 2004-05-11 11:42:27 +00:00
parent 647e922c40
commit a444f136c2
25 changed files with 808 additions and 734 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
ide/environmentopts.pp
View File

@ -35,7 +35,7 @@ uses
{$IFDEF IDE_MEM_CHECK}
MemCheck,
{$ENDIF}
Classes, SysUtils, FPCAdds, Forms, Controls, Buttons, GraphType, Graphics,
Classes, SysUtils, FPCAdds, LCLProc, Forms, Controls, Buttons, GraphType, Graphics,
Laz_XMLCfg, ObjectInspector, ExtCtrls, StdCtrls, Spin, EditorOptions,
LResources, LazConf, Dialogs, ExtToolDialog, IDEProcs, IDEOptionDefs,
InputHistory, LazarusIDEStrConsts, FileCtrl;

5
ide/project.pp
View File

@ -47,7 +47,7 @@ uses
{$IFDEF IDE_MEM_CHECK}
MemCheck,
{$ENDIF}
Classes, SysUtils, FPCAdds, LCLIntf, LCLType, Laz_XMLCfg, LazConf,
Classes, SysUtils, FPCAdds, LCLProc, LCLIntf, LCLType, Laz_XMLCfg, LazConf,
CompilerOptions, FileCtrl, CodeToolManager, CodeCache, Forms, Controls,
EditorOptions, Dialogs, IDEProcs, RunParamsOpts, ProjectDefs, EditDefineTree,
DefineTemplates, PackageDefs;
@ -2846,6 +2846,9 @@ end.
{
$Log$
Revision 1.154 2004/05/11 11:42:26 mattias
replaced writeln by debugln
Revision 1.153 2004/03/25 23:14:01 vincents
added Trace: to assert message

76
lcl/dbgrids.pas
View File

@ -37,7 +37,7 @@ unit DBGrids;
interface
uses
Classes, Graphics, SysUtils, LCLType, stdctrls, DB, LMessages, Grids,
Classes, LCLProc, Graphics, SysUtils, LCLType, stdctrls, DB, LMessages, Grids,
Controls;
Type
@ -230,9 +230,9 @@ end;
procedure TCustomDbGrid.OnRecordChanged(Field: TField);
begin
{$IfDef dbgdbgrid}
Write('(',name,') ','TCustomDBGrid.OnRecordChanged(Field=');
If Field=nil Then WriteLn('nil)')
Else WriteLn(Field.FieldName,')');
DBGOut('(',name,') ','TCustomDBGrid.OnRecordChanged(Field=');
If Field=nil Then DebugLn('nil)')
Else DebugLn(Field.FieldName,')');
{$Endif}
end;
@ -244,9 +244,9 @@ end;
procedure TCustomDbGrid.OnDataSetChanged(aDataSet: TDataSet);
begin
{$Ifdef dbgdbgrid}
Write('(',name,') ','TCustomDBDrid.OnDataSetChanged(aDataSet=');
If aDataSet=nil Then WriteLn('nil)')
Else WriteLn(aDataSet.Name,')');
DBGOut('(',name,') ','TCustomDBDrid.OnDataSetChanged(aDataSet=');
If aDataSet=nil Then DebugLn('nil)')
Else DebugLn(aDataSet.Name,')');
{$endif}
UpdateActive;
end;
@ -254,7 +254,7 @@ end;
procedure TCustomDbGrid.OnDataSetOpen(aDataSet: TDataSet);
begin
{$Ifdef dbgdbgrid}
WriteLn('(',name,') ','TCustomDBGrid.OnDataSetOpen');
DebugLn('(',name,') ','TCustomDBGrid.OnDataSetOpen');
{$endif}
LinkActive(True);
UpdateActive;
@ -263,7 +263,7 @@ end;
procedure TCustomDbGrid.OnDataSetClose(aDataSet: TDataSet);
begin
{$ifdef dbgdbgrid}
WriteLn('(',name,') ','TCustomDBGrid.OnDataSetClose');
DebugLn('(',name,') ','TCustomDBGrid.OnDataSetClose');
{$endif}
LinkActive(False);
end;
@ -271,7 +271,7 @@ end;
procedure TCustomDbGrid.OnInvalidDataSet(aDataSet: TDataSet);
begin
{$ifdef dbgdbgrid}
WriteLn('(',name,') ','TCustomDBGrid.OnInvalidDataSet');
DebugLn('(',name,') ','TCustomDBGrid.OnInvalidDataSet');
{$endif}
LinkActive(False);
end;
@ -279,7 +279,7 @@ end;
procedure TCustomDbGrid.OnInvalidDataSource(aDataSet: TDataset);
begin
{$ifdef dbgdbgrid}
WriteLn('(',name,') ','TCustomDBGrid.OnInvalidDataSource');
DebugLn('(',name,') ','TCustomDBGrid.OnInvalidDataSource');
{$endif}
LinkActive(False);
end;
@ -287,7 +287,7 @@ end;
procedure TCustomDbGrid.OnNewDataSet(aDataSet: TDataset);
begin
{$ifdef dbgdbgrid}
WriteLn('(',name,') ','TCustomDBGrid.OnNewDataSet');
DebugLn('(',name,') ','TCustomDBGrid.OnNewDataSet');
{$endif}
LinkActive(True);
UpdateActive;
@ -296,7 +296,7 @@ end;
procedure TCustomDbGrid.OnDataSetScrolled(aDataset: TDataSet; Distance: Integer);
begin
{$ifdef dbgdbgrid}
WriteLn(ClassName, ' (',name,')', '.OnDataSetScrolled(',Distance,'), Invalidating');
DebugLn(ClassName, ' (',name,')', '.OnDataSetScrolled(',Distance,'), Invalidating');
{$endif}
UpdateActive;
If Distance<>0 Then Invalidate;
@ -317,7 +317,7 @@ begin
//Else
// FDataLink.BufferCount:=0;
{$ifdef dbgdbgrid}
WriteLn(ClassName, ' (',name,')', ' FdataLink.BufferCount=',Fdatalink.BufferCount);
DebugLn(ClassName, ' (',name,')', ' FdataLink.BufferCount=',Fdatalink.BufferCount);
{$endif}
End;
end;
@ -334,14 +334,14 @@ Var
begin
Inherited;
if Not GCache.ValidGrid Then Exit;
WriteLn('VSCROLL: Code=',Message.ScrollCode,' Position=', Message.Pos);
DebugLn('VSCROLL: Code=',dbgs(Message.ScrollCode),' Position=', dbgs(Message.Pos));
exit;
C:=Message.Pos+GCache.Fixedheight;
Num:=(FNumRecords + FixedRows) * DefaultRowHeight;
TL:= Num div C;
GCache.TLRowOff:= C - TL*DefaultRowHeight;
WriteLn('---- Offset=',C, ' ScrollTo=> TL=',TL, ' TLRowOFf=', GCache.TLRowOff);
DebugLn('---- Offset=',dbgs(C), ' ScrollTo=> TL=',dbgs(TL), ' TLRowOFf=', dbgs(GCache.TLRowOff));
end;
@ -373,8 +373,8 @@ begin
FNumRecords:= FDataLink.DataSet.RecordCount;
{$ifdef dbgdbgrid}
WriteLn('(',name,') ','TCustomGrid.LayoutChanged INIT');
WriteLn('DataLink.DataSet.recordcount: ',FNumRecords);
DebugLn('(',name,') ','TCustomGrid.LayoutChanged INIT');
DebugLn('DataLink.DataSet.recordcount: ',FNumRecords);
{$endif}
FLayoutChanging:=True; // Avoid infinit loop
@ -387,7 +387,7 @@ begin
ColWidths[0]:=12;
FDefs:=FDataLink.DataSet.FieldDefs;
For i:=0 to FDefs.Count-1 do Begin
//WriteLn('Field ',FDefs[i].Name, ' Size= ',FDefs[i].Size);
//DebugLn('Field ',FDefs[i].Name, ' Size= ',FDefs[i].Size);
ColWidths[i+1]:= DefaultFieldColWidth(FDefs[i].DataType);
End;
FVisualLock:=False;
@ -406,12 +406,12 @@ begin
W:=F.DisplayWidth;
If W<0 Then W:=0;
If W=0 Then W:=F.GetDefaultwidth;
WriteLn('Field ',F.FieldName,' DisplayWidth=', W);
DebugLn('Field ',F.FieldName,' DisplayWidth=', W);
End;
End;
}
{$ifdef dbgdbgrid}
WriteLn('(',name,') ','TCustomGrid.LayoutChanged - DONE');
DebugLn('(',name,') ','TCustomGrid.LayoutChanged - DONE');
{$endif}
FLayoutChanging:=False;
End;
@ -425,7 +425,7 @@ begin
With FDataLink do begin
Result:=Active;
{$ifdef dbgdbgrid}
WriteLn('(',name,') ',
DebugLn('(',name,') ',
'BeyondRowCount Hitted here: Count=',Count,
' FDataLink.Active=', Result,
' FDataLink.EOF=',EOF);
@ -438,7 +438,7 @@ begin
If not EOF Then begin
I:=MoveBy(Count);
{$Ifdef dbgdbgrid}
WriteLn('Scrolled by ',I);
DebugLn('Scrolled by ',I);
{$Endif}
End;
End;
@ -451,7 +451,7 @@ begin
With FDataLink do Begin
Result:=Active;
{$ifdef dbgdbgrid}
WriteLn('(',name,') ',
DebugLn('(',name,') ',
'BelowFirstRow Hitted here: Count=',Count,
' FDataLink.Active=', Result,
' FDataLink.BOF=',BOF);
@ -462,7 +462,7 @@ begin
Else begin
I:=MoveBy(-Count);
{$Ifdef dbgdbgrid}
WriteLn('Scrolled By ', I);
DebugLn('Scrolled By ', I);
{$Endif}
End;
End;
@ -657,7 +657,7 @@ begin
With FDataLink do begin
If Not GCache.ValidGrid then Exit;
If DataSource=nil Then Exit;
WriteLn('(',Name,') ActiveRecord=', ActiveRecord, ' FixedRows=',FixedRows, ' Row=', Row);
DebugLn('(',Name,') ActiveRecord=', dbgs(ActiveRecord), ' FixedRows=',dbgs(FixedRows), ' Row=', dbgs(Row));
Row:= FixedRows + ActiveRecord;
{
LastRow:=Row;
@ -735,7 +735,7 @@ end;
procedure TComponentDataLink.RecordChanged(Field: TField);
begin
{$ifdef dbgdbgrid}
WriteLn('TComponentDataLink.RecordChanged');
DebugLn('TComponentDataLink.RecordChanged');
{$endif}
If Assigned(OnRecordChanged) Then OnRecordChanged(Field);
end;
@ -743,7 +743,7 @@ end;
procedure TComponentDataLink.DataSetChanged;
begin
{$ifdef dbgdbgrid}
WriteLn('TComponentDataLink.DataSetChanged');
DebugLn('TComponentDataLink.DataSetChanged');
{$Endif}
If Assigned(OnDataSetChanged) Then OnDataSetChanged(DataSet);
end;
@ -751,7 +751,7 @@ end;
procedure TComponentDataLink.ActiveChanged;
begin
{$ifdef dbgdbgrid}
WriteLn('TComponentDataLink.ActiveChanged');
DebugLn('TComponentDataLink.ActiveChanged');
{$endif}
if Active then begin
fDataSet := DataSet;
@ -782,14 +782,14 @@ procedure TComponentDataLink.LayoutChanged;
begin
Inherited LayoutChanged;
{$ifdef dbgdbgrid}
WriteLn('TComponentDataLink.LayoutChanged');
DebugLn('TComponentDataLink.LayoutChanged');
{$endif}
end;
procedure TComponentDataLink.DataSetScrolled(Distance: Integer);
begin
{$ifdef dbgdbgrid}
WriteLn('TComponentDataLink.DataSetScrolled(',Distance,')');
DebugLn('TComponentDataLink.DataSetScrolled(',Distance,')');
{$endif}
if Assigned(OnDataSetScrolled) Then OnDataSetScrolled(DataSet, Distance);
end;
@ -797,7 +797,7 @@ end;
procedure TComponentDataLink.FocusControl(Field: TFieldRef);
begin
{$ifdef dbgdbgrid}
WriteLn('TComponentDataLink.FocusControl');
DebugLn('TComponentDataLink.FocusControl');
{$endif}
end;
@ -805,7 +805,7 @@ procedure TComponentDataLink.CheckBrowseMode;
begin
(*
{$ifdef dbgdbgrid}
WriteLn(ClassName,'.CheckBrowseMode');
DebugLn(ClassName,'.CheckBrowseMode');
{$endif}
*)
inherited CheckBrowseMode;
@ -814,7 +814,7 @@ end;
procedure TComponentDataLink.EditingChanged;
begin
{$ifdef dbgdbgrid}
WriteLn(ClassName,'.EditingChanged');
DebugLn(ClassName,'.EditingChanged');
{$endif}
inherited EditingChanged;
end;
@ -823,7 +823,7 @@ procedure TComponentDataLink.UpdateData;
begin
(*
{$ifdef dbgdbgrid}
WriteLn(ClassName,'.UpdateData');
DebugLn(ClassName,'.UpdateData');
{$endif}
*)
inherited UpdateData;
@ -833,13 +833,13 @@ function TComponentDataLink.MoveBy(Distance: Integer): Integer;
begin
(*
{$ifdef dbgdbgrid}
WriteLn(ClassName,'.MoveBy INIT: Distance=',Distance);
DebugLn(ClassName,'.MoveBy INIT: Distance=',Distance);
{$endif}
*)
Result:=inherited MoveBy(Distance);
(*
{$ifdef dbgdbgrid}
WriteLn(ClassName,'.MoveBy END: Distance=',Distance);
DebugLn(ClassName,'.MoveBy END: Distance=',Distance);
{$endif}
*)
end;
@ -847,7 +847,7 @@ end;
procedure TComponentDataLink.Modified;
begin
{$ifdef dbgdbgrid}
WriteLn(ClassName,'.Modified');
DebugLn(ClassName,'.Modified');
{$Endif}
FModified:=True;
end;

12
lcl/dynamicarray.pas
View File

@ -93,7 +93,7 @@ Procedure Tarray.Clear;
Var
i: Integer;
Begin
{$Ifdef dbgMem}WriteLn('TArray.Clear');{$endif}
{$Ifdef dbgMem}DebugLn('TArray.Clear');{$endif}
For i:=0 to FCols.Count-1 do begin
ClearCol(TList(FCols[i]), i);
TList(FCols[i]).Free;
@ -109,7 +109,7 @@ End;
Destructor Tarray.Destroy;
Begin
{$Ifdef dbgMem}WriteLn('TArray.Destroy FCols.Count=',FCols.Count);{$endif}
{$Ifdef dbgMem}DebugLn('TArray.Destroy FCols.Count=',dbgs(FCols.Count));{$endif}
Clear;
FCols.free;
Inherited Destroy;
@ -120,7 +120,7 @@ var
i,j: Integer;
P:Pointer;
begin
//WriteLn('TArray.Aumentar_Rows: Col=',Col,' Rows=',Rows);
//DebugLn('TArray.Aumentar_Rows: Col=',Col,' Rows=',Rows);
i:=L.Count;
j:=Rows-L.Count;
While j>0 do begin
@ -143,7 +143,7 @@ Var
L: TList;
//P: Pointer;
Begin
{$IfDef DbgMem}WriteLn('TArray.SetLength: Cols=',Cols,' Rows=',Rows);{$Endif}
{$IfDef DbgMem}DebugLn('TArray.SetLength: Cols=',dbgs(Cols),' Rows=',dbgs(Rows));{$Endif}
//
// Ajustar columnas
//
@ -180,7 +180,7 @@ Var
L: TList;
begin
If IsColumn Then begin
{$Ifdef dbgMem}WriteLn('TArray.DeleteColRow Col=',Index);{$endif}
{$Ifdef dbgMem}DebugLn('TArray.DeleteColRow Col=',dbgs(Index));{$endif}
L:=TList(FCols[Index]);
If L<>nil then begin
ClearCol(L, Index);
@ -188,7 +188,7 @@ begin
L.Free;
End;
End Else begin
{$Ifdef dbgMem}WriteLn('TArray.DeleteColRow Row=',Index);{$endif}
{$Ifdef dbgMem}DebugLn('TArray.DeleteColRow Row=',dbgs(Index));{$endif}
For i:=0 to fCols.Count-1 do begin
L:=TList(fcols[i]);
If L<>nil then Begin

2
lcl/editbtn.pas
View File

@ -27,7 +27,7 @@ unit EditBtn;
interface
uses
Classes, SysUtils, FPCAdds, LResources, LCLStrConsts, LCLType, LMessages,
Classes, SysUtils, LCLProc, LResources, LCLStrConsts, LCLType, LMessages,
Graphics, Controls, Forms, Dialogs, StdCtrls, Buttons, Calendar, ExtDlgs;
type

2
lcl/extdlgs.pas
View File

@ -27,7 +27,7 @@ unit ExtDlgs;
interface
uses
Classes, SysUtils, FPCAdds, LResources, VCLGlobals, LCLType, LCLStrConsts,
Classes, SysUtils, LCLProc, LResources, VCLGlobals, LCLType, LCLStrConsts,
Controls, Dialogs, GraphType, Graphics, ExtCtrls, StdCtrls, Forms, FileCtrl,
Calendar, Buttons;

48
lcl/fpcadds.pas
View File

@ -26,7 +26,7 @@ unit FPCAdds;
interface
uses
Classes, SysUtils;
Classes, SysUtils;
// current TStream calculates in int64, old in longint
type
@ -38,53 +38,7 @@ type
PCardinal = ^Cardinal;
{$ENDIF}
function RoundToInt(const e: Extended): integer;
function RoundToCardinal(const e: Extended): cardinal;
function TruncToInt(const e: Extended): integer;
function TruncToCardinal(const e: Extended): cardinal;
function StrToDouble(const s: string): double;
implementation
function RoundToInt(const e: Extended): integer;
begin
Result:=integer(Round(e));
{$IFDEF VerboseRound}
writeln('RoundToInt ',e,' ',Result);
{$ENDIF}
end;
function RoundToCardinal(const e: Extended): cardinal;
begin
Result:=cardinal(Round(e));
{$IFDEF VerboseRound}
writeln('RoundToCardinal ',e,' ',Result);
{$ENDIF}
end;
function TruncToInt(const e: Extended): integer;
begin
Result:=integer(Trunc(e));
{$IFDEF VerboseRound}
writeln('TruncToInt ',e,' ',Result);
{$ENDIF}
end;
function TruncToCardinal(const e: Extended): cardinal;
begin
Result:=cardinal(Trunc(e));
{$IFDEF VerboseRound}
writeln('TruncToCardinal ',e,' ',Result);
{$ENDIF}
end;
function StrToDouble(const s: string): double;
begin
{$IFDEF VerboseRound}
writeln('StrToDouble "',s,'"');
{$ENDIF}
Result:=Double(StrToFloat(s));
end;
end.

9
lcl/graphmath.pp
View File

@ -35,7 +35,7 @@ unit GraphMath;
interface
Uses
Classes, SysUtils, Math, FPCAdds;
Classes, SysUtils, Math, LCLProc;
Type
TFloatPoint = Record
@ -279,8 +279,8 @@ end;
Operator := (Value : TFloatPoint) : TPoint;
begin
With Result do begin
X := FPCAdds.RoundToInt(Value.X);
Y := RoundToInt(Value.Y);
X := LCLProc.RoundToInt(Value.X);
Y := LCLProc.RoundToInt(Value.Y);
end;
end;
@ -1084,6 +1084,9 @@ end.
{ =============================================================================
$Log$
Revision 1.6 2004/05/11 11:42:26 mattias
replaced writeln by debugln
Revision 1.5 2003/12/25 14:17:07 mattias
fixed many range check warnings

41
lcl/graphtype.pp
View File

@ -248,7 +248,7 @@ begin
or (RawImage^.Description.Width=0) or (RawImage^.Description.Height=0)
or (RawImage^.Description.AlphaPrec=0) then begin
{$IFDEF VerboseRawImage}
writeln('RawImageMaskIsEmpty Quicktest: empty');
DebugLn'RawImageMaskIsEmpty Quicktest: empty');
{$ENDIF}
exit;
end;
@ -276,7 +276,7 @@ begin
if p^<>$ff then begin
// not all bits set -> transparent pixels found -> Mask needed
{$IFDEF VerboseRawImage}
writeln('RawImageMaskIsEmpty FullByte y=',y,' x=',x,' Byte=',HexStr(Cardinal(p^),2));
DebugLn'RawImageMaskIsEmpty FullByte y=',y,' x=',x,' Byte=',HexStr(Cardinal(p^),2));
{$ENDIF}
exit;
end;
@ -287,7 +287,7 @@ begin
if (p^ or UnusedByteMask)<>$ff then begin
// not all bits set -> transparent pixels found -> Mask needed
{$IFDEF VerboseRawImage}
writeln('RawImageMaskIsEmpty EdgeByte y=',y,' x=',x,' Byte=',HexStr(Cardinal(p^),2),' UnusedByteMask=',HexStr(Cardinal(UnusedByteMask),2),' UnusedBitsAtEnd=',UnusedBitsAtEnd);
DebugLn'RawImageMaskIsEmpty EdgeByte y=',y,' x=',x,' Byte=',HexStr(Cardinal(p^),2),' UnusedByteMask=',HexStr(Cardinal(UnusedByteMask),2),' UnusedBitsAtEnd=',UnusedBitsAtEnd);
{$ENDIF}
exit;
end;
@ -297,13 +297,13 @@ begin
end else begin
// ToDo: AlphaSeparate and rileTight
{$IFDEF VerboseRawImage}
writeln('RawImageMaskIsEmpty TODO');
DebugLn'RawImageMaskIsEmpty TODO');
{$ENDIF}
exit;
end;
end else begin
{$IFDEF VerboseRawImage}
writeln('RawImageMaskIsEmpty TODO');
DebugLn'RawImageMaskIsEmpty TODO');
{$ENDIF}
exit;
end;
@ -311,7 +311,7 @@ begin
Result:=true;
end;
{$IFDEF VerboseRawImage}
writeln('RawImageMaskIsEmpty Empty=',Result);
DebugLn'RawImageMaskIsEmpty Empty=',Result);
{$ENDIF}
end;
@ -444,7 +444,7 @@ procedure ExtractRawImageRect(SrcRawImage: PRawImage; const SrcRect: TRect;
var
SrcMaskDesc, DestMaskDesc: TRawImageDescription;
begin
//writeln('ExtractRawImageRect SrcRawImage=',RawImageDescriptionAsString(@SrcRawImage^.Description),
//DebugLn'ExtractRawImageRect SrcRawImage=',RawImageDescriptionAsString(@SrcRawImage^.Description),
// ' SrcRect=',SrcRect.Left,',',SrcRect.Top,',',SrcRect.Right,',',SrcRect.Bottom);
// copy description
@ -454,12 +454,12 @@ begin
ExtractRawImageDataRect(@SrcRawImage^.Description,SrcRect,SrcRawImage^.Data,
@DestRawImage^.Description,DestRawImage^.Data,DestRawImage^.DataSize);
// extract rectangle from separate Alpha
//writeln('ExtractRawImageDataRect data=',HexStr(Cardinal(DestRawImage^.Data),8),' Size=',DestRawImage^.DataSize);
//DebugLn'ExtractRawImageDataRect data=',HexStr(Cardinal(DestRawImage^.Data),8),' Size=',DestRawImage^.DataSize);
if SrcRawImage^.Description.AlphaSeparate
and (SrcRawImage^.Mask<>nil) then begin
CreateRawImageDescFromMask(@SrcRawImage^.Description,@SrcMaskDesc);
//writeln('ExtractRawImageRect Mask SrcRawImage=',RawImageDescriptionAsString(@SrcMaskDesc));
//DebugLn'ExtractRawImageRect Mask SrcRawImage=',RawImageDescriptionAsString(@SrcMaskDesc));
ExtractRawImageDataRect(@SrcMaskDesc,SrcRect,SrcRawImage^.Mask,
@DestMaskDesc,DestRawImage^.Mask,DestRawImage^.MaskSize);
end;
@ -506,10 +506,10 @@ begin
// allocate Data
DestRawImageDesc^.Width:=SrcWidth;
DestRawImageDesc^.Height:=SrcHeight;
//writeln('ExtractRawImageDataRect Src=',SrcWidth,',',SrcHeight,' DestData=',HexStr(Cardinal(DestData),8));
//DebugLn'ExtractRawImageDataRect Src=',SrcWidth,',',SrcHeight,' DestData=',HexStr(Cardinal(DestData),8));
CreateRawImageData(SrcWidth,SrcHeight,BitsPerPixel,LineEnd,
DestData,DestDataSize);
//writeln('ExtractRawImageDataRect data=',HexStr(Cardinal(DestData),8),' Size=',DestDataSize);
//DebugLn'ExtractRawImageDataRect data=',HexStr(Cardinal(DestData),8),' Size=',DestDataSize);
if (SrcWidth=TotalWidth) and (TotalHeight=SrcHeight) then begin
// copy whole source
System.Move(SrcData^,DestData^,DestDataSize);
@ -534,7 +534,7 @@ begin
SrcLineEndPosition);
GetRawImageXYPosition(DestRawImageDesc,DestLineStarts,0,y,
DestLineStartPosition);
//writeln('ExtractRawImageDataRect A y=',y,' SrcByte=',SrcLineStartPosition.Byte,' SrcBit=',SrcLineStartPosition.Bit,
//DebugLn'ExtractRawImageDataRect A y=',y,' SrcByte=',SrcLineStartPosition.Byte,' SrcBit=',SrcLineStartPosition.Bit,
//' DestByte=',DestLineStartPosition.Byte,' DestBit=',DestLineStartPosition.Bit);
if (SrcLineStartPosition.Bit=0)
and (DestLineStartPosition.Bit=0) then begin
@ -542,7 +542,7 @@ begin
ByteCount:=SrcLineEndPosition.Byte-SrcLineStartPosition.Byte;
if SrcLineEndPosition.Bit>0 then
inc(ByteCount);
//writeln('ExtractRawImageDataRect B ByteCount=',ByteCount);
//DebugLn'ExtractRawImageDataRect B ByteCount=',ByteCount);
System.Move(
Pointer(Cardinal(SrcData)+SrcLineStartPosition.Byte)^,
Pointer(Cardinal(DestData)+DestLineStartPosition.Byte)^,
@ -561,7 +561,7 @@ begin
inc(DestPos);
end;
end else begin
writeln('ToDo: ExtractRawImageRect DestLineStartPosition.Bit>0');
DebugLn('ToDo: ExtractRawImageRect DestLineStartPosition.Bit>0');
break;
end;
end;
@ -676,7 +676,7 @@ begin
P:=@(TheData[Position.Byte]);
PrecMask:=(Cardinal(1) shl Prec)-1;
Bits:=Bits shr (16-Prec);
{writeln('WriteDataBits WRITE Position=',Position.Byte,'/',Position.Bit,
{DebugLn'WriteDataBits WRITE Position=',Position.Byte,'/',Position.Bit,
' Shift=',Shift,' Prec=',Prec,' BitsPerPixel=',BitsPerPixel,
' PrecMask=',HexStr(Cardinal(PrecMask),4),
' Bits=',HexStr(Cardinal(Bits),4),
@ -693,7 +693,7 @@ begin
OneByte:=OneByte and PrecMask; // clear old
OneByte:=OneByte or (Bits shl ShiftLeft); // set new
P^:=OneByte;
//writeln('WriteDataBits 1,2,4 Result=',HexStr(Cardinal(OneByte),2));
//DebugLn'WriteDataBits 1,2,4 Result=',HexStr(Cardinal(OneByte),2));
end;
8: begin
OneByte:=P^;
@ -701,7 +701,7 @@ begin
OneByte:=OneByte and PrecMask; // clear old
OneByte:=OneByte or (Bits shl Shift); // set new
P^:=OneByte;
//writeln('WriteDataBits 8 Result=',HexStr(Cardinal(OneByte),2));
//DebugLn'WriteDataBits 8 Result=',HexStr(Cardinal(OneByte),2));
end;
16: begin
TwoBytes:=PWord(P)^;
@ -709,7 +709,7 @@ begin
TwoBytes:=TwoBytes and PrecMask; // clear old
TwoBytes:=TwoBytes or (Bits shl Shift); // set new
PWord(P)^:=TwoBytes;
//writeln('WriteDataBits 16 Result=',HexStr(Cardinal(TwoBytes),4));
//DebugLn'WriteDataBits 16 Result=',HexStr(Cardinal(TwoBytes),4));
end;
32: begin
FourBytes:=PDWord(P)^;
@ -717,7 +717,7 @@ begin
FourBytes:=FourBytes and PrecMask; // clear old
FourBytes:=FourBytes or cardinal(Bits shl Shift); // set new
PDWord(P)^:=FourBytes;
//writeln('WriteDataBits 32 Result=',HexStr(Cardinal(FourBytes),8));
//DebugLn'WriteDataBits 32 Result=',HexStr(Cardinal(FourBytes),8));
end;
end;
end;
@ -767,6 +767,9 @@ end.
{ =============================================================================
$Log$
Revision 1.31 2004/05/11 11:42:26 mattias
replaced writeln by debugln
Revision 1.30 2004/04/02 19:39:46 mattias
fixed checking empty mask raw image

35
lcl/include/application.inc
View File

@ -133,10 +133,10 @@ begin
if Assigned(MessageBoxFunction) then
Result:=MessageBoxFunction(Text,Caption,Flags)
else begin
writeln('WARNING: TApplication.MessageBox: no MessageBoxFunction');
writeln(' Caption="',Caption,'"');
writeln(' Text="',Text,'"');
writeln(' Flags=',HexStr(Cardinal(Flags),8));
DebugLn('WARNING: TApplication.MessageBox: no MessageBoxFunction');
DebugLn(' Caption="',Caption,'"');
DebugLn(' Text="',Text,'"');
DebugLn(' Flags=',HexStr(Cardinal(Flags),8));
Result:=0;
end;
end;
@ -216,7 +216,7 @@ begin
// or (AnsiCompareText(InterfaceObject.Classname,'TWIDGETSET')=0)
or (InterfaceObject.ClassType = TWidgetSet)
then begin
writeln('ERROR: ',rsNoInterfaceObject);
DebugLn('ERROR: ',rsNoInterfaceObject);
raise Exception.Create(rsNoInterfaceObject);
end;
InterfaceObject.AppInit;
@ -362,16 +362,16 @@ begin
else
write(' Old=nil');
if NewMouseControl<>nil then
writeln(' New=',NewMouseControl.Name,':',NewMouseControl.ClassName)
DebugLn' New=',NewMouseControl.Name,':',NewMouseControl.ClassName)
else
writeln(' New=nil');}
DebugLn' New=nil');}
if (FMouseControl<>nil) then begin
//writeln(' MOUSELEAVE=',FMouseControl.Name,':',FMouseControl.ClassName);
//DebugLn' MOUSELEAVE=',FMouseControl.Name,':',FMouseControl.ClassName);
FMouseControl.Perform(CM_MOUSELEAVE, 0, 0);
end;
FMouseControl := NewMouseControl;
if (FMouseControl<>nil) then begin
//writeln(' MOUSEENTER=',FMouseControl.Name,':',FMouseControl.ClassName);
//DebugLn' MOUSEENTER=',FMouseControl.Name,':',FMouseControl.ClassName);
FMouseControl.Perform(CM_MOUSEENTER, 0, 0);
end;
end;
@ -487,7 +487,7 @@ var
Info: THintInfoAtMouse;
begin
Info:=GetHintInfoAtMouse;
//writeln('TApplication.DoOnMouseMove Info.ControlHasHint=',Info.ControlHasHint,' Type=',ord(FHintTimerType));
//DebugLn'TApplication.DoOnMouseMove Info.ControlHasHint=',Info.ControlHasHint,' Type=',ord(FHintTimerType));
if FHintControl <> Info.Control then
begin
if Info.ControlHasHint then
@ -601,7 +601,7 @@ begin
StartHintTimer(HintHidePause,ahtHideHint);
end else
HideHint;
//writeln('TApplication.ShowHintWindow Info.ControlHasHint=',Info.ControlHasHint,' Type=',ord(FHintTimerType));
//DebugLn'TApplication.ShowHintWindow Info.ControlHasHint=',Info.ControlHasHint,' Type=',ord(FHintTimerType));
end;
{------------------------------------------------------------------------------
@ -632,7 +632,7 @@ var
Info: THintInfoAtMouse;
OldHintTimerType: TAppHintTimerType;
begin
//writeln('TApplication.OnHintTimer Type=',ord(FHintTimerType));
//DebugLn'TApplication.OnHintTimer Type=',ord(FHintTimerType));
OldHintTimerType:=FHintTimerType;
StopHintTimer;
case OldHintTimerType of
@ -722,7 +722,7 @@ begin
if Self=nil then exit;
if AppHandlingException in FFlags then begin
// there was an exception during showing the exception -> break the circle
writeln('TApplication.HandleException: ',
DebugLn('TApplication.HandleException: ',
'there was another exception during showing the first exception');
HaltingProgram:=true;
Halt;
@ -732,9 +732,9 @@ begin
inherited Terminate;
// before we do anything, write it down
if ExceptObject is Exception then begin
writeln('TApplication.HandleException ',Exception(ExceptObject).Message);
DebugLn('TApplication.HandleException ',Exception(ExceptObject).Message);
end else begin
writeln('TApplication.HandleException Strange Exception ');
DebugLn('TApplication.HandleException Strange Exception ');
end;
// release capture and hide all forms with stay on top, so that
// a message can be shown
@ -821,7 +821,7 @@ begin
for i:=0 to Screen.CustomFormCount-1 do begin
AForm:=Screen.CustomForms[i];
if AForm.FormStyle=fsStayOnTop then begin
writeln('TApplication.HideAllFormsWithStayOnTop ',AForm.Name,':',AForm.ClassName);
DebugLn('TApplication.HideAllFormsWithStayOnTop ',AForm.Name,':',AForm.ClassName);
AForm.Hide;
end;
end;
@ -1179,6 +1179,9 @@ end;
{ =============================================================================
$Log$
Revision 1.79 2004/05/11 11:42:26 mattias
replaced writeln by debugln
Revision 1.78 2004/04/10 17:58:56 mattias
implemented mainunit hints for include files

51
lcl/include/bitmap.inc
View File

@ -53,13 +53,13 @@ var
begin
if Source=Self then exit;
if Source is TBitmap then begin
//writeln('TBitMap.Assign ',ClassName,' ',Source.ClassName);
//DebugLn('TBitMap.Assign ',ClassName,' ',Source.ClassName);
// TBitmap can share image data
// -> check if already shared
SrcBitmap:=TBitmap(Source);
if SrcBitmap.FImage=FImage then exit;
//writeln('TBitMap.Assign A RefCount=',FImage.RefCount);
//DebugLn('TBitMap.Assign A RefCount=',FImage.RefCount);
// image is not shared => new image data
// -> free canvas (interface handles)
FreeCanvasContext;
@ -68,7 +68,7 @@ begin
// share FImage with assign graphic
FImage:=SrcBitmap.FImage;
FImage.Reference;
//writeln('TBitMap.Assign B ',Width,',',Height,' ',HandleAllocated,' RefCount=',FImage.RefCount);
//DebugLn('TBitMap.Assign B ',Width,',',Height,' ',HandleAllocated,' RefCount=',FImage.RefCount);
{$IFNDEF DisableFPImage}
end else if Source is TFPCustomImage then begin
SrcFPImage:=TFPCustomImage(Source);
@ -188,11 +188,11 @@ var
NewRawImage: TRawImage;
ImgHandle, ImgMaskHandle: HBitmap;
begin
writeln('TBitmap.CreateFromBitmapHandles A ',SrcRect.Left,',',SrcRect.Top,',',SrcRect.Right,',',SrcRect.Bottom);
DebugLn('TBitmap.CreateFromBitmapHandles A SrcRect=',dbgs(SrcRect));
if not GetRawImageFromBitmap(SrcBitmap,SrcMaskBitmap,SrcRect,NewRawImage) then
raise EInvalidGraphicOperation.Create('TBitmap.CreateFromBitmapHandles Get RawImage');
try
writeln('TBitmap.CreateFromBitmapHandles A ',SrcRect.Left,',',SrcRect.Top,',',SrcRect.Right,',',SrcRect.Bottom);
DebugLn('TBitmap.CreateFromBitmapHandles B SrRect=',dbgs(SrcRect));
if not CreateBitmapFromRawImage(NewRawImage,ImgHandle,ImgMaskHandle,false) then
raise EInvalidGraphicOperation.Create('TBitmap.CreateFromBitmapHandles Create bitmaps');
Handle:=ImgHandle;
@ -211,7 +211,7 @@ end;
procedure TBitMap.Mask(ATransparentColor: TColor);
begin
writeln('TBitMap.Mask not implemented');
DebugLn('TBitMap.Mask not implemented');
end;
function TBitmap.GetHandle: HBITMAP;
@ -235,7 +235,7 @@ end;
procedure TBitmap.SetHandleType(Value: TBitmapHandleType);
begin
if HandleType=Value then exit;
writeln('TBitmap.SetHandleType TBitmap.SetHandleType not implemented');
DebugLn('TBitmap.SetHandleType TBitmap.SetHandleType not implemented');
end;
procedure TBitmap.SetMonochrome(const AValue: Boolean);
@ -317,7 +317,7 @@ begin
if UseWidth<1 then UseWidth:=1;
if UseHeight<1 then UseHeight:=1;
FImage.FHandle:= CreateBitmap(UseWidth, UseHeight, 1, n, nil);
//writeln('TBitMap.HandleNeeded Self=',HexStr(Cardinal(Self),8),' FImage.FHandle=',HexStr(Cardinal(FImage.FHandle),8),' n=',n);
//DebugLn('TBitMap.HandleNeeded Self=',HexStr(Cardinal(Self),8),' FImage.FHandle=',HexStr(Cardinal(FImage.FHandle),8),' n=',n);
FImage.FDIB.dsbm.bmWidth := Width;
FImage.FDIB.dsbm.bmHeight := Height;
end;
@ -353,12 +353,12 @@ end;
procedure TBitMap.LoadFromResourceName(Instance: THandle; const ResName: String);
begin
writeln('ToDo: TBitMap.LoadFromResourceName');
DebugLn('ToDo: TBitMap.LoadFromResourceName');
end;
procedure TBitMap.LoadFromResourceID(Instance: THandle; ResID: Integer);
begin
writeln('ToDo: TBitMap.LoadFromResourceID');
DebugLn('ToDo: TBitMap.LoadFromResourceID');
end;
procedure TBitmap.GetSupportedSourceMimeTypes(List: TStrings);
@ -418,7 +418,7 @@ var
{$ENDIF}
begin
if (FImage.RefCount>1) then begin
//writeln('TBitmap.UnshareImage ',ClassName,' ',Width,',',Height,' ',HexStr(Cardinal(Self),8));
//DebugLn('TBitmap.UnshareImage ',ClassName,' ',Width,',',Height,' ',HexStr(Cardinal(Self),8));
// release old FImage and create a new one
NewImage:=TBitmapImage.Create;
try
@ -442,21 +442,21 @@ begin
FreeCanvasContext;
OldImage:=FImage;
FImage:=NewImage;
//writeln('TBitMap.UnshareImage Self=',HexStr(Cardinal(Self),8),' FImage.FHandle=',HexStr(Cardinal(FImage.FHandle),8));
//DebugLn('TBitMap.UnshareImage Self=',HexStr(Cardinal(Self),8),' FImage.FHandle=',HexStr(Cardinal(FImage.FHandle),8));
NewImage:=nil; // transaction sucessful
OldImage.Release;
finally
// in case something goes wrong, keep old and free new
NewImage.Free;
end;
//writeln('TBitmap.UnshareImage END ',ClassName,' ',Width,',',Height,' ',HexStr(Cardinal(Self),8));
//DebugLn('TBitmap.UnshareImage END ',ClassName,' ',Width,',',Height,' ',HexStr(Cardinal(Self),8));
end;
end;
procedure TBitmap.FreeSaveStream;
begin
if FImage.FSaveStream<>nil then begin
//writeln('TBitmap.FreeSaveStream A ',ClassName,' ',FImage.FSaveStream.Size);
//DebugLn('TBitmap.FreeSaveStream A ',ClassName,' ',FImage.FSaveStream.Size);
end;
FreeAndNil(FImage.FSaveStream);
FImage.SaveStreamType:=bnNone;
@ -807,7 +807,7 @@ begin
DoWriteOriginal;
exit;
end;
writeln('TBitmap.WriteStream A Warning: creating BMP does not always work ',FImage.SaveStream<>nil,' ',ord(FImage.SaveStreamType),'. Please use FPImage.');
DebugLn('TBitmap.WriteStream A Warning: creating BMP does not always work ',FImage.SaveStream<>nil,' ',ord(FImage.SaveStreamType),'. Please use FPImage.');
// write image in BMP format to temporary stream
MemStream:=TMemoryStream.Create;
@ -910,7 +910,7 @@ begin
ImgSize:=SrcStream.Position-OldStreamPosition;
if not UseSize then begin
// now the size is known -> store stream
//writeln('TBitmap.ReadStreamWithFPImage SrcStream=',SrcStream.ClassName,' ImgSize=',ImgSize);
//DebugLn('TBitmap.ReadStreamWithFPImage SrcStream=',SrcStream.ClassName,' ImgSize=',ImgSize);
SrcStream.Position:=OldStreamPosition;
StoreOriginal(SrcStream,integer(ImgSize));
end else begin
@ -936,7 +936,7 @@ procedure TBitmap.WriteStreamWithFPImage(Stream: TStream; WriteSize: boolean;
Procedure DoWriteStreamSize(DestStream: TStream; Size: longint);
begin
//writeln('DoWriteStreamSize ',ClassName,' Size=',Size,' WriteSize=',WriteSize);
//DebugLn('DoWriteStreamSize ',ClassName,' Size=',Size,' WriteSize=',WriteSize);
if WriteSize then
DestStream.WriteBuffer(Size, SizeOf(Size));
end;
@ -953,12 +953,12 @@ var
IntfImg: TLazIntfImage;
ImgWriter: TFPCustomImageWriter;
begin
//writeln('WriteStreamWithFPImage Self=',HexStr(Cardinal(Self),8),' ',Width,',',Height,' Using SaveStream=',(FImage.SaveStream<>nil) and (FImage.SaveStream.Size>0));
//DebugLn('WriteStreamWithFPImage Self=',HexStr(Cardinal(Self),8),' ',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;
end;
//writeln('WriteStreamWithFPImage');
//DebugLn('WriteStreamWithFPImage');
// write image to temporary stream
MemStream:=TMemoryStream.Create;
@ -984,7 +984,7 @@ begin
{SetLength(s,FImage.SaveStream.Size);
FImage.SaveStream.Position:=0;
FImage.SaveStream.Read(s[1],length(s));
writeln(s);}
DebugLn(s);}
finally
MemStream.Free;
IntfImg.Free;
@ -1027,7 +1027,7 @@ begin
FImage.FreeHandle;
// get the properties from new bitmap
FImage.FHandle:=Value;
//writeln('TBitMap.SetHandle Self=',HexStr(Cardinal(Self),8),' FImage.FHandle=',HexStr(Cardinal(FImage.FHandle),8));
//DebugLn('TBitMap.SetHandle Self=',HexStr(Cardinal(Self),8),' FImage.FHandle=',HexStr(Cardinal(FImage.FHandle),8));
FillChar(FImage.FDIB, SizeOf(FImage.FDIB), 0);
if FImage.FHandle <> 0 then
GetObject(FImage.FHandle, SizeOf(FImage.FDIB), @FImage.FDIB);
@ -1048,13 +1048,13 @@ begin
FImage.FreeMaskHandle;
// combine (depending on the interface we will end with one or two handles)
{$IFDEF VerboseImgMasks}
writeln('TBitmap.SetMaskHandle Before Replace FImage.FHandle=',HexStr(Cardinal(FImage.FHandle),8),
DebugLn('TBitmap.SetMaskHandle Before Replace FImage.FHandle=',HexStr(Cardinal(FImage.FHandle),8),
' FImage.FMaskHandle=',HexStr(Cardinal(FImage.FMaskHandle),8),
' NewMaskHandle=',HexStr(Cardinal(NewMaskHandle),8));
{$ENDIF}
ReplaceBitmapMask(FImage.FHandle,FImage.FMaskHandle,NewMaskHandle);
{$IFDEF VerboseImgMasks}
writeln('TBitmap.SetMaskHandle After Replace FImage.FHandle=',HexStr(Cardinal(FImage.FHandle),8),
DebugLn('TBitmap.SetMaskHandle After Replace FImage.FHandle=',HexStr(Cardinal(FImage.FHandle),8),
' FImage.FMaskHandle=',HexStr(Cardinal(FImage.FMaskHandle),8),
' NewMaskHandle=',HexStr(Cardinal(NewMaskHandle),8));
{$ENDIF}
@ -1191,7 +1191,7 @@ end;
procedure TBitmap.SetTransparentMode(Value: TTransparentMode);
begin
if Value=TransparentMode then exit;
writeln('Note: TBitmap.SetTransparentMode not implemented');
DebugLn('Note: TBitmap.SetTransparentMode not implemented');
end;
// included by graphics.pp
@ -1200,6 +1200,9 @@ end;
{ =============================================================================
$Log$
Revision 1.87 2004/05/11 11:42:26 mattias
replaced writeln by debugln
Revision 1.86 2004/04/23 20:41:11 mattias
added SetFocus after closing completion form

55
lcl/include/clipbrd.inc
View File

@ -32,14 +32,14 @@ end;
constructor TClipboard.Create(AClipboardType: TClipboardType);
begin
//writeln('[TClipboard.Create] A ',ClipboardTypeName[AClipboardType],' Self=',HexStr(Cardinal(Self),8));
//DebugLn('[TClipboard.Create] A ',ClipboardTypeName[AClipboardType],' Self=',HexStr(Cardinal(Self),8));
inherited Create;
FClipboardType:=AClipboardType;
end;
destructor TClipboard.Destroy;
begin
//writeln('[TClipboard.Destroy] A ',ClipboardTypeName[ClipboardType],' Self=',HexStr(Cardinal(Self),8));
//DebugLn('[TClipboard.Destroy] A ',ClipboardTypeName[ClipboardType],' Self=',HexStr(Cardinal(Self),8));
OnRequest:=nil; // this will notify the owner
if FAllocated then begin
ClipboardGetOwnership(ClipboardType,nil,0,nil);
@ -47,14 +47,14 @@ begin
end;
Clear;
inherited Destroy;
//writeln('[TClipboard.Destroy] END ',ClipboardTypeName[ClipboardType]);
//DebugLn('[TClipboard.Destroy] END ',ClipboardTypeName[ClipboardType]);
end;
function TClipboard.IndexOfCachedFormatID(FormatID: TClipboardFormat;
CreateIfNotExists: boolean): integer;
var NewSize: integer;
begin
//writeln('[TClipboard.IndexOfCachedFormatID] A ',ClipboardTypeName[ClipboardType]
//DebugLn('[TClipboard.IndexOfCachedFormatID] A ',ClipboardTypeName[ClipboardType]
//,' Format=',FormatID,' CreateIfNotExists=',CreateIfNotExists);
if FormatID=0 then begin
Result:=-1;
@ -82,7 +82,7 @@ begin
ClipboardTypeName[ClipboardType]);
end;
end;
//writeln('[TClipboard.IndexOfCachedFormatID] END ',ClipboardTypeName[ClipboardType]
//DebugLn('[TClipboard.IndexOfCachedFormatID] END ',ClipboardTypeName[ClipboardType]
//,' Format=',FormatID,' CreateIfNotExists=',CreateIfNotExists,' Result=',Result);
end;
@ -93,7 +93,7 @@ var
OldPosition: TStreamSeekType;
i: integer;
begin
//writeln('[TClipboard.AddFormat - Stream] A ',ClipboardTypeName[ClipboardType],' Format=',FormatID);
//DebugLn('[TClipboard.AddFormat - Stream] A ',ClipboardTypeName[ClipboardType],' Format=',FormatID);
Result:=false;
i:=IndexOfCachedFormatID(FormatID,true);
if i<0 then exit;
@ -112,7 +112,7 @@ function TClipboard.AddFormat(FormatID: TClipboardFormat;
var Buffer; Size: Integer): Boolean;
var i: integer;
begin
//writeln('[TClipboard.AddFormat - Buffer] A ',ClipboardTypeName[ClipboardType],' Format=',FormatID,' Size=',Size);
//DebugLn('[TClipboard.AddFormat - Buffer] A ',ClipboardTypeName[ClipboardType],' Format=',FormatID,' Size=',Size);
Result:=false;
i:=IndexOfCachedFormatID(FormatID,true);
if i<0 then exit;
@ -132,7 +132,7 @@ end;
procedure TClipboard.Clear;
var i: integer;
begin
//writeln('[TClipboard.Clear] A ',ClipboardTypeName[ClipboardType]);
//DebugLn('[TClipboard.Clear] A ',ClipboardTypeName[ClipboardType]);
for i:=0 to FCount-1 do
FData[i].Stream.Free;
if FData<>nil then begin
@ -140,7 +140,7 @@ begin
FData:=nil;
end;
FCount:=0;
//writeln('[TClipboard.Clear] END ',ClipboardTypeName[ClipboardType]);
//DebugLn('[TClipboard.Clear] END ',ClipboardTypeName[ClipboardType]);
end;
{procedure TClipboard.Adding;
@ -171,7 +171,7 @@ end;
procedure TClipboard.InternalOnRequest(const RequestedFormatID: TClipboardFormat;
AStream: TStream);
begin
//writeln('[TClipboard.InternalOnRequest] A ',ClipboardTypeName[ClipboardType]
//DebugLn('[TClipboard.InternalOnRequest] A ',ClipboardTypeName[ClipboardType]
//,' RequestedFormatID=',RequestedFormatID,' AStream=',AStream<>nil,' Allocated=',FAllocated);
if not FAllocated then exit;
if (RequestedFormatID=0) then begin
@ -193,14 +193,14 @@ begin
GetMem(FormatList,SizeOf(TClipboardFormat)*FCount);
for i:=0 to FCount-1 do
FormatList[i]:=FData[i].FormatID;
//writeln('[TClipboard.GetOwnerShip] A ',ClipboardTypeName[ClipboardType],' Allocated=',FAllocated);
//DebugLn('[TClipboard.GetOwnerShip] A ',ClipboardTypeName[ClipboardType],' Allocated=',FAllocated);
FAllocated:=ClipboardGetOwnerShip(ClipboardType,@InternalOnRequest,FCount,
FormatList);
FreeMem(FormatList);
FSupportedFormatsChanged:=false;
end;
Result:=FAllocated;
//writeln('[TClipboard.GetOwnerShip] END ',ClipboardTypeName[ClipboardType],' Allocated=',FAllocated);
//DebugLn('[TClipboard.GetOwnerShip] END ',ClipboardTypeName[ClipboardType],' Allocated=',FAllocated);
end;
procedure TClipboard.SetOnRequest(AnOnRequest: TClipboardRequestEvent);
@ -216,7 +216,7 @@ function TClipboard.GetFormat(FormatID: TClipboardFormat;
// request data from interface object or copy cached data to Stream
var i: integer;
begin
//writeln('[TClipboard.GetFormat] A ',ClipboardTypeName[ClipboardType],' FormatID=',FormatID,' ',ClipboardFormatToMimeType(FormatID),' Allocated=',fAllocated);
//DebugLn('[TClipboard.GetFormat] A ',ClipboardTypeName[ClipboardType],' FormatID=',FormatID,' ',ClipboardFormatToMimeType(FormatID),' Allocated=',fAllocated);
Result:=false;
if Stream=nil then exit;
if FormatID=0 then exit;
@ -239,7 +239,7 @@ begin
// not the clipboard owner -> request data
Result:=ClipboardGetData(ClipboardType,FormatID,Stream);
end;
//writeln('[TClipboard.GetFormat] END ',ClipboardTypeName[ClipboardType],' FormatID=',FormatID,' Result=',Result);
//DebugLn('[TClipboard.GetFormat] END ',ClipboardTypeName[ClipboardType],' FormatID=',FormatID,' Result=',Result);
end;
procedure TClipboard.SetComponent(Component: TComponent);
@ -324,20 +324,20 @@ end;
procedure TClipboard.SetAsText(const Value: string);
var s: string;
begin
//writeln('[TClipboard.SetAsText] A ',ClipboardTypeName[ClipboardType],' "',Value,'"');
//DebugLn('[TClipboard.SetAsText] A ',ClipboardTypeName[ClipboardType],' "',Value,'"');
if Assigned(FOnRequest) then exit;
if Value<>'' then
s:=Value
else
s:=#0;
SetBuffer(PredefinedClipboardFormat(pcfText),s[1],length(Value));
//writeln('[TClipboard.SetAsText] END ',ClipboardTypeName[ClipboardType],' "',Value,'"');
//DebugLn('[TClipboard.SetAsText] END ',ClipboardTypeName[ClipboardType],' "',Value,'"');
end;
function TClipboard.GetAsText: string;
var MemStream: TMemoryStream;
begin
//writeln('[TClipboard.GetAsText] A ',ClipboardTypeName[ClipboardType]);
//DebugLn('[TClipboard.GetAsText] A ',ClipboardTypeName[ClipboardType]);
Result:='';
MemStream:=TMemoryStream.Create;
try
@ -350,14 +350,14 @@ begin
finally
MemStream.Free;
end;
//writeln('[TClipboard.GetAsText] END ',ClipboardTypeName[ClipboardType],' "',Result,'"');
//DebugLn('[TClipboard.GetAsText] END ',ClipboardTypeName[ClipboardType],' "',Result,'"');
end;
procedure TClipboard.SupportedFormats(List: TStrings);
var cnt, i: integer;
FormatList: PClipboardFormat;
begin
//writeln('[TClipboard.SupportedFormats]');
//DebugLn('[TClipboard.SupportedFormats]');
List.Clear;
if FAllocated then begin
for i:=0 to FCount-1 do
@ -409,7 +409,7 @@ var
List: PClipboardFormat;
cnt, i: integer;
begin
//writeln('[TClipboard.FindPictureFormatID]');
//DebugLn('[TClipboard.FindPictureFormatID]');
List:=nil;
Result:=0;
cnt:=0;
@ -442,7 +442,7 @@ var
List: PClipboardFormat;
cnt, i: integer;
begin
//writeln('[TClipboard.FindPictureFormatID]');
//DebugLn('[TClipboard.FindPictureFormatID]');
List:=nil;
Result:=0;
cnt:=0;
@ -480,7 +480,7 @@ function TClipboard.HasFormat(FormatID: TClipboardFormat): Boolean;
var List: PClipboardFormat;
cnt, i: integer;
begin
//writeln('[TClipboard.HasFormat] A ',ClipboardTypeName[ClipboardType],' Allocated=',FAllocated);
//DebugLn('[TClipboard.HasFormat] A ',ClipboardTypeName[ClipboardType],' Allocated=',FAllocated);
if FormatID<>0 then begin
if FAllocated then
Result := (IndexOfCachedFormatID(FormatID,false)>=0)
@ -491,7 +491,7 @@ begin
end;
i:=0;
//for i:=0 to cnt-1 do
//writeln('[TClipboard.HasFormat] ',FormatID,' ',List[i]);
//DebugLn('[TClipboard.HasFormat] ',FormatID,' ',List[i]);
while (i<cnt) and (List[i]<>FormatID) do inc(i);
Result := i<cnt;
if List<>nil then FreeMem(List);
@ -504,7 +504,7 @@ begin
end;
end else
Result:=false;
//writeln('[TClipboard.HasFormat] END ',ClipboardTypeName[ClipboardType],' FormatID=',FormatID,' Result=',Result);
//DebugLn('[TClipboard.HasFormat] END ',ClipboardTypeName[ClipboardType],' FormatID=',FormatID,' Result=',Result);
end;
function TClipboard.HasFormatName(const FormatName: string): Boolean;
@ -638,7 +638,7 @@ function TClipboard.GetFormatCount: Integer;
// ask interfaceobject
var List: PClipboardFormat;
begin
//writeln('[TClipboard.GetFormatCount]');
//DebugLn('[TClipboard.GetFormatCount]');
if FAllocated then
Result:=FCount
else begin
@ -654,7 +654,7 @@ var
List: PClipboardFormat;
cnt: integer;
begin
//writeln('[TClipboard.GetFormats] Index=',Index);
//DebugLn('[TClipboard.GetFormats] Index=',Index);
if FAllocated then begin
if (Index<0) or (Index>=FCount) then
raise Exception.Create('TClipboard.GetFormats: Index out of bounds: Index='
@ -675,6 +675,9 @@ end;
{
$Log$
Revision 1.17 2004/05/11 11:42:27 mattias
replaced writeln by debugln
Revision 1.16 2004/04/10 17:58:56 mattias
implemented mainunit hints for include files

117
lcl/include/control.inc
View File

@ -228,7 +228,7 @@ var
begin
{$IFDEF VerboseSizeMsg}
writeln('TControl.ChangeBounds A ',Name,':',ClassName,' Old=',Left,',',Top,',',Width,',',Height,' New=',ALeft,',',ATop,',',AWidth,',',AHeight);
DebugLn('TControl.ChangeBounds A ',Name,':',ClassName,' Old=',Left,',',Top,',',Width,',',Height,' New=',ALeft,',',ATop,',',AWidth,',',AHeight);
{$ENDIF}
// constraint the size
DoConstrainedResize(AWidth, AHeight);
@ -259,11 +259,11 @@ begin
end;
end;}
//writeln('TControl.ChangeBounds A ',Name,':',ClassName);
//DebugLn('TControl.ChangeBounds A ',Name,':',ClassName);
if (not (csLoading in ComponentState))
and (not (Self is TWinControl)) then
InvalidateControl(Visible, False, true);
//writeln('TControl.ChangeBounds B ',Name,':',ClassName);
//DebugLn('TControl.ChangeBounds B ',Name,':',ClassName);
DoSetBounds(ALeft,ATop,AWidth,AHeight);
// change base bounds
@ -286,7 +286,7 @@ begin
BoundsChanged;
if UpdatePosSizeChanged then exit;
//if csDesigning in ComponentState then
// writeln('TControl.ChangeBounds ',Name,':',ClassName,' ',Left,',',Top,',',Width,',',Height);
// DebugLn('TControl.ChangeBounds ',Name,':',ClassName,' ',Left,',',Top,',',Width,',',Height);
// autosize this control and its brothers
RequestAlign;
if UpdatePosSizeChanged then exit;
@ -335,9 +335,9 @@ procedure TControl.DoSetBounds(ALeft, ATop, AWidth, AHeight : integer);
procedure BoundsOutOfBounds;
begin
writeln('TControl.DoSetBounds ',Name,':',ClassName,
' Old=',Left,',',Top,',',Width,',',Height,
' New=',aLeft,',',aTop,',',aWidth,',',aHeight,
DebugLn('TControl.DoSetBounds ',Name,':',ClassName,
' Old=',dbgs(Left,Top,Width,Height),
' New=',dbgs(aLeft,aTop,aWidth,aHeight),
'');
RaiseGDBException('TControl.DoSetBounds '+Name+':'+ClassName+' Invalid bounds');
end;
@ -347,7 +347,7 @@ begin
BoundsOutOfBounds;
{$IFDEF CHECK_POSITION}
if csDesigning in ComponentState then
writeln('TControl.DoSetBounds ',Name,':',ClassName,
DebugLn('TControl.DoSetBounds ',Name,':',ClassName,
' Old=',Left,',',Top,',',Width,',',Height,
' New=',aLeft,',',aTop,',',aWidth,',',aHeight,
'');
@ -568,7 +568,7 @@ end;
{------------------------------------------------------------------------------}
Procedure TControl.LMCaptureChanged(Var Message: TLMessage);
Begin
//Writeln('[LMCaptureChanged for '+Name+':'+Classname+']');
//DebugLn('[LMCaptureChanged for '+Name+':'+Classname+']');
CaptureChanged;
End;
@ -594,7 +594,7 @@ end;
Procedure TControl.CMMouseEnter(var Message: TLMessage);
Begin
// this is a LCL based mouse message, so don't call DoBeforeMouseMessage
//writeln('TControl.CMMouseEnter ',Name,':',ClassName,' ',FMouseEntered,' ',Message.LParam);
//DebugLn('TControl.CMMouseEnter ',Name,':',ClassName,' ',FMouseEntered,' ',Message.LParam);
if (Message.LParam=0) and (not FMouseEntered) then begin
FMouseEntered:=true;
MouseEnter;
@ -609,7 +609,7 @@ end;
Procedure TControl.CMMouseLeave(var Message: TLMessage);
Begin
// this is a LCL based mouse message, so don't call DoBeforeMouseMessage
//writeln('TControl.CMMouseLeave ',Name,':',ClassName,' ',FMouseEntered,' ',Message.LParam);
//DebugLn('TControl.CMMouseLeave ',Name,':',ClassName,' ',FMouseEntered,' ',Message.LParam);
if (Message.LParam=0) and FMouseEntered then begin
FMouseEntered:=false;
MouseLeave;
@ -797,7 +797,7 @@ end;
procedure TControl.DragCanceled;
begin
{$IFDEF VerboseDrag}
writeln('TControl.DragCanceled');
DebugLn('TControl.DragCanceled');
{$ENDIF}
end;
@ -808,7 +808,7 @@ end;
procedure TControl.DoStartDrag(var DragObject: TDragObject);
begin
{$IFDEF VerboseDrag}
writeln('TControl.DoStartDrag ',Name,':',ClassName);
DebugLn('TControl.DoStartDrag ',Name,':',ClassName);
{$ENDIF}
if Assigned(FOnStartDrag) then FOnStartDrag(Self, DragObject);
end;
@ -819,7 +819,7 @@ end;
Procedure TControl.DoEndDrag(Target: TObject; X,Y: Integer);
Begin
{$IFDEF VerboseDrag}
writeln('TControl.DoEndDrag ',Name,':',ClassName,' XY=',X,',',Y);
DebugLn('TControl.DoEndDrag ',Name,':',ClassName,' XY=',X,',',Y);
{$ENDIF}
if Assigned(FOnEndDrag) then FOnEndDrag(Self,Target,X,Y);
end;
@ -886,9 +886,9 @@ begin
if OldFocus<>nil then
NewFocus := TopLevel.FindNextControl(OldFocus,ForwardTab,True,False,False);
//if NewFocus<>nil then
// writeln('TControl.PerformTab A ',Name,':',ClassName,' NewFocus=',NewFocus.Name,':',NewFocus.ClassName)
// DebugLn('TControl.PerformTab A ',Name,':',ClassName,' NewFocus=',NewFocus.Name,':',NewFocus.ClassName)
//else
// writeln('TControl.PerformTab A ',Name,':',ClassName,' NewFocus=nil');
// DebugLn('TControl.PerformTab A ',Name,':',ClassName,' NewFocus=nil');
If (NewFocus = nil) then NewFocus:=FirstFocus;
If NewFocus = OldFocus then begin
@ -1000,12 +1000,12 @@ var
P: TPoint;
Begin
{$IFDEF VerboseDrag}
writeln('TControl.DoDragMsg ',Name,':',ClassName,' DragMsg.DragMessage=',ord(DragMsg.DragMessage));
DebugLn('TControl.DoDragMsg ',Name,':',ClassName,' DragMsg.DragMessage=',ord(DragMsg.DragMessage));
{$ENDIF}
Src := DragMsg.Dragrec^.Source;
P:=ScreenToClient(DragMsg.Dragrec^.Pos);
{$IFDEF VerboseDrag}
writeln('TControl.DoDragMsg ',Name,':',ClassName,' DragMsg.Dragrec^.Pos=',DragMsg.Dragrec^.Pos.X,',',DragMsg.Dragrec^.Pos.Y,' -> P=',P.X,P.Y);
DebugLn('TControl.DoDragMsg ',Name,':',ClassName,' DragMsg.Dragrec^.Pos=',DragMsg.Dragrec^.Pos.X,',',DragMsg.Dragrec^.Pos.Y,' -> P=',P.X,P.Y);
if P.X<0 then RaiseGDBException('');
{$ENDIF}
case DragMsg.DragMessage of
@ -1040,7 +1040,7 @@ Procedure TControl.DragOver(Source: TObject; X,Y : Integer; State: TDragState;
var Accept:Boolean);
begin
{$IFDEF VerboseDrag}
writeln('TControl.DragOver ',Name,':',ClassName,' XY=',X,',',Y);
DebugLn('TControl.DragOver ',Name,':',ClassName,' XY=',X,',',Y);
{$ENDIF}
Accept := False;
if Assigned(FOnDragOver) then begin
@ -1055,7 +1055,7 @@ end;
Procedure TControl.DragDrop(Source: TObject; X,Y : Integer);
begin
{$IFDEF VerboseDrag}
writeln('TControl.DragDrop ',Name,':',ClassName,' XY=',X,',',Y);
DebugLn('TControl.DragDrop ',Name,':',ClassName,' XY=',X,',',Y);
{$ENDIF}
If Assigned(FOnDragDrop) then FOnDragDrop(Self, Source,X,Y);
end;
@ -1159,7 +1159,7 @@ begin
Include(FControlFlags,cfLastAlignedBoundsValid);
//if AnsiCompareText(ClassName,'TSCROLLBAR')=0 then
// writeln('TControl.SetAlignedBounds A ',Name,':',ClassName,' ',aLeft,',',aTop,',',aWidth,',',aHeight);
// DebugLn('TControl.SetAlignedBounds A ',Name,':',ClassName,' ',aLeft,',',aTop,',',aWidth,',',aHeight);
SetBoundsKeepBase(aLeft, aTop, aWidth, aHeight, true);
end;
@ -1285,7 +1285,7 @@ procedure TControl.WndProc(var TheMessage : TLMessage);
Var
Form : TCustomForm;
begin
//writeln('CCC TControl.WndPRoc ',Name,':',ClassName);
//DebugLn('CCC TControl.WndPRoc ',Name,':',ClassName);
if (csDesigning in ComponentState) then
begin
Form := GetParentForm(Self);
@ -1431,13 +1431,13 @@ begin
DoBeforeMouseMessage;
if csCaptureMouse in ControlStyle then begin
{$IFDEF VerboseMouseCapture}
writeln('TControl.WMLButtonDown ',Name,':',ClassName);
DebugLn('TControl.WMLButtonDown ',Name,':',ClassName);
{$ENDIF}
MouseCapture := True;
end;
if csClickEvents in ControlStyle then Include(FControlState, csClicked);
DoMouseDown(Message, mbLeft, []);
//Writeln('TCONTROL WMLBUTTONDOWN B ',Name,':',ClassName);
//DebugLn('TCONTROL WMLBUTTONDOWN B ',Name,':',ClassName);
end;
{------------------------------------------------------------------------------
@ -1479,7 +1479,7 @@ begin
//TODO: SendCancelMode(self);
if csCaptureMouse in ControlStyle then begin
{$IFDEF VerboseMouseCapture}
writeln('TControl.WMLButtonDblClk ',Name,':',ClassName);
DebugLn('TControl.WMLButtonDblClk ',Name,':',ClassName);
{$ENDIF}
MouseCapture := True;
end;
@ -1528,7 +1528,7 @@ begin
//TODO: SendCancelMode(self);
if csCaptureMouse in ControlStyle then begin
{$IFDEF VerboseMouseCapture}
writeln('TControl.WMLButtonTripleClk ',Name,':',ClassName);
DebugLn('TControl.WMLButtonTripleClk ',Name,':',ClassName);
{$ENDIF}
MouseCapture := True;
end;
@ -1575,7 +1575,7 @@ begin
//TODO: SendCancelMode(self);
if csCaptureMouse in ControlStyle then begin
{$IFDEF VerboseMouseCapture}
writeln('TControl.WMLButtonQuadClk ',Name,':',ClassName);
DebugLn('TControl.WMLButtonQuadClk ',Name,':',ClassName);
{$ENDIF}
MouseCapture := True;
end;
@ -1619,10 +1619,10 @@ end;
procedure TControl.WMLButtonUp(var Message: TLMLButtonUp);
begin
DoBeforeMouseMessage;
//Writeln('TControl.WMLButtonUp A ',Name,':',ClassName,' csCaptureMouse=',csCaptureMouse in ControlStyle,' csClicked=',csClicked in ControlState);
//DebugLn('TControl.WMLButtonUp A ',Name,':',ClassName,' csCaptureMouse=',csCaptureMouse in ControlStyle,' csClicked=',csClicked in ControlState);
if csCaptureMouse in ControlStyle then begin
{$IFDEF VerboseMouseCapture}
writeln('TControl.WMLButtonUp ',Name,':',ClassName);
DebugLn('TControl.WMLButtonUp ',Name,':',ClassName);
{$ENDIF}
MouseCapture := False;
end;
@ -1630,15 +1630,15 @@ begin
if csClicked in ControlState then
begin
Exclude(FControlState, csClicked);
//writeln('TControl.WMLButtonUp B ',ClientRect.Left,',',ClientRect.Top,',',ClientRect.Right,',',ClientRect.Bottom,' ',Message.Pos.X,',',Message.Pos.Y);
//DebugLn('TControl.WMLButtonUp B ',ClientRect.Left,',',ClientRect.Top,',',ClientRect.Right,',',ClientRect.Bottom,' ',Message.Pos.X,',',Message.Pos.Y);
if PtInRect(ClientRect, SmallPointToPoint(Message.Pos))
then begin
//writeln('TControl.WMLButtonUp C');
//DebugLn('TControl.WMLButtonUp C');
Click;
end;
end;
DoMouseUp(Message, mbLeft);
//Writeln('TControl.WMLButtonUp END');
//DebugLn('TControl.WMLButtonUp END');
end;
{------------------------------------------------------------------------------
@ -1748,7 +1748,7 @@ end;
Procedure TControl.SetBoundsRect(const ARect : TRect);
Begin
{$IFDEF CHECK_POSITION}
writeln('[TControl.SetBoundsRect] ',Name,':',ClassName);
DebugLn('[TControl.SetBoundsRect] ',Name,':',ClassName);
{$ENDIF}
with ARect do
SetBounds(Left,Top,Right - Left, Bottom - Top);
@ -1833,7 +1833,7 @@ begin
if MouseCapture <> Value
then begin
{$IFDEF VerboseMouseCapture}
writeln('TControl.SetMouseCapture ',Name,':',ClassName,' NewValue=',Value);
DebugLn('TControl.SetMouseCapture ',Name,':',ClassName,' NewValue=',Value);
{$ENDIF}
if Value
then SetCaptureControl(Self)
@ -1906,7 +1906,7 @@ begin
end
else begin
// Bummer, we have to do it the compatible way.
WriteLN('Note: GetTextBuf is overridden for: ', Classname);
DebugLn('Note: GetTextBuf is overridden for: ', Classname);
len := GetTextLen;
if len = 0
@ -2060,7 +2060,7 @@ begin
begin
{$IFDEF VerboseDsgnPaintMsg}
if csDesigning in ComponentState then
writeln('TControl.Repaint A ',Name,':',ClassName);
DebugLn('TControl.Repaint A ',Name,':',ClassName);
{$ENDIF}
DC := GetDC(Parent.Handle);
try
@ -2088,7 +2088,7 @@ begin
or (FLastResizeClientWidth<>ClientWidth)
or (FLastResizeClientHeight<>ClientHeight) then begin
//if AnsiCompareText('NOTEBOOK',Name)=0 then
{writeln('[TControl.Resize] ',Name,':',ClassName,
{DebugLn('[TControl.Resize] ',Name,':',ClassName,
' Last=',FLastResizeWidth,',',FLastResizeHeight,
' LastClient=',FLastResizeClientWidth,',',FLastResizeClientHeight,
' New=',Width,',',Height,
@ -2104,7 +2104,7 @@ end;
procedure TControl.Loaded;
begin
inherited Loaded;
{writeln('TControl.Loaded A ',Name,':',ClassName,
{DebugLn('TControl.Loaded A ',Name,':',ClassName,
' CW=',cfClientWidthLoaded in FControlFlags,'=',FLoadedClientSize.X,
' CH=',cfClientHeightLoaded in FControlFlags,'=',FLoadedClientSize.Y,
'');}
@ -2151,7 +2151,7 @@ end;
procedure TControl.SetAlign(Value: TAlign);
begin
if FAlign = Value then exit;
//writeln('TControl.SetAlign ',Name,':',ClassName,' Old=',AlignNames[FAlign],' New=',AlignNames[Value]);
//DebugLn('TControl.SetAlign ',Name,':',ClassName,' Old=',AlignNames[FAlign],' New=',AlignNames[Value]);
FAlign := Value;
RequestAlign;
end;
@ -2211,7 +2211,7 @@ begin
and (NewBaseParentClientSize.Y=FBaseParentClientSize.Y)
then exit;
{if csDesigning in ComponentState then
writeln('TControl.UpdateBaseBounds ',Name,':',ClassName,
DebugLn('TControl.UpdateBaseBounds ',Name,':',ClassName,
' OldBounds=',FBaseBounds.Left,',',FBaseBounds.Top,',',FBaseBounds.Right-FBaseBounds.Left,',',FBaseBounds.Bottom-FBaseBounds.Top,
' OldClientSize=',FBaseParentClientSize.X,',',FBaseParentClientSize.Y,
' NewBounds=',NewBaseBounds.Left,',',NewBaseBounds.Top,',',NewBaseBounds.Right-NewBaseBounds.Left,',',NewBaseBounds.Bottom-NewBaseBounds.Top,
@ -2253,7 +2253,7 @@ end;
procedure TControl.SetLeft(Value: Integer);
begin
{$IFDEF CHECK_POSITION}
writeln('[TControl.SetLeft] ',Name,':',ClassName,' ',Value);
DebugLn('[TControl.SetLeft] ',Name,':',ClassName,' ',Value);
{$ENDIF}
SetBounds(Value, FTop, FWidth, FHeight);
end;
@ -2264,7 +2264,7 @@ end;
procedure TControl.SetTop(Value: Integer);
begin
{$IFDEF CHECK_POSITION}
writeln('[TControl.SetTop] ',Name,':',ClassName,' ',Value);
DebugLn('[TControl.SetTop] ',Name,':',ClassName,' ',Value);
{$ENDIF}
SetBounds(FLeft, Value, FWidth, FHeight);
end;
@ -2275,7 +2275,7 @@ end;
procedure TControl.SetWidth(Value: Integer);
begin
{$IFDEF CHECK_POSITION}
writeln('[TControl.SetWidth] ',Name,':',ClassName,' ',Value);
DebugLn('[TControl.SetWidth] ',Name,':',ClassName,' ',Value);
{$ENDIF}
SetBounds(FLeft, FTop, Value, FHeight);
end;
@ -2286,7 +2286,7 @@ end;
procedure TControl.SetHeight(Value: Integer);
begin
{$IFDEF CHECK_POSITION}
writeln('[TControl.SetHeight] ',Name,':',ClassName,' ',Value);
DebugLn('[TControl.SetHeight] ',Name,':',ClassName,' ',Value);
{$ENDIF}
SetBounds(FLeft, FTop, FWidth, Value);
end;
@ -2388,7 +2388,7 @@ end;
Procedure TControl.WMMouseMove(Var Message: TLMMouseMove);
Begin
{$IFDEF VerboseMouseBugfix}
writeln('[TControl.WMMouseMove] ',Name,':',ClassName,' ',Message.XPos,',',Message.YPos);
DebugLn('[TControl.WMMouseMove] ',Name,':',ClassName,' ',Message.XPos,',',Message.YPos);
{$ENDIF}
DoBeforeMouseMessage;
if not (csNoStdEvents in ControlStyle)
@ -2445,13 +2445,13 @@ end;
procedure TControl.MouseEnter;
begin
//writeln('TControl.MouseEnter ',Name,':',ClassName,' ',Assigned(FOnMouseEnter));
//DebugLn('TControl.MouseEnter ',Name,':',ClassName,' ',Assigned(FOnMouseEnter));
if Assigned(FOnMouseEnter) then FOnMouseEnter(Self);
end;
procedure TControl.MouseLeave;
begin
//writeln('TControl.MouseLeave ',Name,':',ClassName,' ',Assigned(FOnMouseLeave));
//DebugLn('TControl.MouseLeave ',Name,':',ClassName,' ',Assigned(FOnMouseLeave));
if Assigned(FOnMouseLeave) then FOnMouseLeave(Self);
end;
@ -2699,7 +2699,7 @@ begin
end
else begin
// Bummer, we have to do it the compatible way.
WriteLN('Note: SetTextBuf is overridden for: ', Classname);
DebugLn('Note: SetTextBuf is overridden for: ', Classname);
SetTextBuf(PChar(Value));
end;
end;
@ -2723,16 +2723,16 @@ destructor TControl.Destroy;
var
HandlerType: TControlHandlerType;
begin
//writeln('[TControl.Destroy] A ',Name,':',ClassName);
//DebugLn('[TControl.Destroy] A ',Name,':',ClassName);
Application.ControlDestroyed(Self);
SetParent(nil);
FreeThenNil(FActionLink);
FreeThenNil(FBorderSpacing);
FreeThenNil(FConstraints);
FreeThenNil(FFont);
//writeln('[TControl.Destroy] B ',Name,':',ClassName);
//DebugLn('[TControl.Destroy] B ',Name,':',ClassName);
inherited Destroy;
//writeln('[TControl.Destroy] END ',Name,':',ClassName);
//DebugLn('[TControl.Destroy] END ',Name,':',ClassName);
for HandlerType:=Low(TControlHandlerType) to High(TControlHandlerType) do
FreeThenNil(FControlHandlers[HandlerType]);
end;
@ -2747,7 +2747,7 @@ end;
constructor TControl.Create(AOwner : TComponent);
begin
//if AnsiCompareText(ClassName,'TSpeedButton')=0 then
// writeln('TControl.Create START ',Name,':',ClassName);
// DebugLn('TControl.Create START ',Name,':',ClassName);
inherited Create(AOwner);
FControlStyle := [csCaptureMouse, csClickEvents, csSetCaption, csDoubleClicks,
@ -2773,7 +2773,7 @@ begin
FTabOrder := -1;
TabStop := False;
FDragCursor := crDrag;
//writeln('TControl.Create END ',Name,':',ClassName);
//DebugLn('TControl.Create END ',Name,':',ClassName);
end;
{------------------------------------------------------------------------------
@ -2836,11 +2836,11 @@ end;
procedure TControl.SetInitialBounds(aLeft, aTop, aWidth, aHeight: integer);
begin
//writeln('TControl.SetInitialBounds A ',Name,':',ClassName,' ',aLeft,',',aTop,',',aWidth,',',aHeight);
//DebugLn('TControl.SetInitialBounds A ',Name,':',ClassName,' ',aLeft,',',aTop,',',aWidth,',',aHeight);
if (csLoading in ComponentState)
or ((Owner<>nil) and (csLoading in Owner.ComponentState)) then
exit;
//writeln('TControl.SetInitialBounds B ',Name,':',ClassName,' ',aLeft,',',aTop,',',aWidth,',',aHeight);
//DebugLn('TControl.SetInitialBounds B ',Name,':',ClassName,' ',aLeft,',',aTop,',',aWidth,',',aHeight);
SetBounds(aLeft,aTop,aWidth,aHeight);
end;
@ -2888,7 +2888,7 @@ end;
procedure TControl.WMSize(Var Message : TLMSize);
begin
{$IFDEF CHECK_POSITION}
writeln('[TControl.WMSize] Name=',Name,':',ClassName,' Message.Width=',Message.Width,' Message.Height=',Message.Height,' Width=',Width,' Height=',Height);
DebugLn('[TControl.WMSize] Name=',Name,':',ClassName,' Message.Width=',Message.Width,' Message.Height=',Message.Height,' Width=',Width,' Height=',Height);
{$ENDIF}
//Assert(False, Format('Trace:[TWinControl.WMSize] %s', [ClassName]));
@ -2907,7 +2907,7 @@ end;
procedure TControl.WMMove(var Message: TLMMove);
begin
{$IFDEF CHECK_POSITION}
writeln('[TControl.WMMove] Name=',Name,':',ClassName,' Message.XPos=',Message.XPos,' Message.YPos=',Message.YPos,' OldLeft=',Left,' OldTop=',Top);
DebugLn('[TControl.WMMove] Name=',Name,':',ClassName,' Message.XPos=',Message.XPos,' Message.YPos=',Message.YPos,' OldLeft=',Left,' OldTop=',Top);
{$ENDIF}
{ Just sync the coordinates }
SetBoundsKeepBase(Message.XPos, Message.YPos, Width, Height,Parent<>nil);
@ -2923,6 +2923,9 @@ end;
{ =============================================================================
$Log$
Revision 1.185 2004/05/11 11:42:27 mattias
replaced writeln by debugln
Revision 1.184 2004/05/11 10:53:59 mattias
replaced writeln by debugln

87
lcl/include/customform.inc
View File

@ -104,7 +104,7 @@ end;
------------------------------------------------------------------------------}
destructor TCustomForm.Destroy;
begin
//writeln('[TCustomForm.Destroy] A ',Name,':',ClassName);
//DebugLn('[TCustomForm.Destroy] A ',Name,':',ClassName);
if not (csDestroying in ComponentState) then ;//GlobalNameSpace.BeginWrite;
try
// ------
@ -116,9 +116,9 @@ begin
FreeThenNil(FIcon);
Screen.RemoveForm(Self);
FreeThenNil(FActionLists);
//writeln('[TCustomForm.Destroy] B ',Name,':',ClassName);
//DebugLn('[TCustomForm.Destroy] B ',Name,':',ClassName);
inherited Destroy;
//writeln('[TCustomForm.Destroy] END ',Name,':',ClassName);
//DebugLn('[TCustomForm.Destroy] END ',Name,':',ClassName);
finally
//GlobalNameSpace.EndWrite;
end;
@ -229,7 +229,7 @@ end;
------------------------------------------------------------------------------}
function TCustomForm.GetIconHandle: HICON;
begin
//writeln('[TCustomForm.GetIconHandle] ',ClassName,' ',FIcon<>nil);
//DebugLn('[TCustomForm.GetIconHandle] ',ClassName,' ',FIcon<>nil);
if (FIcon<>nil) and not Icon.Empty then
Result := FIcon.Handle
else
@ -255,7 +255,7 @@ Procedure TCustomForm.SetFocus;
Begin
{$IFDEF VerboseFocus}
writeln('TCustomForm.SetFocus ',Name,':',ClassName);
DebugLn('TCustomForm.SetFocus ',Name,':',ClassName);
{$ENDIF}
if not FActive then
begin
@ -271,19 +271,19 @@ end;
Procedure TCustomForm.SetVisible(Value : boolean);
Begin
if (Value=(fsVisible in FFormState)) and (Visible=Value) then exit;
//writeln('[TCustomForm.SetVisible] START ',Name,':',ClassName,' Old=',Visible,' New=',Value,' ',(fsCreating in FFormState),' ',FormUpdating);
//DebugLn('[TCustomForm.SetVisible] START ',Name,':',ClassName,' Old=',Visible,' New=',Value,' ',(fsCreating in FFormState),' ',FormUpdating);
if Value then
Include(FFormState, fsVisible)
else
Exclude(FFormState, fsVisible);
//writeln('TCustomForm.SetVisible ',Name,':',ClassName,' FormUpdating=',FormUpdating,' fsCreating=',fsCreating in FFormState);
//DebugLn('TCustomForm.SetVisible ',Name,':',ClassName,' FormUpdating=',FormUpdating,' fsCreating=',fsCreating in FFormState);
if (fsCreating in FFormState) {or FormUpdating} then
// will be done when finished loading
else
begin
inherited Visible:=Value;
end;
//writeln('[TCustomForm.SetVisible] END ',Name,':',ClassName,' ',Value,' ',(fsCreating in FFormState),' ',FormUpdating,' ',Visible);
//DebugLn('[TCustomForm.SetVisible] END ',Name,':',ClassName,' ',Value,' ',(fsCreating in FFormState),' ',FormUpdating,' ',Visible);
end;
{------------------------------------------------------------------------------
@ -298,7 +298,7 @@ begin
else
NewFocusControl := Self;
{$IFDEF VerboseFocus}
writeln('TCustomForm.SetWindowFocus ',Name,':',Classname ,
DebugLn('TCustomForm.SetWindowFocus ',Name,':',Classname ,
' NewFocusControl=',NewFocusControl.Name,':',NewFocusControl.ClassName,
' HndAlloc=',NewFocusControl.HandleAllocated);
{$ENDIF}
@ -327,7 +327,7 @@ begin
end else begin
write(' FActiveControl=nil');
end;
writeln('');
DebugLn('');
{$ENDIF}
if (fsShowing in FFormState) then exit;
Include(FFormState, fsShowing);
@ -336,7 +336,7 @@ begin
if (FActiveControl<>nil) and FActiveControl.HandleAllocated
and (FActiveControl.Visible) and (FActiveControl.Enabled) then begin
{$IFDEF VerboseFocus}
writeln('TCustomForm.WMShowWindow B ',FActiveControl.Name,':',FActiveControl.ClassName);
DebugLn('TCustomForm.WMShowWindow B ',FActiveControl.Name,':',FActiveControl.ClassName);
{$ENDIF}
LCLIntf.SetFocus(FActiveControl.Handle);
end;
@ -359,7 +359,7 @@ end;
procedure TCustomForm.WMActivate(var Message : TLMActivate);
begin
{$IFDEF VerboseFocus}
writeln('TCustomForm.WMActivate A ',Name,':',ClassName,' Msg.Active=',Message.Active);
DebugLn('TCustomForm.WMActivate A ',Name,':',ClassName,' Msg.Active=',Message.Active);
{$ENDIF}
if (FormStyle <> fsMDIForm) or (csDesigning in ComponentState) then
SetActive(Message.Active {<> WA_INACTIVE});
@ -421,9 +421,9 @@ end;
------------------------------------------------------------------------------}
procedure TCustomForm.WMPaint(var Message: TLMPaint);
begin
//writeln('[TCustomForm.WMPaint] ',Name,':',ClassName);
//DebugLn('[TCustomForm.WMPaint] ',Name,':',ClassName);
inherited WMPaint(Message);
//writeln('[TCustomForm.WMPaint] END ',Name,':',ClassName);
//DebugLn('[TCustomForm.WMPaint] END ',Name,':',ClassName);
end;
@ -439,7 +439,7 @@ var
OldState: TWindowState;
begin
{$IFDEF CHECK_POSITION}
Writeln('[TCustomForm.WMSize] Name=',Name,' Class=',ClassName,' Message.Width=',Message.Width,' Message.Height=',Message.Height);
DebugLn('[TCustomForm.WMSize] Name=',Name,' Class=',ClassName,' Message.Width=',Message.Width,' Message.Height=',Message.Height);
{$ENDIF}
Assert(False, 'Trace:WMSIZE in TCustomForm');
if not (csDesigning in ComponentState) then begin
@ -604,7 +604,7 @@ begin
// FCanvas.Lock;
try
FCanvas.Handle := DC;
//writeln('[TCustomForm.PaintWindow] ',ClassName,' DC=',HexStr(DC,8),' ',HexStr(FCanvas.Handle,8));
//DebugLn('[TCustomForm.PaintWindow] ',ClassName,' DC=',HexStr(DC,8),' ',HexStr(FCanvas.Handle,8));
try
if FDesigner <> nil then FDesigner.PaintGrid else Paint;
finally
@ -709,7 +709,7 @@ begin
if FocusHandle <> 0
then begin
{$IFDEF VerboseFocus}
writeln('[TCustomForm.WndProc] ',Name,':',ClassName);
DebugLn('[TCustomForm.WndProc] ',Name,':',ClassName);
{$ENDIF}
LCLIntf.SetFocus(FocusHandle);
Exit;
@ -1024,13 +1024,13 @@ Begin
{$IFDEF VerboseFocus}
write('TCustomForm.SetActiveControl ',Name,':',ClassName,' FActive=',FActive);
if FActiveControl<>nil then
writeln(' OldActiveControl=',FActiveControl.Name,':',FActiveControl.ClassName)
DebugLn(' OldActiveControl=',FActiveControl.Name,':',FActiveControl.ClassName)
else
writeln(' OldActiveControl=nil');
DebugLn(' OldActiveControl=nil');
if AWinControl<>nil then
writeln(' NewActiveControl=',AWinControl.Name,':',AWinControl.ClassName)
DebugLn(' NewActiveControl=',AWinControl.Name,':',AWinControl.ClassName)
else
writeln(' NewActiveControl=nil');
DebugLn(' NewActiveControl=nil');
{$ENDIF}
FActiveControl := AWinControl;
if not (csLoading in ComponentState) then
@ -1068,24 +1068,24 @@ end;
------------------------------------------------------------------------------}
constructor TCustomForm.Create(AOwner : TComponent);
begin
//writeln('[TCustomForm.Create] A Class=',Classname);
//DebugLn('[TCustomForm.Create] A Class=',Classname);
try
BeginFormUpdate;
CreateNew(AOwner, 1);
//writeln('[TCustomForm.Create] B Class=',Classname);
//DebugLn('[TCustomForm.Create] B Class=',Classname);
if (ClassType <> TForm) and not (csDesigning in ComponentState) then
begin
Include(FFormState, fsCreating);
try
//writeln('[TCustomForm.Create] C Class=',Classname);
//DebugLn('[TCustomForm.Create] C Class=',Classname);
if not InitResourceComponent(Self, TForm) then begin
//writeln('[TCustomForm.Create] Resource '''+ClassName+''' not found');
//Writeln('This is for information purposes only. This is not critical at this time.');
//DebugLn('[TCustomForm.Create] Resource '''+ClassName+''' not found');
//DebugLn('This is for information purposes only. This is not critical at this time.');
// MG: Ignoring is best at the moment. (Delphi raises an exception.)
end;
//writeln('[TCustomForm.Create] D Class=',Classname);
//DebugLn('[TCustomForm.Create] D Class=',Classname);
DoCreate;
//writeln('[TCustomForm.Create] E Class=',Classname);
//DebugLn('[TCustomForm.Create] E Class=',Classname);
finally
Exclude(FFormState, fsCreating);
end;
@ -1093,7 +1093,7 @@ begin
EndFormUpdate;
finally
end;
//writeln('[TCustomForm.Create] END Class=',Classname);
//DebugLn('[TCustomForm.Create] END Class=',Classname);
end;
{------------------------------------------------------------------------------
@ -1101,7 +1101,7 @@ end;
------------------------------------------------------------------------------}
constructor TCustomForm.CreateNew(AOwner: TComponent; Num : Integer);
Begin
//writeln('[TCustomForm.CreateNew] Class=',Classname);
//DebugLn('[TCustomForm.CreateNew] Class=',Classname);
BeginFormUpdate;
// set border style before handle is allocated
if not (fsBorderStyleChanged in FFormState) then
@ -1247,7 +1247,7 @@ procedure TCustomForm.ShowOnTop;
begin
Show;
BringToFront;
//writeln('TCustomForm.ShowOnTop ',Name,':',ClassName,' ',Visible,' ',HandleAllocated,' ',csDesigning in ComponentState);
//DebugLn('TCustomForm.ShowOnTop ',Name,':',ClassName,' ',Visible,' ',HandleAllocated,' ',csDesigning in ComponentState);
LCLIntf.ShowWindow(Handle,SW_SHOWNORMAL);
end;
@ -1296,7 +1296,7 @@ begin
{$IFDEF VerboseFocus}
write('TCustomForm.SetFocusedControl Self=',Name,':',ClassName,' ');
write(' Control=',Control.Name,':',Control.ClassName,' Control.HandleAllocated=',Control.HandleAllocated);
writeln();
DebugLn();
{$ENDIF}
Result:=true;
@ -1388,7 +1388,7 @@ procedure TCustomForm.CreateWnd;
var
DC: HDC;
begin
//writeln('TCustomForm.CreateWnd START ',ClassName);
//DebugLn('TCustomForm.CreateWnd START ',ClassName);
FFormState:=FFormState-[fsBorderStyleChanged,fsFormStyleChanged];
inherited CreateWnd;
CNSendMessage(LM_SETFORMICON, Self, Pointer(GetIconHandle));
@ -1408,12 +1408,12 @@ begin
if (FActiveControl<>nil) and FActiveControl.HandleAllocated
and FActiveControl.Visible and FActiveControl.Enabled then begin
{$IFDEF VerboseFocus}
writeln('TCustomForm.CreateWnd A ',FActiveControl.Name,':',FActiveControl.ClassName);
DebugLn('TCustomForm.CreateWnd A ',FActiveControl.Name,':',FActiveControl.ClassName);
{$ENDIF}
LCLIntf.SetFocus(FActiveControl.Handle);
end;
end;
//writeln('TCustomForm.CreateWnd END ',ClassName);
//DebugLn('TCustomForm.CreateWnd END ',ClassName);
end;
procedure TCustomForm.Loaded;
@ -1429,7 +1429,7 @@ begin
FActiveControl := nil;
if Control.CanFocus then SetActiveControl(Control);
end;
//writeln('TCustomForm.Loaded ',Name,':',ClassName,' ',FormUpdating,' ',fsCreating in FFormState,' ',Visible,' ',fsVisible in FormState);
//DebugLn('TCustomForm.Loaded ',Name,':',ClassName,' ',FormUpdating,' ',fsCreating in FFormState,' ',Visible,' ',fsVisible in FormState);
if fsVisible in FormState then
Visible:=true;
end;
@ -1461,7 +1461,7 @@ var
X, Y : integer;
begin
{$IFDEF CHECK_POSITION}
writeln('[TCustomForm.UpdateShowing] A Class=',Name,':',Classname,' Pos=',Left,',',Top,' Visible=',Visible);
DebugLn('[TCustomForm.UpdateShowing] A Class=',Name,':',Classname,' Pos=',Left,',',Top,' Visible=',Visible);
{$ENDIF}
{ If the the form is about to show, calculate its metrics }
if Visible then begin
@ -1501,11 +1501,11 @@ begin
SetBounds(X, Y, Width, Height);
end;
{$IFDEF CHECK_POSITION}
writeln('[TCustomForm.UpdateShowing] B ',Name,':',Classname,' Pos=',Left,',',Top);
DebugLn('[TCustomForm.UpdateShowing] B ',Name,':',Classname,' Pos=',Left,',',Top);
{$ENDIF}
inherited UpdateShowing;
{$IFDEF CHECK_POSITION}
writeln('[TCustomForm.UpdateShowing] END ',Name,':',Classname,' Pos=',Left,',',Top);
DebugLn('[TCustomForm.UpdateShowing] END ',Name,':',Classname,' Pos=',Left,',',Top);
{$ENDIF}
end;
@ -1516,8 +1516,8 @@ Function TCustomForm.ShowModal: Integer;
procedure RaiseShowModalImpossible;
begin
writeln('TCustomForm.ShowModal Visible=',Visible,' Enabled=',Enabled,
' fsModal=',fsModal in FFormState,' MDIChild=',FormStyle = fsMDIChild);
DebugLn('TCustomForm.ShowModal Visible=',dbgs(Visible),' Enabled=',dbgs(Enabled),
' fsModal=',dbgs(fsModal in FFormState),' MDIChild=',dbgs(FormStyle = fsMDIChild));
raise EInvalidOperation.Create('TCustomForm.ShowModal impossible ');
end;
@ -1536,7 +1536,7 @@ begin
CancelDrag;
// close popupmenus
if ActivePopupMenu<>nil then ActivePopupMenu.Close;
//writeln('[TCustomForm.ShowModal] START ',Classname);
//DebugLn('[TCustomForm.ShowModal] START ',Classname);
if Visible or not Enabled or (fsModal in FFormState)
or (FormStyle = fsMDIChild) then
RaiseShowModalImpossible;
@ -1602,6 +1602,9 @@ end;
{ =============================================================================
$Log$
Revision 1.135 2004/05/11 11:42:27 mattias
replaced writeln by debugln
Revision 1.134 2004/04/23 11:18:28 mattias
fixed unsetting csFocusing

45
lcl/include/customnotebook.inc
View File

@ -36,7 +36,7 @@ end;
------------------------------------------------------------------------------}
function TNBPages.Get(Index: Integer): String;
begin
//writeln('TNBPages.Get Index=',Index);
//DebugLn('TNBPages.Get Index=',Index);
if (Index<0) or (Index>=fPageList.Count) then
RaiseGDBException('TNBPages.Get Index out of bounds');
Result := TCustomPage(fPageList[Index]).Caption;
@ -79,11 +79,11 @@ begin
Msg.fCompStyle := fNotebook.fCompStyle;
Msg.Str := S;
{$IFDEF NOTEBOOK_DEBUG}
writeln('[TNBPages.Put] A ',fNoteBook.Name,' ',Index,' ',S);
DebugLn('[TNBPages.Put] A ',fNoteBook.Name,' ',Index,' ',S);
{$ENDIF}
CNSendMessage(LM_SetLabel, fNotebook, @Msg);
{$IFDEF NOTEBOOK_DEBUG}
writeln('[TNBPages.Put] B ',fNoteBook.Name);
DebugLn('[TNBPages.Put] B ',fNoteBook.Name);
{$ENDIF}
end;
end;
@ -96,7 +96,7 @@ var
begin
// Make sure Index is in the range of valid pages to delete
{$IFDEF NOTEBOOK_DEBUG}
writeln('TNBPages.RemovePage A ',fNoteBook.Name,' Index=',Index,
DebugLn('TNBPages.RemovePage A ',fNoteBook.Name,' Index=',Index,
' fPageList.Count=',fPageList.Count,' fNoteBook.PageIndex=',fNoteBook.PageIndex);
{$ENDIF}
if (Index >= 0) and
@ -139,7 +139,7 @@ begin
end;
end;
{$IFDEF NOTEBOOK_DEBUG}
writeln('TNBPages.RemovePage END ',fNoteBook.Name,' Index=',Index,' fPageList.Count=',fPageList.Count,' fNoteBook.PageIndex=',fNoteBook.PageIndex);
DebugLn('TNBPages.RemovePage END ',fNoteBook.Name,' Index=',Index,' fPageList.Count=',fPageList.Count,' fNoteBook.PageIndex=',fNoteBook.PageIndex);
{$ENDIF}
end;
@ -161,8 +161,8 @@ var
begin
// Make sure Index is in the range of valid pages to delete
{$IFDEF NOTEBOOK_DEBUG}
//writeln('TNBPages.Delete A Index=',Index);
writeln('TNBPages.Delete B ',fNoteBook.Name,' Index=',Index,' fPageList.Count=',fPageList.Count,' fNoteBook.PageIndex=',fNoteBook.PageIndex);
//DebugLn('TNBPages.Delete A Index=',Index);
DebugLn('TNBPages.Delete B ',fNoteBook.Name,' Index=',Index,' fPageList.Count=',fPageList.Count,' fNoteBook.PageIndex=',fNoteBook.PageIndex);
{$ENDIF}
if (Index >= 0) and
(Index < fPageList.Count) then
@ -174,7 +174,7 @@ begin
APage.Free;
end;
{$IFDEF NOTEBOOK_DEBUG}
writeln('TNBPages.Delete END ',fNoteBook.Name,' Index=',Index,' fPageList.Count=',fPageList.Count,' fNoteBook.PageIndex=',fNoteBook.PageIndex);
DebugLn('TNBPages.Delete END ',fNoteBook.Name,' Index=',Index,' fPageList.Count=',fPageList.Count,' fNoteBook.PageIndex=',fNoteBook.PageIndex);
{$ENDIF}
end;
@ -187,7 +187,7 @@ var
NewOwner: TComponent;
begin
{$IFDEF NOTEBOOK_DEBUG}
writeln('TNBPages.Insert A ',fNoteBook.Name,' Index=',Index,' S="',S,'"');
DebugLn('TNBPages.Insert A ',fNoteBook.Name,' Index=',Index,' S="',S,'"');
{$ENDIF}
NewOwner:=fNotebook.Owner;
if NewOwner=nil then
@ -200,11 +200,11 @@ begin
end;
{$IFDEF NOTEBOOK_DEBUG}
writeln('TNBPages.Insert B ',fNoteBook.Name,' Index=',Index,' S="',S,'"');
DebugLn('TNBPages.Insert B ',fNoteBook.Name,' Index=',Index,' S="',S,'"');
{$ENDIF}
InsertPage(Index,tmpPage);
{$IFDEF NOTEBOOK_DEBUG}
writeln('TNBPages.Insert END ',fNoteBook.Name,' Index=',Index,' S="',S,'"');
DebugLn('TNBPages.Insert END ',fNoteBook.Name,' Index=',Index,' S="',S,'"');
{$ENDIF}
end;
@ -217,7 +217,7 @@ var
NewZPosition: integer;
begin
{$IFDEF NOTEBOOK_DEBUG}
writeln('TNBPages.InsertPage A ',fNoteBook.Name,' Index=',Index,' Name=',APage.Name,' Caption=',APage.Caption);
DebugLn('TNBPages.InsertPage A ',fNoteBook.Name,' Index=',Index,' Name=',APage.Name,' Caption=',APage.Caption);
{$ENDIF}
if Index<fPageList.Count then
NewZPosition:=fNoteBook.GetControlIndex(TCustomPage(fPageList[Index]))
@ -246,7 +246,7 @@ begin
fNoteBook.PageIndex := Index;
end;
{$IFDEF NOTEBOOK_DEBUG}
writeln('TNBPages.InsertPage END ',fNoteBook.Name,' Index=',Index,' Name=',APage.Name,' Caption=',APage.Caption);
DebugLn('TNBPages.InsertPage END ',fNoteBook.Name,' Index=',Index,' Name=',APage.Name,' Caption=',APage.Caption);
{$ENDIF}
end;
@ -340,7 +340,7 @@ end;
procedure TCustomNotebook.CreateWnd;
begin
{$IFDEF NOTEBOOK_DEBUG}
writeln('TCustomNotebook.CreateWnd ',Name,':',ClassName,' HandleAllocated=',HandleAllocated);
DebugLn('TCustomNotebook.CreateWnd ',Name,':',ClassName,' HandleAllocated=',HandleAllocated);
{$ENDIF}
inherited CreateWnd;
DoCreateWnd;
@ -357,12 +357,12 @@ var
Msg: TLMNotebookEvent;
begin
{$IFDEF NOTEBOOK_DEBUG}
writeln('TCustomNotebook.DoCreateWnd ',Name,':',ClassName,' HandleAllocated=',HandleAllocated);
DebugLn('TCustomNotebook.DoCreateWnd ',Name,':',ClassName,' HandleAllocated=',HandleAllocated);
{$ENDIF}
fAddingPages:=true;
for i := 0 to FPageList.Count -1 do begin
{$IFDEF NOTEBOOK_DEBUG}
writeln('TCustomNotebook.DoCreateWnd ',Name,':',ClassName,' ',Page[i].Caption,' ',not (pfAdded in Page[i].Flags));
DebugLn('TCustomNotebook.DoCreateWnd ',Name,':',ClassName,' ',Page[i].Caption,' ',not (pfAdded in Page[i].Flags));
{$ENDIF}
if not (pfAdded in Page[i].Flags) then begin
Msg.Parent := Self;
@ -704,7 +704,7 @@ Begin
else
begin
{$IFDEF NOTEBOOK_DEBUG}
writeln('[TCustomNotebook.CNNotify] unhandled NMHdr code:', NMHdr^.code);
DebugLn('[TCustomNotebook.CNNotify] unhandled NMHdr code:', NMHdr^.code);
{$ENDIF}
end;
end;
@ -722,11 +722,11 @@ begin
Msg.fCompStyle := fCompStyle;
Msg.Page := fPageIndex;
{$IFDEF NOTEBOOK_DEBUG}
writeln('[TCustomNotebook.DoSendPageIndex] A ',Name,' PageIndex=',fPageIndex);
DebugLn('[TCustomNotebook.DoSendPageIndex] A ',Name,' PageIndex=',fPageIndex);
{$ENDIF}
CNSendMessage(LM_SETITEMINDEX, Self, @Msg);
{$IFDEF NOTEBOOK_DEBUG}
writeln('[TCustomNotebook.DoSendPageIndex] B');
DebugLn('[TCustomNotebook.DoSendPageIndex] B');
{$ENDIF}
end;
@ -742,11 +742,11 @@ begin
Msg.fCompStyle := fCompStyle;
Msg.ShowTabs := fShowTabs;
{$IFDEF NOTEBOOK_DEBUG}
writeln('[TCustomNotebook.DoSendShowTabs] A ',Name);
DebugLn('[TCustomNotebook.DoSendShowTabs] A ',Name);
{$ENDIF}
CNSendMessage(LM_SHOWTABS, Self, @Msg);
{$IFDEF NOTEBOOK_DEBUG}
writeln('[TCustomNotebook.DoSendShowTabs] B ',Name);
DebugLn('[TCustomNotebook.DoSendShowTabs] B ',Name);
{$ENDIF}
end;
@ -792,6 +792,9 @@ end;}
{ =============================================================================
$Log$
Revision 1.47 2004/05/11 11:42:27 mattias
replaced writeln by debugln
Revision 1.46 2004/04/11 11:30:39 vincents
Reduced output, fixes bug 220

15
lcl/include/customradiogroup.inc
View File

@ -104,14 +104,14 @@ var
begin
if FCreatingWnd then exit;
FCreatingWnd := true;
//writeln('[TCustomRadioGroup.CreateWnd] A ',Name,':',ClassName,' FItems.Count=',FItems.Count,' HandleAllocated=',HandleAllocated,' ItemIndex=',ItemIndex);
//DebugLn('[TCustomRadioGroup.CreateWnd] A ',Name,':',ClassName,' FItems.Count=',FItems.Count,' HandleAllocated=',HandleAllocated,' ItemIndex=',ItemIndex);
// destroy radiobuttons, if there are too many
while FButtonList.Count>FItems.Count do begin
TRadioButton(FButtonList[FButtonList.Count-1]).Free;
FButtonList.Delete(FButtonList.Count-1);
end;
//writeln('[TCustomRadioGroup.CreateWnd] B ',Name,':',ClassName,' FItems.Count=',FItems.Count,' HandleAllocated=',HandleAllocated);
//DebugLn('[TCustomRadioGroup.CreateWnd] B ',Name,':',ClassName,' FItems.Count=',FItems.Count,' HandleAllocated=',HandleAllocated);
// create as many TRadioButton as needed
while (FButtonList.Count<FItems.Count) do begin
@ -129,12 +129,12 @@ begin
end;
end;
//writeln('[TCustomRadioGroup.CreateWnd] C ',Name,':',ClassName,' FItems.Count=',FItems.Count,' HandleAllocated=',HandleAllocated);
//DebugLn('[TCustomRadioGroup.CreateWnd] C ',Name,':',ClassName,' FItems.Count=',FItems.Count,' HandleAllocated=',HandleAllocated);
if (FItemIndex>=FItems.Count) then FItemIndex:=FItems.Count-1;
//writeln('[TCustomRadioGroup.CreateWnd] D ',Name,':',ClassName,' ',FItems.Count);
//DebugLn('[TCustomRadioGroup.CreateWnd] D ',Name,':',ClassName,' ',FItems.Count);
inherited CreateWnd;
//writeln('[TCustomRadioGroup.CreateWnd] E ',Name,':',ClassName,' ',FItems.Count,' ',FButtonList.Count);
//DebugLn('[TCustomRadioGroup.CreateWnd] E ',Name,':',ClassName,' ',FItems.Count,' ',FButtonList.Count);
if FItems.Count>0 then begin
for i:=0 to FItems.Count-1 do begin
@ -158,7 +158,7 @@ begin
end;
FHiddenButton.Checked:=(fItemIndex=-1);
end;
//writeln('[TCustomRadioGroup.CreateWnd] F ',Name,':',ClassName,' FItems.Count=',FItems.Count,' HandleAllocated=',HandleAllocated,' ItemIndex=',ItemIndex);
//DebugLn('[TCustomRadioGroup.CreateWnd] F ',Name,':',ClassName,' FItems.Count=',FItems.Count,' HandleAllocated=',HandleAllocated,' ItemIndex=',ItemIndex);
FCreatingWnd := false;
end;
@ -396,6 +396,9 @@ end;
{
$Log$
Revision 1.28 2004/05/11 11:42:27 mattias
replaced writeln by debugln
Revision 1.27 2004/04/10 17:58:57 mattias
implemented mainunit hints for include files

35
lcl/include/imglist.inc
View File

@ -70,7 +70,7 @@ begin
Change;
except
on E: Exception do begin
writeln('TCustomImageList.Add ',E.Message);
DebugLn('TCustomImageList.Add ',E.Message);
Result := -1; // Ignore exceptions, just return -1
end;
end;
@ -166,7 +166,7 @@ begin
Change;
except
on E: Exception do begin
writeln('TCustomImageList.AddMasked ',E.Message);
DebugLn('TCustomImageList.AddMasked ',E.Message);
Result := -1; // Ignore exceptions, just return -1
end;
end;
@ -466,7 +466,7 @@ end;
procedure TCustomImageList.GetBitmap(Index: Integer; Image: TBitmap);
begin
if (FCount = 0) or (Image = nil) then Exit;
//writeln('TCustomImageList.GetBitmap Index=',Index,' Image=',HexStr(Cardinal(Image),8),' Bitmap=',HexStr(Cardinal(FImageList.Items[Index]),8));
//DebugLn('TCustomImageList.GetBitmap Index=',Index,' Image=',HexStr(Cardinal(Image),8),' Bitmap=',HexStr(Cardinal(FImageList.Items[Index]),8));
Image.Assign(TBitMap(FImageList.Items[Index]));
end;
@ -812,7 +812,7 @@ begin
for i:=0 to Count-1 do
begin
CurImage:=TBitmap(FImageList[i]);
//writeln('TCustomImageList.WriteData Position=',AStream.Position,' ',CurImage.Width,',',CurImage.Height);
//DebugLn('TCustomImageList.WriteData Position=',AStream.Position,' ',CurImage.Width,',',CurImage.Height);
CurImage.WriteNativeStream(AStream,true,bnXPixmap);
end;
{$ENDIF}
@ -835,10 +835,10 @@ var
i, NewCount, Size: Integer;
bmp: TBitmap;
begin
//writeln('TCustomImageList.ReadData DoReadLaz1');
//DebugLn('TCustomImageList.ReadData DoReadLaz1');
// provided for compatability for earlier lazarus streams
NewCount := AStream.ReadWord;
//writeln('TCustomImageList.ReadData DoReadLaz1 NewCount=',NewCount);
//DebugLn('TCustomImageList.ReadData DoReadLaz1 NewCount=',NewCount);
for i := 0 to NewCount - 1 do
begin
bmp := TBitMap.Create;
@ -854,17 +854,17 @@ var
i, NewCount, Size: cardinal;
bmp: TBitmap;
begin
//writeln('TCustomImageList.ReadData DoReadLaz2');
//DebugLn('TCustomImageList.ReadData DoReadLaz2');
NewCount := AStream.ReadDWord;
Width := AStream.ReadDWord;
Height := AStream.ReadDWord;
//writeln('TCustomImageList.ReadData DoReadLaz2 NewCount=',NewCount,' Width=',Width,' Height=',Height);
//DebugLn('TCustomImageList.ReadData DoReadLaz2 NewCount=',NewCount,' Width=',Width,' Height=',Height);
for i := 0 to NewCount - 1 do
begin
bmp := TBitMap.Create;
//writeln('TCustomImageList.ReadData DoReadLaz2 i=',i,' ',AStream.Position);
//DebugLn('TCustomImageList.ReadData DoReadLaz2 i=',i,' ',AStream.Position);
AStream.Read(Size, SizeOf(Size));
//writeln('TCustomImageList.ReadData DoReadLaz2 Size=',Size,' ',AStream.Position);
//DebugLn('TCustomImageList.ReadData DoReadLaz2 Size=',Size,' ',AStream.Position);
bmp.ReadStream(AStream, True, Size);
AddDirect(bmp, nil);
end;
@ -899,14 +899,14 @@ var
false)
then
raise EInvalidGraphicOperation.Create('TCustomImageList.CreateImagesFromRawImage Create bitmaps');
//writeln('CreateImagesFromRawImage A ',HexStr(Cardinal(SubRawImage.Data),8),' ',SubRawImage.DataSize);
//DebugLn('CreateImagesFromRawImage A ',HexStr(Cardinal(SubRawImage.Data),8),' ',SubRawImage.DataSize);
FreeRawImageData(@SubRawImage);
Img := TBitmap.Create;
Img.Handle:=ImgHandle;
Img.MaskHandle:=MaskHandle;
AddDirect(Img, nil);
//writeln('CreateImagesFromRawImage B ',Img.Width,',',Img.Height,' ',Count);
//DebugLn('CreateImagesFromRawImage B ',Img.Width,',',Img.Height,' ',Count);
Img := nil;
Dec(NewCount);
end;
@ -962,7 +962,7 @@ var
Filename:='TCustomImageList'+IntToStr(i)+'.stream';
until not FileExists(Filename);
CurStreamPos := AStream.Position;
writeln('TCustomImageList.ReadData Saving stream to ',Filename);
DebugLn('TCustomImageList.ReadData Saving stream to ',Filename);
fs:=TFileStream.Create(Filename,fmCreate);
AStream.Position:=StreamPos;
fs.CopyFrom(AStream,AStream.Size-AStream.Position);
@ -1005,13 +1005,13 @@ begin
then begin
AStream.ReadWord; //Skip ?
NewCount := AStream.ReadWord;
//writeln('NewCount=',NewCount);
//DebugLn('NewCount=',NewCount);
AStream.ReadWord; //Skip Capacity
AStream.ReadWord; //Skip Grow
FWidth := AStream.ReadWord;
//writeln('NewWidth=',FWidth);
//DebugLn('NewWidth=',FWidth);
FHeight := AStream.ReadWord;
//writeln('NewHeight=',FHeight);
//DebugLn('NewHeight=',FHeight);
FBKColor := TColor(AStream.ReadDWord);
{$IFNDEF DisableFPImage}
HasMask := (AStream.ReadWord and 1) = 1;
@ -1261,6 +1261,9 @@ end;
{
$Log$
Revision 1.39 2004/05/11 11:42:27 mattias
replaced writeln by debugln
Revision 1.38 2004/04/10 17:58:57 mattias
implemented mainunit hints for include files

90
lcl/include/treeview.inc
View File

@ -87,7 +87,7 @@ begin
r:=Count-1;
while (l<=r) do begin
m:=(l+r) shr 1;
//writeln(':0 [IndexOfNodeAtTop] m=',m,' y=',y,' ',NodeArray[m].Text,' NodeArray[m].Top=',NodeArray[m].Top,' NodeArray[m].BottomExpanded=',NodeArray[m].BottomExpanded);
//DebugLn(':0 [IndexOfNodeAtTop] m=',m,' y=',y,' ',NodeArray[m].Text,' NodeArray[m].Top=',NodeArray[m].Top,' NodeArray[m].BottomExpanded=',NodeArray[m].BottomExpanded);
if NodeArray[m].Top>y then
r:=m-1
else if NodeArray[m].BottomExpanded<=y then
@ -195,7 +195,7 @@ destructor TTreeNode.Destroy;
// CheckValue: Integer;
begin
{$IFDEF TREEVIEW_DEBUG}
writeln('[TTreeNode.Destroy] Self=',HexStr(Cardinal(Self),8),' Self.Text=',Text);
DebugLn('[TTreeNode.Destroy] Self=',HexStr(Cardinal(Self),8),' Self.Text=',Text);
{$ENDIF}
FDeleting := True;
HasChildren := false;
@ -468,7 +468,7 @@ end;
procedure TTreeNode.DoExpand(ExpandIt: Boolean);
begin
//writeln('[TTreeNode.DoExpand] Self=',HexStr(Cardinal(Self),8),' Text=',Text,
//DebugLn('[TTreeNode.DoExpand] Self=',HexStr(Cardinal(Self),8),' Text=',Text,
//' HasChildren=',HasChildren,' ExpandIt=',ExpandIt,' Expanded=',Expanded);
if HasChildren and (Expanded<>ExpandIt) then begin
if (TreeView<>nil) then begin
@ -677,7 +677,7 @@ procedure TTreeNode.SetHasChildren(AValue: Boolean);
//var Item: TTVItem;
begin
if AValue=HasChildren then exit;
//writeln('[TTreeNode.SetHasChildren] Self=',HexStr(Cardinal(Self),8),
//DebugLn('[TTreeNode.SetHasChildren] Self=',HexStr(Cardinal(Self),8),
//' Self.Text=',Text,' AValue=',AValue);
if AValue then
Include(FStates,nsHasChildren)
@ -1008,7 +1008,7 @@ var OldIndex, i: integer;
TheTreeView: TCustomTreeView;
begin
{$IFDEF TREEVIEW_DEBUG}
writeln('[TTreeNode.Unbind] Self=',HexStr(Cardinal(Self),8),' Self.Text=',Text);
DebugLn('[TTreeNode.Unbind] Self=',HexStr(Cardinal(Self),8),' Self.Text=',Text);
{$ENDIF}
Selected:=false;
if Owner<>nil then begin
@ -1087,7 +1087,7 @@ begin
write('[TTreeNode.InternalMove] Self=',HexStr(Cardinal(Self),8),' Self.Text=',Text
,' ANode=',ANode<>nil,' AddMode=',AddModeNames[AddMode]);
if ANode<>nil then write(' ANode.Text=',ANode.Text);
writeln('');
DebugLn('');
{$ENDIF}
Unbind;
// set parent
@ -1166,7 +1166,7 @@ begin
taInsert:
begin
// insert node in front of ANode
//writeln('[TTreeNode.InternalMove] ANode.Index=',ANode.Index,' ANode=',HexStr(Cardinal(ANode),8));
//DebugLn('[TTreeNode.InternalMove] ANode.Index=',ANode.Index,' ANode=',HexStr(Cardinal(ANode),8));
FNextBrother:=ANode;
FPrevBrother:=ANode.GetPrevSibling;
if Owner<>nil then begin
@ -1186,7 +1186,7 @@ begin
write('[TTreeNode.InternalMove] END Self=',HexStr(Cardinal(Self),8),' Self.Text=',Text
,' ANode=',ANode<>nil,' AddMode=',AddModeNames[AddMode]);
if ANode<>nil then write(' ANode.Text=',ANode.Text);
writeln('');
DebugLn('');
{$ENDIF}
{var
@ -1692,7 +1692,7 @@ begin
write('TTreeNode.WriteDebugReport Self=',HexStr(Cardinal(Self),8));
write(' Consistency=',ConsistencyCheck);
write(' Text=',Text);
writeln('');
DebugLn('');
if Recurse then begin
for i:=0 to FCount-1 do
Items[i].WriteDebugReport(Prefix+' ',true);
@ -1888,7 +1888,7 @@ begin
write('[TTreeNodes.InternalAddObject] Node=',Node<>nil,' S=',S,
' AddMode=',AddModeNames[AddMode]);
if Node<>nil then write(' Node.Text=',Node.Text);
writeln('');
DebugLn('');
{$ENDIF}
Result := Owner.CreateNode;
ok:=false;
@ -2124,7 +2124,7 @@ procedure TTreeNodes.MoveTopLvlNode(TopLvlFromIndex, TopLvlToIndex: integer;
var i: integer;
begin
{$IFDEF TREEVIEW_DEBUG}
writeln('[TTreeNodes.MoveTopLvlNode] TopLvlFromIndex=',TopLvlFromIndex,
DebugLn('[TTreeNodes.MoveTopLvlNode] TopLvlFromIndex=',TopLvlFromIndex,
' TopLvlToIndex=',TopLvlToIndex,' Node.Text=',Node.Text);
{$ENDIF}
if (TopLvlFromIndex>=FTopLvlCount) then
@ -2322,10 +2322,10 @@ begin
exit;
end;
inc(RealCount,Node.SubTreeCount);
//writeln(' ConsistencyCheck: B ',RealCount,',',Node.SubTreeCount);
//DebugLn(' ConsistencyCheck: B ',RealCount,',',Node.SubTreeCount);
Node:=Node.FNextBrother;
end;
//writeln(' ConsistencyCheck: B ',RealCount,',',FCount);
//DebugLn(' ConsistencyCheck: B ',RealCount,',',FCount);
if RealCount<>FCount then exit(-3);
if (FTopLvlCapacity<=0) and (FTopLvlItems<>nil) then exit(-4);
if (FTopLvlCapacity>0) and (FTopLvlItems=nil) then exit(-5);
@ -2337,7 +2337,7 @@ begin
exit(-9);
if (i<FTopLvlCount-1) and (FTopLvlItems[i].FNextBrother<>FTopLvlItems[i+1])
then begin
writeln(' CONSISTENCY i=',i,' FTopLvlCount=',FTopLvlCount,' FTopLvlItems[i]=',HexStr(Cardinal(FTopLvlItems[i]),8),' FTopLvlItems[i].FNextBrother=',HexStr(Cardinal(FTopLvlItems[i].FNextBrother),8),' FTopLvlItems[i+1]=',HexStr(Cardinal(FTopLvlItems[i+1]),8));
DebugLn(' CONSISTENCY i=',dbgs(i),' FTopLvlCount=',dbgs(FTopLvlCount),' FTopLvlItems[i]=',HexStr(Cardinal(FTopLvlItems[i]),8),' FTopLvlItems[i].FNextBrother=',HexStr(Cardinal(FTopLvlItems[i].FNextBrother),8),' FTopLvlItems[i+1]=',HexStr(Cardinal(FTopLvlItems[i+1]),8));
exit(-10);
end;
if (i=FTopLvlCount-1) and (FTopLvlItems[i].FNextBrother<>nil) then
@ -2357,7 +2357,7 @@ begin
write(Prefix);
write('TTreeNodes.WriteDebugReport Self=',HexStr(Cardinal(Self),8));
write(' Consistency=',ConsistencyCheck);
writeln('');
DebugLn('');
if AllNodes then begin
Node:=GetFirstNode;
while Node<>nil do begin
@ -2570,7 +2570,7 @@ begin
write(Prefix);
write('TTreeStrings.WriteDebugReport Self=',HexStr(Cardinal(Self),8));
write(' Consistency=',ConsistencyCheck);
writeln('');
DebugLn('');
end;
@ -2815,7 +2815,7 @@ end;
procedure TCustomTreeView.SetScrolledLeft(AValue: integer);
begin
//writeln('@@@@@ ',FScrolledTop,',',AValue);
//DebugLn('@@@@@ ',FScrolledTop,',',AValue);
if AValue<0 then AValue:=0;
if AValue=FScrolledLeft then exit;
if AValue>GetMaxScrollLeft then AValue:=GetMaxScrollLeft;
@ -2827,7 +2827,7 @@ end;
procedure TCustomTreeView.SetScrolledTop(AValue: integer);
begin
//writeln('$$$$$ ',FScrolledTop,',',AValue);
//DebugLn('$$$$$ ',FScrolledTop,',',AValue);
if FScrolledTop=AValue then exit;
if AValue<0 then AValue:=0;
if AValue>GetMaxScrollTop then AValue:=GetMaxScrollTop;
@ -2998,7 +2998,7 @@ end;
procedure TCustomTreeView.UpdateTopItem;
begin
//writeln('TCustomTreeView.UpdateTopItem tvsTopItemNeedsUpdate in FStates=',tvsTopItemNeedsUpdate in FStates);
//DebugLn('TCustomTreeView.UpdateTopItem tvsTopItemNeedsUpdate in FStates=',tvsTopItemNeedsUpdate in FStates);
if (FStates*[tvsTopItemNeedsUpdate,tvsTopsNeedsUpdate]=[]) then exit;
FTopItem:=GetNodeAtY(BorderWidth);
Exclude(FStates,tvsTopItemNeedsUpdate);
@ -3136,7 +3136,7 @@ begin
else begin
Result:=LastVisibleNode.Top+LastVisibleNode.Height
-(ClientHeight-ScrollBarWidth)+2*BorderWidth;
//writeln('>>> ',LastVisibleNode.Text,' ',Result);
//DebugLn('>>> ',LastVisibleNode.Text,' ',Result);
if Result<0 then Result:=0;
end;
end;
@ -3370,17 +3370,17 @@ end;
function TCustomTreeView.IsNodeVisible(ANode: TTreeNode): Boolean;
begin
Result:=(ANode<>nil) and (ANode.AreParentsExpanded);
//writeln('[TCustomTreeView.IsNodeVisible] A Node=',HexStr(Cardinal(ANode),8),
//DebugLn('[TCustomTreeView.IsNodeVisible] A Node=',HexStr(Cardinal(ANode),8),
//' ANode.AreParentsExpanded=',ANode.AreParentsExpanded);
if Result then begin
//writeln('[TCustomTreeView.IsNodeVisible] B Node=',HexStr(Cardinal(ANode),8),
//DebugLn('[TCustomTreeView.IsNodeVisible] B Node=',HexStr(Cardinal(ANode),8),
//' ',FScrolledTop,'>=',ANode.Top,'+',ANode.Height,' or ',FScrolledTop,'+',ClientHeight,'<',ANode.Top);
if (FScrolledTop>=ANode.Top+ANode.Height)
or (FScrolledTop+(ClientHeight-ScrollBarWidth)-2*BorderWidth<ANode.Top)
then
Result:=false;
end;
//writeln('[TCustomTreeView.IsNodeVisible] END Node=',HexStr(Cardinal(ANode),8),
//DebugLn('[TCustomTreeView.IsNodeVisible] END Node=',HexStr(Cardinal(ANode),8),
//' Node.Text=',ANode.Text,' Visible=',Result);
end;
@ -3486,7 +3486,7 @@ begin
ShowScrollBar(Handle,SB_HORZ,True);
end;
end;
//writeln('>>>>>>>>>> [TCustomTreeView.UpdateScrollbars] nMin=',ScrollInfo.nMin,
//DebugLn('>>>>>>>>>> [TCustomTreeView.UpdateScrollbars] nMin=',ScrollInfo.nMin,
//' nMax=',ScrollInfo.nMax,' nPage=',ScrollInfo.nPage,
//' nPos=',ScrollInfo.nPos,' GetMaxScrollLeft=',GetMaxScrollLeft,
//' ClientW=',ClientWidth,
@ -3519,11 +3519,11 @@ begin
ShowScrollBar(Handle,SB_VERT,True);
end;
end;
//writeln('>>>>>>>>>> [TCustomTreeView.UpdateScrollbars] Vert On nMin=',ScrollInfo.nMin,
//DebugLn('>>>>>>>>>> [TCustomTreeView.UpdateScrollbars] Vert On nMin=',ScrollInfo.nMin,
//' nMax=',ScrollInfo.nMax,' nPage=',ScrollInfo.nPage,
//' nPos=',ScrollInfo.nPos,' GetMaxScrollTop=',GetMaxScrollTop);
end else begin
//writeln('>>>>>>>>>> [TCustomTreeView.UpdateScrollbars] Vert Off ');
//DebugLn('>>>>>>>>>> [TCustomTreeView.UpdateScrollbars] Vert Off ');
FLastVertScrollInfo.cbSize:=0;
ShowScrollBar(Handle,SB_VERT,false);
end;
@ -3978,7 +3978,7 @@ var
P: TPoint;
begin
{$IFDEF VerboseDrag}
writeln('TCustomTreeView.DoStartDrag A ',Name,':',ClassName);
DebugLn('TCustomTreeView.DoStartDrag A ',Name,':',ClassName);
{$ENDIF}
inherited DoStartDrag(DragObject);
FLastDropTarget := nil;
@ -3987,9 +3987,9 @@ begin
with ScreenToClient(P) do FDragNode := GetNodeAt(X, Y);
{$IFDEF VerboseDrag}
if FDragNode<>nil then
writeln('TCustomTreeView.DoStartDrag DragNode=',FDragNode.Text)
DebugLn('TCustomTreeView.DoStartDrag DragNode=',FDragNode.Text)
else
writeln('TCustomTreeView.DoStartDrag DragNode=nil');
DebugLn('TCustomTreeView.DoStartDrag DragNode=nil');
{$ENDIF}
end;
end;
@ -3997,7 +3997,7 @@ end;
procedure TCustomTreeView.DoEndDrag(Target: TObject; X, Y: Integer);
begin
{$IFDEF VerboseDrag}
writeln('TCustomTreeView.DoEndDrag A ',Name,':',ClassName);
DebugLn('TCustomTreeView.DoEndDrag A ',Name,':',ClassName);
{$ENDIF}
inherited DoEndDrag(Target, X, Y);
FLastDropTarget := nil;
@ -4007,7 +4007,7 @@ procedure TCustomTreeView.CMDrag(var AMessage: TCMDrag);
begin
inherited CMDrag(AMessage);
{$IFDEF VerboseDrag}
writeln('TCustomTreeView.CMDrag ',Name,':',ClassName,' ',ord(AMessage.DragMessage));
DebugLn('TCustomTreeView.CMDrag ',Name,':',ClassName,' ',ord(AMessage.DragMessage));
{$ENDIF}
with AMessage, DragRec^ do
case DragMessage of
@ -4035,7 +4035,7 @@ begin
inherited DragOver(Source,X,Y,State,Accept);
Node := GetNodeAt(X, Y);
{$IFDEF VerboseDrag}
writeln('TCustomTreeView.DragOver ',Name,':',ClassName,' ',Node<>nil,' ',Node <> DropTarget,' ',Node = FLastDropTarget);
DebugLn('TCustomTreeView.DragOver ',Name,':',ClassName,' ',Node<>nil,' ',Node <> DropTarget,' ',Node = FLastDropTarget);
{$ENDIF}
if (Node <> nil)
and ((Node <> DropTarget) or (Node = FLastDropTarget)) then
@ -4067,12 +4067,12 @@ begin
// draw nodes
Node:=TopItem;
//write('[TCustomTreeView.DoPaint] A Node=',HexStr(Cardinal(Node),8));
//if Node<>nil then writeln(' Node.Text=',Node.Text) else writeln('');
//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));
//if Node<>nil then writeln(' Node.Text=',Node.Text) else writeln('');
//if Node<>nil then DebugLn(' Node.Text=',Node.Text) else DebugLn('');
end;
// draw insert mark for new root node
if (InsertMarkType=tvimAsFirstChild)
@ -4089,11 +4089,11 @@ begin
Node:=BottomItem;
if Node<>nil then
SpaceRect.Top:=Node.Top+Node.Height-FScrolledTop+BorderWidth;
//if Node<>nil then writeln('BottomItem=',BottomItem.text) else writeln('NO BOTTOMITEM!!!!!!!!!');
//if Node<>nil then DebugLn('BottomItem=',BottomItem.text) else DebugLn('NO BOTTOMITEM!!!!!!!!!');
// TWinControl(Parent).InvalidateRect(Self,SpaceRect,true);
if (FBackgroundColor<>clNone) and (SpaceRect.Top<SpaceRect.Bottom) then
begin
//writeln(' SpaceRect=',SpaceRect.Left,',',SpaceRect.Top,',',SpaceRect.Right,',',SpaceRect.Bottom);
//DebugLn(' SpaceRect=',SpaceRect.Left,',',SpaceRect.Top,',',SpaceRect.Right,',',SpaceRect.Bottom);
Brush.Color:=FBackgroundColor;
FillRect(SpaceRect);
end;
@ -4138,7 +4138,7 @@ var
Blue:=AColor and $ff;
if Red+Green+Blue>$180 then
Result:=clBlack;
//writeln('[TCustomTreeView.DoPaintNode.InvertColor] Result=',Result,' ',Red,',',Green,',',Blue);
//DebugLn('[TCustomTreeView.DoPaintNode.InvertColor] Result=',Result,' ',Red,',',Green,',',Blue);
end;
function DrawTreeLines(CurNode: TTreeNode): integer;
@ -4324,7 +4324,7 @@ begin
PaintImages:=true;
end;
VertMid:=(NodeRect.Top+NodeRect.Bottom) shr 1;
//writeln('[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=',HexStr(Cardinal(Node),8),' 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
@ -4530,7 +4530,7 @@ var
bStartDrag: boolean;
begin
{$IFDEF VerboseDrag}
writeln('TCustomTreeView.MouseDown A ',Name,':',ClassName,' ');
DebugLn('TCustomTreeView.MouseDown A ',Name,':',ClassName,' ');
{$ENDIF}
fMouseDownX := X;
fMouseDownY := Y;
@ -4561,7 +4561,7 @@ begin
end else if x>=CursorNode.DisplayTextLeft then begin
// mousedown occured in text -> select node and begin drag operation
{$IFDEF VerboseDrag}
writeln('TCustomTreeView.MouseDown In Text ',Name,':',ClassName,' MouseCapture=',MouseCapture);
DebugLn('TCustomTreeView.MouseDown In Text ',Name,':',ClassName,' MouseCapture=',MouseCapture);
{$ENDIF}
if MouseCapture then
Include(FStates,tvsMouseCapture);
@ -4586,7 +4586,7 @@ begin
end;
if (bStartDrag) then begin
{$IFDEF VerboseDrag}
writeln('TCustomTreeView.MouseDown A bStartDrag ',Name,':',ClassName,' ');
DebugLn('TCustomTreeView.MouseDown A bStartDrag ',Name,':',ClassName,' ');
{$ENDIF}
FDragNode:=CursorNode;
Include(fStates,tvsWaitForDragging);
@ -4602,7 +4602,7 @@ begin
or (Abs(fMouseDownY - Y) >= GetSystemMetrics(SM_CYDRAG))
then begin
{$IFDEF VerboseDrag}
writeln('TCustomTreeView.MouseMove A Begindrag ',Name,':',ClassName,' ');
DebugLn('TCustomTreeView.MouseMove A Begindrag ',Name,':',ClassName,' ');
{$ENDIF}
Exclude(fStates, tvsWaitForDragging);
BeginDrag(false);
@ -4803,12 +4803,12 @@ procedure TCustomTreeView.WMLButtonDown(var AMessage: TLMLButtonDown);
P: TSmallPoint;}
begin
{$IFDEF VerboseDrag}
writeln('TCustomTreeView.WMLButtonDown A ',Name,':',ClassName,' ');
DebugLn('TCustomTreeView.WMLButtonDown A ',Name,':',ClassName,' ');
{$ENDIF}
Exclude(FStates,tvsDragged);
inherited WMLButtonDown(AMessage);
{$IFDEF VerboseDrag}
writeln('TCustomTreeView.WMLButtonDown END ',Name,':',ClassName,' ');
DebugLn('TCustomTreeView.WMLButtonDown END ',Name,':',ClassName,' ');
{$ENDIF}
{
FDragNode := nil;
@ -5002,7 +5002,7 @@ begin
write(Prefix);
write('TCustomTreeView.WriteDebugReport Self=',HexStr(Cardinal(Self),8));
write(' Consistency=',ConsistencyCheck);
writeln('');
DebugLn('');
if AllNodes then begin
Items.WriteDebugReport(Prefix+' ',true);
end;

175
lcl/include/wincontrol.inc
View File

@ -115,7 +115,7 @@ var
{$IFDEF CHECK_POSITION}
if AnsiCompareText(Control.ClassName,'TScrollBar')=0 then
with Control do
writeln('[TWinControl.AlignControls.DoPosition] A Control=',Name,':',ClassName,' ',Left,',',Top,',',Width,',',Height,' recalculate the anchors=',(Control.Anchors <> AnchorAlign[AAlign]),' Align=',AlignNames[AAlign]);
DebugLn('[TWinControl.AlignControls.DoPosition] A Control=',Name,':',ClassName,' ',Left,',',Top,',',Width,',',Height,' recalculate the anchors=',(Control.Anchors <> AnchorAlign[AAlign]),' Align=',AlignNames[AAlign]);
{$ENDIF}
@ -171,7 +171,7 @@ var
{$IFDEF CHECK_POSITION}
//if csDesigning in ComponentState then
if AnsiCompareText(Control.ClassName,'TScrollBar')=0 then
writeln('[TWinControl.AlignControls.DoPosition] Before Anchoring ',
DebugLn('[TWinControl.AlignControls.DoPosition] Before Anchoring ',
' ',Name,':',ClassName,
' CurBaseBounds=',CurBaseBounds.Left,',',CurBaseBounds.Top,',',CurBaseBounds.Right-CurBaseBounds.Left,',',CurBaseBounds.Bottom-CurBaseBounds.Top,
' ParBaseClient=',ParentBaseClientSize.X,',',ParentBaseClientSize.Y,
@ -241,7 +241,7 @@ var
//if csDesigning in ComponentState then
if AnsiCompareText(Control.ClassName,'TScrollBar')=0 then
with Control do
writeln('[TWinControl.AlignControls.DoPosition] After Anchoring',
DebugLn('[TWinControl.AlignControls.DoPosition] After Anchoring',
' ',Name,':',ClassName,
' Align=',AlignNames[AAlign],
' Control=',Name,':',ClassName,
@ -271,7 +271,7 @@ var
NewBottom:=NewTop+NewHeight;
{$IFDEF CHECK_POSITION}
if AnsiCompareText(Control.ClassName,'TScrollBar')=0 then
writeln(' Before aligning akRight in AnchorAlign[AAlign]=',akRight in AnchorAlign[AAlign],
DebugLn(' Before aligning akRight in AnchorAlign[AAlign]=',akRight in AnchorAlign[AAlign],
' akLeft in Control.Anchors=',akLeft in Control.Anchors,
' ARect=',ARect.Left,',',ARect.Top,',',ARect.Right,',',ARect.Bottom,
' New=',NewLeft,',',NewTop,',',NewRight,',',NewBottom);
@ -341,7 +341,7 @@ var
//if csDesigning in Control.ComponentState then
if AnsiCompareText(Control.ClassName,'TScrollBar')=0 then
with Control do
writeln('[TWinControl.AlignControls.DoPosition] After Aligning',
DebugLn('[TWinControl.AlignControls.DoPosition] After Aligning',
' ',Name,':',ClassName,
' Align=',AlignNames[AAlign],
' Control=',Name,':',ClassName,
@ -359,7 +359,7 @@ var
//if csDesigning in Control.ComponentState then
if AnsiCompareText(Control.ClassName,'TScrollBar')=0 then
with Control do
writeln('[TWinControl.AlignControls.DoPosition] NEW BOUNDS Control=',Name,':',ClassName,' NewBounds=',NewLeft,',',NewTop,',',NewWidth,',',NewHeight,' Align=',AlignNames[AAlign]);
DebugLn('[TWinControl.AlignControls.DoPosition] NEW BOUNDS Control=',Name,':',ClassName,' NewBounds=',NewLeft,',',NewTop,',',NewWidth,',',NewHeight,' Align=',AlignNames[AAlign]);
{$ENDIF}
// lock the base bounds, so that the new automatic bounds do not override
// the user settings
@ -377,7 +377,7 @@ var
//if csDesigning in Control.ComponentState then
if AnsiCompareText(Control.ClassName,'TScrollBar')=0 then
with Control do
writeln('[TWinControl.AlignControls.DoPosition] AFTER SETBOUND Control=',Name,':',ClassName,' Bounds=',Left,',',Top,',',Width,',',Height);
DebugLn('[TWinControl.AlignControls.DoPosition] AFTER SETBOUND Control=',Name,':',ClassName,' Bounds=',Left,',',Top,',',Width,',',Height);
{$ENDIF}
end;
@ -406,7 +406,7 @@ var
{$IFDEF CHECK_POSITION}
if AnsiCompareText(Control.ClassName,'TScrollBar')=0 then
with Control do
writeln('[TWinControl.AlignControls.DoPosition] END Control=',
DebugLn('[TWinControl.AlignControls.DoPosition] END Control=',
Name,':',ClassName,
' ',Left,',',Top,',',Width,',',Height,
' Align=',AlignNames[AAlign],
@ -490,14 +490,14 @@ begin
try
//if csDesigning in ComponentState then begin
//writeln('[TWinControl.AlignControls] ',Name,':',Classname,' ',Left,',',Top,',',Width,',',Height,' AlignWork=',AlignWork,' ControlCount=',ControlCount);
//if AControl<>nil then writeln(' AControl=',AControl.Name,':',AControl.ClassName);
//DebugLn('[TWinControl.AlignControls] ',Name,':',Classname,' ',Left,',',Top,',',Width,',',Height,' AlignWork=',AlignWork,' ControlCount=',ControlCount);
//if AControl<>nil then DebugLn(' AControl=',AControl.Name,':',AControl.ClassName);
//end;
if AlignWork then
begin
AdjustClientRect(ARect);
FAdjustClientRectRealized:=ARect;
//writeln('[TWinControl.AlignControls] ',Name,':',Classname,' ',Left,',',Top,',',Width,',',Height,' ClientRect=',ARect.Left,',',ARect.Top,',',ARect.Right,',',ARect.Bottom);
//DebugLn('[TWinControl.AlignControls] ',Name,':',Classname,' ',Left,',',Top,',',Width,',',Height,' ClientRect=',ARect.Left,',',ARect.Top,',',ARect.Right,',',ARect.Bottom);
AlignList := TList.Create;
try
DoAlign(alTop);
@ -631,7 +631,7 @@ end;
Procedure TWinControl.CMDrag(var Message: TCMDrag);
Begin
{$IFDEF VerboseDrag}
writeln('TWinControl.CMDrag ',Name,':',ClassName,' ',ord(Message.DragMessage));
DebugLn('TWinControl.CMDrag ',Name,':',ClassName,' ',ord(Message.DragMessage));
{$ENDIF}
DoDragMsg(Message);
end;
@ -685,7 +685,7 @@ begin
if (csLoading in ComponentState) then exit;
r:=GetClientRect;
AdjustClientRect(r);
//writeln(' TWinControl.DoAdjustClientRectChange ',Name,':',ClassName,' ',r.Right,',',r.Bottom);
//DebugLn(' TWinControl.DoAdjustClientRectChange ',Name,':',ClassName,' ',r.Right,',',r.Bottom);
if (r.Left<>FAdjustClientRectRealized.Left)
or (r.Top<>FAdjustClientRectRealized.Top)
or (r.Right<>FAdjustClientRectRealized.Right)
@ -693,7 +693,7 @@ begin
then begin
// client rect changed since last AlignControl
{$IFDEF VerboseClientRectBugFix}
writeln('UUU TWinControl.DoAdjustClientRectChange ClientRect changed ',Name,':',ClassName,
DebugLn('UUU TWinControl.DoAdjustClientRectChange ClientRect changed ',Name,':',ClassName,
' Old=',FAdjustClientRectRealized.Right,'x',FAdjustClientRectRealized.Bottom,
' New=',r.RIght,'x',r.Bottom);
{$ENDIF}
@ -725,7 +725,7 @@ var
I: Integer;
begin
{$IFDEF VerboseClientRectBugFix}
writeln('[TWinControl.InvalidateClientRectCache] ',Name,':',ClassName);
DebugLn('[TWinControl.InvalidateClientRectCache] ',Name,':',ClassName);
{$ENDIF}
Include(FFlags,wcfClientRectNeedsUpdate);
@ -774,7 +774,7 @@ begin
GetClientRect;
end;
{$IFDEF VerboseClientRectBugFix}
write('[TWinControl.DoSetBounds] ',Name,':',ClassName,' OldClient=',FClientWidth,',',FClientHeight,
DbgOut('[TWinControl.DoSetBounds] ',Name,':',ClassName,' OldClient=',FClientWidth,',',FClientHeight,
' OldHeight=',FHeight,' NewHeight=',AHeight);
{$ENDIF}
inc(FClientWidth,AWidth-FWidth);
@ -782,7 +782,7 @@ begin
inc(FClientHeight,AHeight-FHeight);
if (FClientHeight<0) then FClientHeight:=0;
{$IFDEF VerboseClientRectBugFix}
writeln(' NewClient=',FClientWidth,',',FClientHeight);
DebugLn(' NewClient=',FClientWidth,',',FClientHeight);
{$ENDIF}
inherited DoSetBounds(ALeft,ATop,AWidth,AHeight);
@ -817,12 +817,12 @@ begin
dmFindTarget:
begin
{$IFDEF VerboseDrag}
Writeln('TWinControl.DoDragMsg dmFindTarget ',Name,':',ClassName,' Start DragMsg.DragRec^.Pos=',DragMsg.DragRec^.Pos.X,',',DragMsg.DragRec^.Pos.Y);
DebugLn('TWinControl.DoDragMsg dmFindTarget ',Name,':',ClassName,' Start DragMsg.DragRec^.Pos=',DragMsg.DragRec^.Pos.X,',',DragMsg.DragRec^.Pos.Y);
{$ENDIF}
TargetControl := ControlatPos(ScreentoClient(DragMsg.DragRec^.Pos),False);
if TargetControl = nil then TargetControl := Self;
{$IFDEF VerboseDrag}
Writeln('TWinControl.DoDragMsg dmFindTarget ',Name,':',ClassName,' End Result=',TargetControl.Name,':',TargetControl.ClassName);
DebugLn('TWinControl.DoDragMsg dmFindTarget ',Name,':',ClassName,' End Result=',TargetControl.Name,':',TargetControl.ClassName);
{$ENDIF}
DragMsg.Result:=longint(TargetControl);
end;
@ -873,7 +873,7 @@ var
Begin
Result.X := 0;
Result.Y := 0;
//writeln('[TWinControl.GetClientOrigin] ',Name,':',ClassName,' ',Handle);
//DebugLn('[TWinControl.GetClientOrigin] ',Name,':',ClassName,' ',Handle);
if HandleAllocated then begin
// get the interface idea where the client area is on the screen
LCLIntf.ClientToScreen(Handle,Result);
@ -908,7 +908,7 @@ function TWinControl.GetClientRect: TRect;
FClientWidth:=NewClientRect.Right;
FClientHeight:=NewClientRect.Bottom;
{$IFDEF VerboseSizeMsg}
writeln('StoreClientRect ',Name,':',ClassName,' ',FClientWidth,',',FClientHeight);
DebugLn('StoreClientRect ',Name,':',ClassName,' ',FClientWidth,',',FClientHeight);
{$ENDIF}
if ClientSizeChanged then begin
for i:=0 to ControlCount-1 do
@ -941,7 +941,7 @@ begin
or (r.Top<>Result.Top)
or (r.Right<>Result.Right)
or (r.Bottom<>Result.Bottom) then begin
//writeln(' TWinControl.GetClientRect ',Name,':',ClassName,
//DebugLn(' TWinControl.GetClientRect ',Name,':',ClassName,
// ' Old=',r.Left,',',r.Top,',',r.Right,',',r.Bottom,
// ' New=',Result.Left,',',Result.Top,',',Result.Right,',',Result.Bottom
// );
@ -1041,7 +1041,7 @@ begin
Height:= FHeight;
{$IFDEF CHECK_POSITION}
if AnsiCompareText(ClassName,'TScrollBar')=0 then
writeln(' [TControl.SendMoveSizeMessages] ',Name,':',ClassName,' SizeMsg Width=',Width,' Height=',Height);
DebugLn(' [TControl.SendMoveSizeMessages] ',Name,':',ClassName,' SizeMsg Width=',Width,' Height=',Height);
{$ENDIF}
end;
WindowProc(TLMessage(SizeMsg));
@ -1055,7 +1055,7 @@ begin
YPos:= FTop;
{$IFDEF CHECK_POSITION}
if AnsiCompareText(ClassName,'TScrollBar')=0 then
writeln(' [TControl.SendMoveSizeMessages] ',Name,':',ClassName,' MoveMsg XPos=',XPos,' YPos=',YPos);
DebugLn(' [TControl.SendMoveSizeMessages] ',Name,':',ClassName,' MoveMsg XPos=',XPos,' YPos=',YPos);
{$ENDIF}
end;
WindowProc(TLMessage(MoveMsg));
@ -1083,7 +1083,7 @@ begin
end;
if HandleAllocated then begin
//writeln('TWinControl.UpdateShowing A ',Name,':',ClassName,' FShowing=',FShowing,' bShow=',bShow);
//DebugLn('TWinControl.UpdateShowing A ',Name,':',ClassName,' FShowing=',FShowing,' bShow=',bShow);
if (not FShowingValid) or (FShowing <> bShow) then begin
FShowing := bShow;
FShowingValid := true;
@ -1229,7 +1229,7 @@ begin
If List.Count > 0 then begin
J := List.IndexOf(CurrentControl);
if J<0 then exit;
//writeln('TWinControl.FindNextControl A ',CurrentControl.Name,' ',J,' ',GoForward,',',CheckTabStop,',',CheckParent,',',OnlyWinControls);
//DebugLn('TWinControl.FindNextControl A ',CurrentControl.Name,' ',J,' ',GoForward,',',CheckTabStop,',',CheckParent,',',OnlyWinControls);
I := J;
Repeat
If GoForward then begin
@ -1244,14 +1244,14 @@ begin
if I=J then exit;
Next := TControl(List[I]);
//writeln('TWinControl.FindNextControl B ',Next.Name,' ',I);
//DebugLn('TWinControl.FindNextControl B ',Next.Name,' ',I);
If (((Not CheckTabStop) or Next.TabStop)
and ((not CheckParent) or (Next.Parent = Self)))
and (Next.Enabled and Next.Visible)
and ((not OnlyWinControls) or (Next is TWinControl)) then
Result := Next;
until (Result <> nil);
//writeln('TWinControl.FindNextControl END ',Result.Name,':',Result.ClassName,' ',I);
//DebugLn('TWinControl.FindNextControl END ',Result.Name,':',Result.ClassName,' ',I);
end;
finally
List.Free;
@ -1349,7 +1349,7 @@ begin
dec(P.X,ClientBounds.Left);
dec(P.Y,ClientBounds.Top);
{$IFDEF VerboseMouseBugfix}
writeln('TWinControl.IsControlMouseMsg ',Name,' -> ',Control.Name,
DebugLn('TWinControl.IsControlMouseMsg ',Name,' -> ',Control.Name,
' MsgPos=',TheMessage.Pos.X,',',TheMessage.Pos.Y,
' Control=',Control.Left,',',Control.Top,
' ClientBounds=',ClientBounds.Left,',',ClientBounds.Top,
@ -1407,12 +1407,12 @@ var
PS: TPaintStruct; //defined in LCLIntf.pp
ControlsNeedsClipping: boolean;
begin
//writeln('[TWinControl.PaintHandler] ',Name,':',ClassName,' DC=',HexStr(Message.DC,8));
//DebugLn('[TWinControl.PaintHandler] ',Name,':',ClassName,' DC=',HexStr(Message.DC,8));
if (csDestroying in ComponentState) or (not HandleAllocated) then exit;
{$IFDEF VerboseDsgnPaintMsg}
if csDesigning in ComponentState then
writeln('TWinControl.PaintHandler A ',Name,':',ClassName);
DebugLn('TWinControl.PaintHandler A ',Name,':',ClassName);
{$ENDIF}
Assert(False, Format('Trace:> [TWinControl.PaintHandler] %s --> Msg.DC: 0x%x', [ClassName, TheMessage.DC]));
@ -1437,7 +1437,7 @@ begin
for I := 0 to FControls.Count - 1 do
if ControlMustBeClipped(TControl(FControls[I])) then
with TControl(FControls[I]) do begin
//writeln('TWinControl.PaintHandler Exclude Child ',Self.Name,':',Self.ClassName,' Control=',Name,':',ClassName);
//DebugLn('TWinControl.PaintHandler Exclude Child ',Self.Name,':',Self.ClassName,' Control=',Name,':',ClassName);
Clip := ExcludeClipRect(DC, Left, Top, Left + Width, Top + Height);
if Clip = NullRegion then Break;
end;
@ -1451,7 +1451,7 @@ begin
if TheMessage.DC = 0 then EndPaint(Handle, PS);
end;
Assert(False, Format('Trace:< [TWinControl.PaintHandler] %s', [ClassName]));
//writeln('[TWinControl.PaintHandler] END ',Name,':',ClassName,' DC=',HexStr(Message.DC,8));
//DebugLn('[TWinControl.PaintHandler] END ',Name,':',ClassName,' DC=',HexStr(Message.DC,8));
end;
procedure TWinControl.PaintControls(DC: HDC; First: TControl);
@ -1460,14 +1460,14 @@ var
// FrameBrush: HBRUSH;
TempControl : TCOntrol;
begin
//writeln('[TWinControl.PaintControls] ',Name,':',ClassName,' DC=',HexStr(DC,8));
//DebugLn('[TWinControl.PaintControls] ',Name,':',ClassName,' DC=',HexStr(DC,8));
if (csDestroying in ComponentState)
or ((DC=0) and (not HandleAllocated)) then
exit;
{$IFDEF VerboseDsgnPaintMsg}
if csDesigning in ComponentState then
writeln('TWinControl.PaintControls A ',Name,':',ClassName);
DebugLn('TWinControl.PaintControls A ',Name,':',ClassName);
{$ENDIF}
// Controls that are not TWinControl, have no handle of their own, and so
@ -1484,7 +1484,7 @@ begin
while I < Count do
begin
TempControl := TControl(FControls.Items[I]);
//writeln('TWinControl.PaintControls B Self=',Self.Name,':',Self.ClassName,' Control=',TempControl.Name,':',TempControl.ClassName,' ',TempControl.Left,',',TempControl.Top,',',TempControl.Width,',',TempControl.Height);
//DebugLn('TWinControl.PaintControls B Self=',Self.Name,':',Self.ClassName,' Control=',TempControl.Name,':',TempControl.ClassName,' ',TempControl.Left,',',TempControl.Top,',',TempControl.Width,',',TempControl.Height);
with (TempControl) do
if (Visible
or ((csDesigning in ComponentState)
@ -1495,7 +1495,7 @@ begin
Include(FControlState, csPaintCopy);
SaveIndex := SaveDC(DC);
MoveWindowOrg(DC, Left, Top);
//writeln('TWinControl.PaintControls B Self=',Self.Name,':',Self.ClassName,' Control=',Name,':',ClassName,' ',Left,',',Top,',',Width,',',Height);
//DebugLn('TWinControl.PaintControls B Self=',Self.Name,':',Self.ClassName,' Control=',Name,':',ClassName,' ',Left,',',Top,',',Width,',',Height);
IntersectClipRect(DC, 0, 0, Width, Height);
Perform(LM_PAINT, WParam(DC), 0);
RestoreDC(DC, SaveIndex);
@ -1524,21 +1524,21 @@ begin
DeleteObject(FrameBrush);
}
end;
//writeln('[TWinControl.PaintControls] END ',Name,':',ClassName,' DC=',HexStr(DC,8));
//DebugLn('[TWinControl.PaintControls] END ',Name,':',ClassName,' DC=',HexStr(DC,8));
end;
procedure TWinControl.PaintWindow(DC: HDC);
var
Message: TLMessage;
begin
//writeln('[TWinControl.PaintWindow] ',Name,':',Classname,' DC=',HexStr(DC,8));
//DebugLn('[TWinControl.PaintWindow] ',Name,':',Classname,' DC=',HexStr(DC,8));
if (csDestroying in ComponentState)
or ((DC=0) and (not HandleAllocated)) then
exit;
{$IFDEF VerboseDsgnPaintMsg}
if csDesigning in ComponentState then
writeln('TWinControl.PaintWindow A ',Name,':',ClassName);
DebugLn('TWinControl.PaintWindow A ',Name,':',ClassName);
{$ENDIF}
Message.Msg := LM_PAINT;
@ -1656,7 +1656,7 @@ var
)
);
{$IFDEF VerboseMouseBugfix}
writeln('GetControlAtPos ',Name,':',ClassName,
DebugLn('GetControlAtPos ',Name,':',ClassName,
' Pos=',Pos.X,',',Pos.Y,
' P=',P.X,',',P.Y,
' ClientBounds=',ClientBounds.Left,',',ClientBounds.Top,',',ClientBounds.Right,',',ClientBounds.Bottom,
@ -1734,15 +1734,15 @@ var
AWinControl: TWinControl;
begin
if not HandleAllocated then begin
writeln('Warning: TWinControl.DestroyHandle ',Name,':',ClassName,' Handle not Allocated');
DebugLn('Warning: TWinControl.DestroyHandle ',Name,':',ClassName,' Handle not Allocated');
//RaiseGDBException('');
end;
// First destroy all children handles
if FWinControls <> nil then begin
for i:= 0 to FWinControls.Count - 1 do begin
//writeln(' i=',i);
//writeln(' ',TWinControl(FWinControls[i]).Name,':',TWinControl(FWinControls[i]).ClassName);
//DebugLn(' i=',i);
//DebugLn(' ',TWinControl(FWinControls[i]).Name,':',TWinControl(FWinControls[i]).ClassName);
AWinControl:=TWinControl(FWinControls[i]);
if AWinControl.HandleAllocated then
AWinControl.DestroyHandle;
@ -1768,7 +1768,7 @@ Begin
Assert(False, Format('Trace:[TWinControl.WndPRoc] %s --> LM_SETFOCUS', [ClassName]));
Form := GetParentForm(Self);
{$IFDEF VerboseFocus}
writeln('TWinControl.WndProc LM_SetFocus ',Name,':',ClassName);
DebugLn('TWinControl.WndProc LM_SetFocus ',Name,':',ClassName);
{$ENDIF}
if (Form <> nil) and not Form.SetFocusedControl(Self) then Exit;
Message.Result:=0;
@ -1779,7 +1779,7 @@ Begin
Assert(False, Format('Trace:[TWinControl.WndPRoc] %s --> _KILLFOCUS', [ClassName]));
if csFocusing in ControlState then begin
{$IFDEF VerboseFocus}
writeln('TWinControl.WndProc LM_KillFocus during focusing ',Name,':',ClassName);
DebugLn('TWinControl.WndProc LM_KillFocus during focusing ',Name,':',ClassName);
{$ENDIF}
Exit;
end;
@ -1804,12 +1804,12 @@ Begin
LM_RBUTTONQUADCLK:
begin
{$IFDEF VerboseMouseBugfix}
writeln('TWinControl.WndPRoc A ',Name,':',ClassName);
DebugLn('TWinControl.WndPRoc A ',Name,':',ClassName);
{$ENDIF}
if IsControlMouseMSG(TLMMouse(Message)) then
Exit;
{$IFDEF VerboseMouseBugfix}
writeln('TWinControl.WndPRoc B ',Name,':',ClassName);
DebugLn('TWinControl.WndPRoc B ',Name,':',ClassName);
{$ENDIF}
end;
@ -1889,7 +1889,7 @@ var
Form : TCustomForm;
begin
{$IFDEF VerboseFocus}
writeln('[TWinControl.SetFocus] ',Name,':',ClassName,' Visible=',Visible,' HandleAllocated=',HandleAllocated);
DebugLn('[TWinControl.SetFocus] ',Name,':',ClassName,' Visible=',Visible,' HandleAllocated=',HandleAllocated);
{$ENDIF}
Form := GetParentForm(Self);
if Form <> nil then
@ -2124,7 +2124,7 @@ Begin
if (not HandleAllocated) or (csDestroying in ComponentState) then exit;
{$IFDEF VerboseDsgnPaintMsg}
if csDesigning in ComponentState then
writeln('TWinControl.Repaint A ',Name,':',ClassName);
DebugLn('TWinControl.Repaint A ',Name,':',ClassName);
{$ENDIF}
CNSendMessage(LM_PAINT, Self, nil);
// Invalidate;
@ -2220,7 +2220,7 @@ begin
Include(FFlags,wcfReAlignNeeded);
exit;
end;
//writeln('TWinControl.ReAlign ',Name,':',ClassName);
//DebugLn('TWinControl.ReAlign ',Name,':',ClassName);
AlignControl(nil);
Exclude(FFlags,wcfReAlignNeeded);
end;
@ -2300,7 +2300,7 @@ begin
UpdateControlState;
end else
if HandleAllocated then AControl.Invalidate;
//writeln('TWinControl.InsertControl ',Name,':',ClassName);
//DebugLn('TWinControl.InsertControl ',Name,':',ClassName);
end;
AControl.RequestAlign;
Perform(CM_CONTROLCHANGE, WParam(AControl), LParam(True));
@ -2336,8 +2336,8 @@ var
ChildControl: TControl;
begin
//if csDesigning in ComponentState then begin
// write('TWinControl.AlignControl ',Name,':',ClassName);
// if AControl<>nil then writeln(' AControl=',AControl.Name,':',AControl.ClassName) else writeln(' AControl=nil');;
// DbgOut('TWinControl.AlignControl ',Name,':',ClassName);
// if AControl<>nil then DebugLn(' AControl=',AControl.Name,':',AControl.ClassName) else DebugLn(' AControl=nil');;
//end;
if csDestroying in ComponentState then exit;
@ -2509,23 +2509,23 @@ var
n: Integer;
Control: TControl;
begin
//writeln('[TWinControl.Destroy] A ',Name,':',ClassName);
//DebugLn('[TWinControl.Destroy] A ',Name,':',ClassName);
// prevent parent to try to focus a to be destroyed control
if Parent <> nil then
RemoveFocus(true);
if HandleAllocated then
DestroyHandle;
//writeln('[TWinControl.Destroy] B ',Name,':',ClassName);
//DebugLn('[TWinControl.Destroy] B ',Name,':',ClassName);
//for n:=0 to ComponentCount-1 do
// writeln(' n=',n,' ',Components[n].ClassName);
// DebugLn(' n=',n,' ',Components[n].ClassName);
n := ControlCount;
while n > 0 do
begin
Control := Controls[n - 1];
//writeln('[TWinControl.Destroy] C ',Name,':',ClassName,' ',Control.Name,':',Control.ClassName);
//DebugLn('[TWinControl.Destroy] C ',Name,':',ClassName,' ',Control.Name,':',Control.ClassName);
Remove(Control);
// don't free the control just set parent to nil
// controls are freed by the owner
@ -2536,9 +2536,9 @@ begin
FreeThenNil(FBrush);
FreeThenNil(FChildSizing);
//writeln('[TWinControl.Destroy] D ',Name,':',ClassName);
//DebugLn('[TWinControl.Destroy] D ',Name,':',ClassName);
inherited Destroy;
//writeln('[TWinControl.Destroy] END ',Name,':',ClassName);
//DebugLn('[TWinControl.Destroy] END ',Name,':',ClassName);
end;
{------------------------------------------------------------------------------
@ -2623,7 +2623,7 @@ end;
------------------------------------------------------------------------------}
Procedure TWinControl.WMSetFocus(var Message: TLMSetFocus);
Begin
//writeln('TWinControl.WMSetFocus A ',Name,':',ClassName);
//DebugLn('TWinControl.WMSetFocus A ',Name,':',ClassName);
Assert(False, Format('Trace: %s', [ClassName]));
DoEnter;
end;
@ -2637,7 +2637,7 @@ end;
------------------------------------------------------------------------------}
procedure TWinControl.WMKillFocus(var Message: TLMKillFocus);
begin
//writeln('TWinControl.WMKillFocus A ',Name,':',ClassName);
//DebugLn('TWinControl.WMKillFocus A ',Name,':',ClassName);
Assert(False, Format('Trace: %s', [ClassName]));
DoExit;
end;
@ -2660,13 +2660,13 @@ var
PS : TPaintStruct;
ClientBoundRect: TRect;
begin
//writeln('[TWinControl.WMPaint] ',Name,':',ClassName,' ',HexStr(Msg.DC,8));
//DebugLn('[TWinControl.WMPaint] ',Name,':',ClassName,' ',HexStr(Msg.DC,8));
if ([csDestroying,csLoading]*ComponentState<>[]) or (not HandleAllocated) then
exit;
{$IFDEF VerboseDsgnPaintMsg}
if csDesigning in ComponentState then
writeln('TWinControl.WMPaint A ',Name,':',ClassName);
DebugLn('TWinControl.WMPaint A ',Name,':',ClassName);
{$ENDIF}
Assert(False, Format('Trace:> [TWinControl.WMPaint] %s Msg.DC: 0x%x', [ClassName, Msg.DC]));
@ -2681,7 +2681,7 @@ begin
end
else begin
// NOTE: not every interface uses this part
//writeln('TWinControl.WMPaint Painting doublebuffered ',Name,':',classname);
//DebugLn('TWinControl.WMPaint Painting doublebuffered ',Name,':',classname);
{$ifdef BUFFERED_WMPAINT}
DC := GetDC(0);
MemWidth:=Width;
@ -2728,7 +2728,7 @@ begin
end;
end;
Assert(False, Format('Trace:< [TWinControl.WMPaint] %s', [ClassName]));
//writeln('[TWinControl.WMPaint] END ',Name,':',ClassName);
//DebugLn('[TWinControl.WMPaint] END ',Name,':',ClassName);
end;
{------------------------------------------------------------------------------
@ -2741,7 +2741,7 @@ end;
procedure TWinControl.WMDestroy(var Message: TLMDestroy);
begin
Assert(False, Format('Trace: [TWinControl.LMDestroy] %s', [ClassName]));
//writeln('TWinControl.WMDestroy ',Name,':',ClassName);
//DebugLn('TWinControl.WMDestroy ',Name,':',ClassName);
// Our widget/window doesn't exist anymore
Handle := 0;
end;
@ -2758,7 +2758,7 @@ var
NewWidth, NewHeight: integer;
begin
{$IFDEF VerboseSizeMsg}
writeln('TWinControl.WMMove A ',Name,':',ClassName,' Message=',Message.XPos,',',Message.YPos,
DebugLn('TWinControl.WMMove A ',Name,':',ClassName,' Message=',Message.XPos,',',Message.YPos,
' BoundsRealized=',FBoundsRealized.Left,',',FBoundsRealized.Top,',',FBoundsRealized.Right-FBoundsRealized.Left,',',FBoundsRealized.Bottom-FBoundsRealized.Top);
{$ENDIF}
NewWidth:=Width;
@ -2790,7 +2790,7 @@ var
NewLeft, NewTop: integer;
begin
{$IFDEF VerboseSizeMsg}
writeln('TWinControl.WMSize A ',Name,':',ClassName,' Message=',Message.Width,',',Message.Height,
DebugLn('TWinControl.WMSize A ',Name,':',ClassName,' Message=',Message.Width,',',Message.Height,
' BoundsRealized=',FBoundsRealized.Left,',',FBoundsRealized.Top,',',FBoundsRealized.Right-FBoundsRealized.Left,',',FBoundsRealized.Bottom-FBoundsRealized.Top);
{$ENDIF}
NewLeft:=Left;
@ -2802,7 +2802,7 @@ begin
NewTop:=FBoundsRealized.Top;
if HandleAllocated then
GetWindowRelativePosition(Handle,NewLeft,NewTop);
//writeln('TWinControl.WMSize B ',Name,':',ClassName,' ',NewLeft,',',NewTop);
//DebugLn('TWinControl.WMSize B ',Name,':',ClassName,' ',NewLeft,',',NewTop);
FBoundsRealized:=Bounds(NewLeft,NewTop,Message.Width,Message.Height);
end;
@ -2818,7 +2818,7 @@ end;
------------------------------------------------------------------------------}
procedure TWinControl.CNKeyDown(var Message: TLMKeyDown);
begin
//writeln('TWinControl.CNKeyDown ',Name,':',ClassName);
//DebugLn('TWinControl.CNKeyDown ',Name,':',ClassName);
if not DoKeyDown(Message) then {inherited}; // there is nothing to inherit
end;
@ -2943,7 +2943,7 @@ end;
------------------------------------------------------------------------------}
Procedure TWinControl.WMKeyDown(Var Message : TLMKeyDown);
begin
//writeln('TWinControl.WMKeyDown ',Name,':',ClassName);
//DebugLn('TWinControl.WMKeyDown ',Name,':',ClassName);
// ToDo: If not WantAllKeys then
//KeyDown(CharCode, ShiftState);
end;
@ -3002,14 +3002,14 @@ var
begin
LCLIntf.GetClientRect(Handle,r);
if csDesigning in ComponentState then
writeln('WriteClientRect ',Prefix,' ',Name,':',ClassName,' r=',r.Right,',',r.Bottom);
DebugLn('WriteClientRect ',Prefix,' ',Name,':',ClassName,' r=',r.Right,',',r.Bottom);
end;}
begin
//writeln('[TWinControl.CreateWnd] START ',Name,':',Classname);
//DebugLn('[TWinControl.CreateWnd] START ',Name,':',Classname);
if (FCompstyle = csNone) then
begin
WriteLn(Format('WARNING: [TWinControl.CreateWnd] %s --> FCompstyle = csNone', [ClassName]));
DebugLn(Format('WARNING: [TWinControl.CreateWnd] %s --> FCompstyle = csNone', [ClassName]));
Exit;
end;
@ -3024,7 +3024,7 @@ begin
if FCreatingHandle
then begin
WriteLN('[WARNING] Recursive call to CreateWnd for ', ClassName, ' (', Name, ')');
DebugLn('[WARNING] Recursive call to CreateWnd for ', ClassName, ' (', Name, ')');
Exit;
end;
@ -3045,7 +3045,7 @@ begin
//WriteClientRect('B');
InitializeWnd;
//writeln('[TWinControl.CreateWnd] ',Name,':',ClassName,' ',Left,',',Top,',',Width,',',Height);
//DebugLn('[TWinControl.CreateWnd] ',Name,':',ClassName,' ',Left,',',Top,',',Width,',',Height);
//WriteClientRect('C');
// realign childs
@ -3057,7 +3057,7 @@ begin
if Visible then HandleNeeded;
end;
//writeln('[TWinControl.CreateWnd] END ',Name,':',Classname);
//DebugLn('[TWinControl.CreateWnd] END ',Name,':',Classname);
//WriteClientRect('D');
end;
@ -3106,7 +3106,7 @@ begin
Assert(False, Format('Trace:[TWinControl.InitializeWnd] %s', [ClassName]));
// set all cached properties
//writeln('[TWinControl.InitializeWnd] ',Name,':',ClassName,':', FCaption,' ',Left,',',Top,',',Width,',',Height);
//DebugLn('[TWinControl.InitializeWnd] ',Name,':',ClassName,':', FCaption,' ',Left,',',Top,',',Width,',',Height);
DoSendBoundsToInterface;
CNSendMessage(LM_SHOWHIDE, Self, nil);
@ -3330,7 +3330,7 @@ begin
{$IFDEF CHECK_POSITION}
//if csDesigning in ComponentState then
if AnsiCompareText(ClassName,'TScrollBar')=0 then
writeln('[TWinControl.SetBounds] START ',Name,':',ClassName,
DebugLn('[TWinControl.SetBounds] START ',Name,':',ClassName,
' Old=',Left,',',Top,',',Width,',',Height,
' -> New=',ALeft,',',ATop,',',AWidth,',',AHeight,
' Lock=',BoundsLockCount,
@ -3349,7 +3349,7 @@ begin
{$IFDEF CHECK_POSITION}
//if csDesigning in ComponentState then
if AnsiCompareText(ClassName,'TScrollBar')=0 then
writeln('[TWinControl.SetBounds] Set LCL Bounds ',Name,':',ClassName,
DebugLn('[TWinControl.SetBounds] Set LCL Bounds ',Name,':',ClassName,
' OldBounds=',Left,',',Top,',',Left+Width,',',Top+Height,
' -> New=',ALeft,',',ATop,',',ALeft+AWidth,',',ATop+AHeight);
{$ENDIF}
@ -3416,7 +3416,7 @@ end;
function TWinControl.GetDeviceContext(var WindowHandle: HWnd): HDC;
begin
Result := GetDC(Handle);
//writeln('[TWinControl.GetDeviceContext] ',ClassName,' DC=',HexStr(Cardinal(Result),8),' Handle=',HexStr(Cardinal(FHandle),8));
//DebugLn('[TWinControl.GetDeviceContext] ',ClassName,' DC=',HexStr(Cardinal(Result),8),' Handle=',HexStr(Cardinal(FHandle),8));
if Result = 0
then raise EOutOfResources.CreateFmt(rsErrorCreatingDeviceContext, [Name,
ClassName]);
@ -3452,7 +3452,7 @@ var
NewBounds: TRect;
begin
NewBounds:=Bounds(Left, Top, Width, Height);
//writeln('TWinControl.DoSendBoundsToInterface A ',Name,':',ClassName,' Old=',FBoundsRealized.Left,',',FBoundsRealized.Top,',',FBoundsRealized.Right,',',FBoundsRealized.Bottom,
//DebugLn('TWinControl.DoSendBoundsToInterface A ',Name,':',ClassName,' Old=',FBoundsRealized.Left,',',FBoundsRealized.Top,',',FBoundsRealized.Right,',',FBoundsRealized.Bottom,
//' New=',NewBounds.Left,',',NewBounds.Top,',',NewBounds.Right,',',NewBounds.Bottom);
FBoundsRealized:=NewBounds;
CNSendMessage(LM_SetSize, Self, @NewBounds);
@ -3471,9 +3471,9 @@ begin
{$IFDEF CHECK_POSITION}
//if csDesigning in ComponentState then
if AnsiCompareText(ClassName,'TScrollBar')=0 then
writeln('[TWinControl.RealizeBounds] A ',Name,':',ClassName,
' OldRelBounds=',FBoundsRealized.Left,',',FBoundsRealized.Top,',',FBoundsRealized.Right,',',FBoundsRealized.Bottom,
' -> NewBounds=',NewBounds.Left,',',NewBounds.Top,',',NewBounds.Right,',',NewBounds.Bottom);
DebugLn('[TWinControl.RealizeBounds] A ',Name,':',ClassName,
' OldRelBounds=',dbgs(FBoundsRealized),
' -> NewBounds=',dbgs(NewBounds));
{$ENDIF}
BeginUpdateBounds;
try
@ -3519,6 +3519,9 @@ end;
{ =============================================================================
$Log$
Revision 1.227 2004/05/11 11:42:27 mattias
replaced writeln by debugln
Revision 1.226 2004/05/11 10:53:59 mattias
replaced writeln by debugln

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

@ -180,7 +180,7 @@ end;
exit;
{$ENDIF}
if not (AWinControl is TButton) then exit;
writeln('ModifyWidgetStyle A ',AWinControl.Name,':',AWinControl.ClassName,' AWidget=',HexStr(Cardinal(AWidget),8));
DebugLn('ModifyWidgetStyle A ',AWinControl.Name,':',AWinControl.ClassName,' AWidget=',HexStr(Cardinal(AWidget),8));
RCStyle:=gtk_rc_style_new;
g_free(RCStyle^.font_name);
RCStyle^.font_name:=g_strdup('-urw-chancery l-medium-i-normal-*-*-140-*-*-p-*-iso8859-2');
@ -228,7 +228,7 @@ begin
// define extra events we're interrested in
//write('GTKRealizeAfterCB ');
//if TheWinControl<>nil then write(' ',TheWinControl.Name,':',TheWinControl.ClassName,' ',HexStr(Cardinal(TheWinControl.Handle),8));
//writeln(' Widget=',HexStr(Cardinal(Widget),8),' Fixed=',HexStr(Cardinal(GetFixedWidget(Widget)),8),' Main=',HexStr(Cardinal(GetMainWidget(Widget)),8));
//DebugLn(' Widget=',HexStr(Cardinal(Widget),8),' Fixed=',HexStr(Cardinal(GetFixedWidget(Widget)),8),' Main=',HexStr(Cardinal(GetMainWidget(Widget)),8));
if (TheWinControl<>nil) then begin
{$IFDEF DebugGDK}BeginGDKErrorTrap;{$ENDIF}
NewEventMask:=gdk_window_get_events(GetControlWindow(Widget))
@ -240,7 +240,7 @@ begin
or WinWidgetInfo^.EventMask;
gdk_window_set_events(GetControlWindow(ClientWidget),NewEventMask);
end;
//writeln('BBB1 ',HexStr(Cardinal(NewEventMask),8),' ',HexStr(Cardinal(gdk_window_get_events(Widget^.Window)),8));
//DebugLn('BBB1 ',HexStr(Cardinal(NewEventMask),8),' ',HexStr(Cardinal(gdk_window_get_events(Widget^.Window)),8));
{$IFDEF DebugGDK}EndGDKErrorTrap;{$ENDIF}
end;
@ -301,7 +301,7 @@ begin
Mess.Msg := LM_ACTIVATE;
Mess.Result := 0;
DeliverMessage(Data, Mess);
//writeln('gtkactivateCB ',Result);
//DebugLn('gtkactivateCB ',Result);
Result := CallBackDefaultReturn;
end;
@ -399,7 +399,7 @@ begin
if DesignOnlySignal then exit;
end else begin
{$IFDEF VerboseDesignerDraw}
writeln('gtkDrawAfter',
DebugLn('gtkDrawAfter',
' Widget=',HexStr(Cardinal(Widget),8),'=',GetWidgetClassName(Widget),
' ',TComponent(Data).Name,
' ',area^.x,',',area^.y,',',area^.width,',',area^.height,
@ -425,7 +425,7 @@ begin
if DesignOnlySignal then exit;
end else begin
{$IFDEF VerboseDesignerDraw}
writeln('gtkExposeAfter',
DebugLn('gtkExposeAfter',
' Widget=',HexStr(Cardinal(Widget),8),'=',GetWidgetClassName(Widget),
' ',TComponent(Data).Name,
' ',Event^.area.x,',',Event^.area.y,',',Event^.area.width,',',Event^.area.height,
@ -461,7 +461,7 @@ begin
end;
end else
write(' LCLObject=nil');
writeln(''); write(' ');
DebugLn(''); write(' ');
CurFocusWidget:=PGtkWidget(GetFocus);
if CurFocusWidget<>nil then begin
write(' GetFocus=',HexStr(Cardinal(CurFocusWidget),8));
@ -477,7 +477,7 @@ begin
end else begin
write(' GetFocus=nil');
end;
writeln('');
DebugLn('');
{$ENDIF}
UpdateMouseCaptureControl;
@ -507,9 +507,9 @@ begin
' GetFocus=',HexStr(Cardinal(Widget),8));
LCLObject:=TControl(GetLCLObject(Widget));
if LCLObject<>nil then
writeln(' LCLObject=',LCLObject.Name,':',LCLObject.ClassName)
DebugLn(' LCLObject=',LCLObject.Name,':',LCLObject.ClassName)
else
writeln(' LCLObject=nil');
DebugLn(' LCLObject=nil');
{$ENDIF}
UpdateMouseCaptureControl;
@ -541,7 +541,7 @@ var
procedure StopKeyEvent(const AnEventName: PChar);
begin
{$IFDEF VerboseKeyboard}
writeln('StopKeyEvent AnEventName="',AnEventName,'"');
DebugLn('StopKeyEvent AnEventName="',AnEventName,'"');
{$ENDIF}
if not EventStopped
then begin
@ -608,7 +608,7 @@ begin
HandledByLCL:=KeyEventWasHandledByLCL(Event,BeforeEvent);
{$IFDEF VerboseKeyboard}
writeln('[HandleGTKKeyUpDown] ',TControl(Data).Name,':',TControl(Data).ClassName,
DebugLn('[HandleGTKKeyUpDown] ',TControl(Data).Name,':',TControl(Data).ClassName,
' ',Event^.theType,' Widget=',GetWidgetClassName(Widget),
' Before=',BeforeEvent,' HandledByLCL=',HandledByLCL);
{$ENDIF}
@ -632,7 +632,7 @@ begin
FocusedWinControl:=TWinControl(LCLObject);
if FocusedWidget<>Widget then begin
{$IFDEF VerboseKeyboard}
writeln('[HandleGTKKeyUpDown] REDIRECTING ',
DebugLn('[HandleGTKKeyUpDown] REDIRECTING ',
' FocusedWidget=',GetWidgetClassName(FocusedWidget),
' Control=',FocusedWinControl.Name,':',FocusedWinControl.ClassName);
{$ENDIF}
@ -678,7 +678,7 @@ begin
GDK_KEY_RELEASE:
begin
{$IFDEF VerboseKeyboard}
writeln('[HandleGTKKeyUpDown] GDK_KEY_RELEASE VKey=',VKey.VKey);
DebugLn('[HandleGTKKeyUpDown] GDK_KEY_RELEASE VKey=',VKey.VKey);
{$ENDIF}
Msg.CharCode := VKey.VKey;
@ -711,7 +711,7 @@ begin
GDK_KEY_PRESS:
begin
{$IFDEF VerboseKeyboard}
writeln('[HandleGTKKeyUpDown] GDK_KEY_PRESS VKey=',VKey.VKey);
DebugLn('[HandleGTKKeyUpDown] GDK_KEY_PRESS VKey=',VKey.VKey);
{$ENDIF}
Msg.CharCode := VKey.VKey;
@ -791,7 +791,7 @@ begin
end;}
end;
end;
//writeln('[HandleGTKKeyUpDown] ',TControl(Data).Name,':',TControl(Data).ClassName,' Result=',Result);
//DebugLn('[HandleGTKKeyUpDown] ',TControl(Data).Name,':',TControl(Data).ClassName,' Result=',Result);
end;
function GTKKeyUpDown(Widget: PGtkWidget; Event: PGdkEventKey;
@ -827,7 +827,7 @@ begin
end;
end else
write(' LCLObject=nil');
writeln(''); write(' ');
DebugLn(''); write(' ');
CurFocusWidget:=PGtkWidget(GetFocus);
if CurFocusWidget<>nil then begin
write(' GetFocus=',HexStr(Cardinal(CurFocusWidget),8));
@ -843,7 +843,7 @@ begin
end else begin
write(' GetFocus=nil');
end;
writeln('');
DebugLn('');
{$ENDIF}
Result:=true;
@ -871,7 +871,7 @@ begin
end;
end else
write(' LCLObject=nil');
writeln(''); write(' ');
DebugLn(''); write(' ');
CurFocusWidget:=PGtkWidget(GetFocus);
if CurFocusWidget<>nil then begin
write(' GetFocus=',HexStr(Cardinal(CurFocusWidget),8));
@ -887,7 +887,7 @@ begin
end else begin
write(' GetFocus=nil');
end;
writeln('');
DebugLn('');
{$ENDIF}
UpdateMouseCaptureControl;
@ -921,7 +921,7 @@ begin
end;
end else
write(' LCLObject=nil');
writeln(''); write(' ');
DebugLn(''); write(' ');
CurFocusWidget:=PGtkWidget(GetFocus);
if CurFocusWidget<>nil then begin
write(' GetFocus=',HexStr(Cardinal(CurFocusWidget),8));
@ -937,7 +937,7 @@ begin
end else begin
write(' GetFocus=nil');
end;
writeln('');
DebugLn('');
{$ENDIF}
Result:=true;
@ -965,7 +965,7 @@ begin
end;
end else
write(' LCLObject=nil');
writeln(''); write(' ');
DebugLn(''); write(' ');
CurFocusWidget:=PGtkWidget(GetFocus);
if CurFocusWidget<>nil then begin
write(' GetFocus=',HexStr(Cardinal(CurFocusWidget),8));
@ -981,7 +981,7 @@ begin
end else begin
write(' GetFocus=nil');
end;
writeln('');
DebugLn('');
{$ENDIF}
UpdateMouseCaptureControl;
@ -1154,7 +1154,7 @@ begin
{$IFDEF VerboseMouseBugfix}
DesignOnlySignal:=GetDesignOnlySignalFlag(Widget,dstMouseMotion);
writeln('[GTKMotionNotify] ',
DebugLn('[GTKMotionNotify] ',
TControl(Data).Name,':',TControl(Data).ClassName,
' Widget=',HexStr(Cardinal(Widget),8),
' DSO=',DesignOnlySignal,
@ -1189,7 +1189,7 @@ begin
Result := CallBackDefaultReturn;
{$IFDEF VerboseMouseBugfix}
writeln('[GTKMotionNotifyAfter] ',
DebugLn('[GTKMotionNotifyAfter] ',
TControl(Data).Name,':',TControl(Data).ClassName);
{$ENDIF}
@ -1275,7 +1275,7 @@ var
(not (gdk_event_get_type(Event) in [gdk_2button_press,gdk_3button_press]))
then begin
{$IFDEF VerboseMouseBugfix}
writeln(' NO CLICK: LastMouse.Down=',LastMouse.Down,
DebugLn(' NO CLICK: LastMouse.Down=',LastMouse.Down,
' Event^.theType=',gdk_event_get_type(Event));
{$ENDIF}
Exit;
@ -1320,7 +1320,7 @@ var
then begin
// multi click
{$IFDEF VerboseMouseBugfix}
writeln(' MULTI CLICK: ',now,'-',LastMouse.TheTime,'<= ',
DebugLn(' MULTI CLICK: ',now,'-',LastMouse.TheTime,'<= ',
((1/86400)*(DblClickTime/1000)));
{$ENDIF}
end else begin
@ -1330,7 +1330,7 @@ var
end;
end;
{$IFDEF VerboseMouseBugfix}
writeln(' ClickCount=',LastMouse.ClickCount);
DebugLn(' ClickCount=',LastMouse.ClickCount);
{$ENDIF}
LastMouse.TheTime := Now;
@ -1357,7 +1357,7 @@ begin
ShiftState := GTKEventState2ShiftState(Event^.State);
MappedXY:=TranslateGdkPointToClientArea(Event^.Window,EventXY,
PGtkWidget(AWinControl.Handle));
//writeln('DeliverMouseDownMessage ',AWinControl.Name,':',AWinControl.ClassName,' Mapped=',MappedXY.X,',',MappedXY.Y,' Event=',EventXY.X,',',EventXY.Y);
//DebugLn('DeliverMouseDownMessage ',AWinControl.Name,':',AWinControl.ClassName,' Mapped=',MappedXY.X,',',MappedXY.Y,' Event=',EventXY.X,',',EventXY.Y);
if event^.Button in [4,5] then begin
// this is a mouse wheel event
@ -1432,9 +1432,9 @@ begin
Result := CallBackDefaultReturn;
{$IFDEF VerboseMouseBugfix}
writeln('');
DebugLn('');
DesignOnlySignal:=GetDesignOnlySignalFlag(Widget,dstMousePress);
writeln('[gtkMouseBtnPress] ',
DebugLn('[gtkMouseBtnPress] ',
TComponent(Data).Name,':',TObject(Data).ClassName,
' Widget=',HexStr(Cardinal(Widget),8),
' ControlWidget=',HexStr(Cardinal(TWinControl(Data).Handle),8),
@ -1442,14 +1442,14 @@ begin
' ',TruncToInt(Event^.X),',',TruncToInt(Event^.Y),
' Type=',Event^.theType);
{$ENDIF}
//writeln('DDD1 MousePress Widget=',HexStr(Cardinal(Widget),8),
//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)
//);
//if GetFixedWidget(Widget)<>nil then
// writeln('DDD2 ClientWindow=',HexStr(Cardinal(PGtkWidget(GetFixedWidget(Widget))^.Window),8));
// DebugLn('DDD2 ClientWindow=',HexStr(Cardinal(PGtkWidget(GetFixedWidget(Widget))^.Window),8));
EventTrace('Mouse button Press', data);
Assert(False, Format('Trace:[gtkMouseBtnPress] ', []));
@ -1490,7 +1490,7 @@ begin
Result := CallBackDefaultReturn;
{$IFDEF VerboseMouseBugfix}
{writeln('[gtkMouseBtnPressAfter] ',
{DebugLn('[gtkMouseBtnPressAfter] ',
TControl(Data).Name,':',TObject(Data).ClassName,
' Widget=',HexStr(Cardinal(Widget),8),
' ',TruncToInt(Event^.X),',',TruncToInt(Event^.Y));}
@ -1607,14 +1607,14 @@ begin
{$IFDEF VerboseMouseBugfix}
DesignOnlySignal:=GetDesignOnlySignalFlag(Widget,dstMouseRelease);
writeln('[gtkMouseBtnRelease] A ',
DebugLn('[gtkMouseBtnRelease] A ',
TComponent(Data).Name,':',TObject(Data).ClassName,' ',
' Widget=',HexStr(Cardinal(Widget),8),
' DSO=',DesignOnlySignal,
' ',TruncToInt(Event^.X),',',TruncToInt(Event^.Y),' Btn=',event^.Button);
{$ENDIF}
//writeln('EEE1 MouseRelease Widget=',HexStr(Cardinal(Widget),8),
//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));
@ -1651,7 +1651,7 @@ begin
Result := CallBackDefaultReturn;
{$IFDEF VerboseMouseBugfix}
{writeln('[gtkMouseBtnReleaseAfter] ',
{DebugLn('[gtkMouseBtnReleaseAfter] ',
TControl(Data).Name,':',TObject(Data).ClassName,' ',
TruncToInt(Event^.X),',',TruncToInt(Event^.Y));}
{$ENDIF}
@ -1672,7 +1672,7 @@ var
Mess : TLMessage;
begin
Result := CallBackDefaultReturn;
//writeln('[gtkclickedCB] ',TObject(Data).ClassName);
//DebugLn('[gtkclickedCB] ',TObject(Data).ClassName);
EventTrace('clicked', data);
if (LockOnChange(PgtkObject(Widget),0)>0) then exit;
Mess.Msg := LM_CLICKED;
@ -1816,7 +1816,7 @@ begin
gtk_color_selection_get_current_color(colorsel, @newColor);
TColorDialog(theDialog).Color := TGDKColorToTColor(newcolor);
{$IFDEF VerboseColorDialog}
writeln('gtkDialogOKclickedCB ',HexStr(Cardinal(TColorDialog(theDialog).Color),8));
DebugLn('gtkDialogOKclickedCB ',HexStr(Cardinal(TColorDialog(theDialog).Color),8));
{$ENDIF}
end
else if theDialog is TFontDialog then
@ -2180,7 +2180,7 @@ begin
end;
Mess.msg := CM_MOUSEENTER;
writeln('gtkEnterCB');
DebugLn('gtkEnterCB');
Status := DeliverMessage(Data, Mess) = 0;
{$ifdef GTK2}
@ -2205,7 +2205,7 @@ begin
end;
Mess.msg := CM_MOUSELEAVE;
writeln('gtkLeaveCB');
DebugLn('gtkLeaveCB');
Status := DeliverMessage(Data, Mess) = 0;
{$ifdef GTK2}
@ -2238,10 +2238,10 @@ begin
if not (TObject(Data) is TControl) then begin
// owner is not TControl -> ignore
writeln('WARNING: gtksize_allocateCB: Data is not TControl. Data=',
DebugLn('WARNING: gtksize_allocateCB: Data is not TControl. Data=',
HexStr(Cardinal(Data),8),' ',GetWidgetClassName(Widget));
if Data<>nil then
writeln(' Data=',TObject(Data).ClassName);
DebugLn(' Data=',TObject(Data).ClassName);
RaiseException('');
exit;
end;
@ -2254,7 +2254,7 @@ begin
Therefore all resize messages between lcl and gtk are cached.
}
{$IFDEF VerboseSizeMsg}
writeln('gtksize_allocateCB: ',
DebugLn('gtksize_allocateCB: ',
TControl(Data).Name,':',TControl(Data).ClassName,
' widget=',HexStr(Cardinal(Widget),8),
' fixwidget=',HexStr(Cardinal(GetFixedWidget(Widget)),8),
@ -2262,7 +2262,7 @@ begin
{$ENDIF}
{$IFDEF VerboseFormPositioning}
if TControl(Data) is TCustomForm then
writeln('VFP gtksize_allocateCB: ',TControl(Data).ClassName,' ',Size^.X,',',Size^.Y);
DebugLn('VFP gtksize_allocateCB: ',TControl(Data).ClassName,' ',Size^.X,',',Size^.Y);
{$ENDIF}
SaveSizeNotification(Widget);
end;
@ -2278,7 +2278,7 @@ begin
if (Widget=nil) or (Size=nil) then ;
if (TObject(Data) is TWinControl) then begin
{$IFDEF VerboseSizeMsg}
writeln('gtksize_allocate_client: ',
DebugLn('gtksize_allocate_client: ',
TControl(Data).Name,':',TControl(Data).ClassName,
' widget=',HexStr(Cardinal(Widget),8),
' NewSize=',Size^.Width,',',Size^.Height,
@ -2294,7 +2294,7 @@ begin
SaveClientSizeNotification(ClientWidget);
end else begin
// owner is not TWinControl -> ignore
writeln('WARNING: gtksize_allocate_client: Data is not TWinControl. Data=',
DebugLn('WARNING: gtksize_allocate_client: Data is not TWinControl. Data=',
HexStr(Cardinal(Data),8));
exit;
end;
@ -2538,13 +2538,13 @@ begin
if (FTimerData=nil) or (FTimerData.IndexOf(Data)<0) then begin
{$IFDEF VerboseTimer}
writeln('gtkTimerCB Timer was killed: TimerInfo=',HexStr(Cardinal(TimerInfo),8));
DebugLn('gtkTimerCB Timer was killed: TimerInfo=',HexStr(Cardinal(TimerInfo),8));
{$ENDIF}
// timer was killed
Result:=GdkFalse; // stop timer
end else begin
{$IFDEF VerboseTimer}
writeln('gtkTimerCB Timer Event: TimerInfo=',HexStr(Cardinal(TimerInfo),8));
DebugLn('gtkTimerCB Timer Event: TimerInfo=',HexStr(Cardinal(TimerInfo),8));
{$ENDIF}
if TimerInfo^.TimerFunc <> nil
then begin
@ -2565,7 +2565,7 @@ begin
if Result=GdkFalse then begin
{$IFDEF VerboseTimer}
writeln('gtkTimerCB Timer was STOPPED: TimerInfo=',HexStr(Cardinal(TimerInfo),8));
DebugLn('gtkTimerCB Timer was STOPPED: TimerInfo=',HexStr(Cardinal(TimerInfo),8));
{$ENDIF}
// timer will be stopped
// -> free timer data, if not already done
@ -2582,7 +2582,7 @@ var
MessI : TLMEnter;
begin
Result := CallBackDefaultReturn;
//writeln('[gtkFocusInNotifyCB] ',TControl(data).Name,':',TObject(data).ClassName);
//DebugLn('[gtkFocusInNotifyCB] ',TControl(data).Name,':',TObject(data).ClassName);
EventTrace ('FocusInNotify (alias Enter)', data);
if (Event=nil) then ;
@ -2601,7 +2601,7 @@ var
MessI : TLMExit;
begin
Result := CallBackDefaultReturn;
//writeln('[gtkFocusOutNotifyCB] ',TControl(data).Name,':',TObject(data).ClassName);
//DebugLn('[gtkFocusOutNotifyCB] ',TControl(data).Name,':',TObject(data).ClassName);
EventTrace ('FocusOutNotify (alias Exit)', data);
if (Event=nil) then ;
@ -2815,7 +2815,7 @@ begin
if VKey.VKey = $FF
then begin
if Pressed
then WriteLN(Format('[WARNING] Key pressed without VKey: K=0x%x S="%s"', [
then DebugLn(Format('[WARNING] Key pressed without VKey: K=0x%x S="%s"', [
Event^.KeyVal,
{$IFDEF GTK2} Event^._String {$ELSE} Event^.theString {$ENDIF}
]));
@ -2897,7 +2897,7 @@ begin
dec(i);
end;
{$IFDEF DEBUG_CLIPBOARD}
writeln('[ClipboardSelectionReceivedHandler] A TimeID=',TimeID,' RequestIndex=',i,
DebugLn('[ClipboardSelectionReceivedHandler] A TimeID=',TimeID,' RequestIndex=',i,
' selection=',SelectionData^.selection,
' target=',SelectionData^.Target,
' theType=',SelectionData^.theType,
@ -2913,7 +2913,7 @@ begin
// copy the raw data to an internal buffer (the gtk buffer will be destroyed
// right after this event)
{$IFDEF DEBUG_CLIPBOARD}
writeln('[ClipboardSelectionReceivedHandler] B DataLen=',c^.Data.Length);
DebugLn('[ClipboardSelectionReceivedHandler] B DataLen=',c^.Data.Length);
{$ENDIF}
if (c^.Data.Data<>nil)
and (c^.Data.Length>0) then begin
@ -2921,7 +2921,7 @@ begin
Move(c^.Data.Data^,TempBuf^,c^.Data.Length);
c^.Data.Data:=TempBuf;
{$IFDEF DEBUG_CLIPBOARD}
writeln('[ClipboardSelectionReceivedHandler] C FirstCharacter=',ord(PChar(c^.Data.Data)[0]));
DebugLn('[ClipboardSelectionReceivedHandler] C FirstCharacter=',ord(PChar(c^.Data.Data)[0]));
{$ENDIF}
end else
c^.Data.Data:=nil;
@ -2946,7 +2946,7 @@ var ClipboardType: TClipboardType;
BitCount: integer;
begin
{$IFDEF DEBUG_CLIPBOARD}
writeln('*** [ClipboardSelectionRequestHandler] START');
DebugLn('*** [ClipboardSelectionRequestHandler] START');
{$ENDIF}
if (Data=nil) or (TimeID=0) or (Info=0) or (TargetWidget=nil) then ;
if SelectionData^.Target=0 then exit;
@ -2957,7 +2957,7 @@ begin
// now create a stream and find a supported format
{$IFDEF DEBUG_CLIPBOARD}
p:=gdk_atom_name(SelectionData^.Target);
writeln('[ClipboardSelectionRequestHandler] ',ClipboardTypeName[ClipboardType],' Format=',p,' ID=',SelectionData^.Target);
DebugLn('[ClipboardSelectionRequestHandler] ',ClipboardTypeName[ClipboardType],' Format=',p,' ID=',SelectionData^.Target);
g_free(p);
{$ENDIF}
MemStream:=TMemoryStream.Create;
@ -2975,7 +2975,7 @@ begin
FormatID:=gdk_atom_intern('text/plain',GdkFalse);
{$IFDEF DEBUG_CLIPBOARD}
writeln('[ClipboardSelectionRequestHandler] FormatID=',FormatID,' CompoundText=',gdk_atom_intern('COMPOUND_TEXT',1),' ',ClipboardExtraGtkFormats[ClipboardType][gfCOMPOUND_TEXT]);
DebugLn('[ClipboardSelectionRequestHandler] FormatID=',FormatID,' CompoundText=',gdk_atom_intern('COMPOUND_TEXT',1),' ',ClipboardExtraGtkFormats[ClipboardType][gfCOMPOUND_TEXT]);
{$ENDIF}
// get the requested data by calling the handler for this clipboard type
ClipboardHandler[ClipboardType](FormatID,MemStream);
@ -3009,7 +3009,7 @@ begin
end;
if Buffer=nil then begin
{$IFDEF DEBUG_CLIPBOARD}
writeln('[ClipboardSelectionRequestHandler] Default MemStream.Size=',MemStream.Size);
DebugLn('[ClipboardSelectionRequestHandler] Default MemStream.Size=',MemStream.Size);
{$ENDIF}
BufLength:=integer(MemStream.Size);
if BufLength>0 then begin
@ -3018,11 +3018,11 @@ begin
{SetLength(s,MemStream.Size);
MemStream.Position:=0;
MemStream.Read(s[1],MemStream.Size);
writeln(' >>> "',s,'"');}
DebugLn(' >>> "',s,'"');}
end;
end;
{$IFDEF DEBUG_CLIPBOARD}
writeln('[ClipboardSelectionRequestHandler] Len=',BufLength);
DebugLn('[ClipboardSelectionRequestHandler] Len=',BufLength);
{$ENDIF}
gtk_selection_data_set(SelectionData,SelectionData^.Target,BitCount,
Buffer,BufLength);
@ -3046,11 +3046,11 @@ function ClipboardSelectionLostOwnershipHandler(TargetWidget: PGtkWidget;
var ClipboardType: TClipboardType;
begin
if (Data=nil) or (TargetWidget=nil) then ;
//writeln('*** [ClipboardSelectionLostOwnershipHandler] ',hexstr(cardinal(targetwidget),8));
//DebugLn('*** [ClipboardSelectionLostOwnershipHandler] ',hexstr(cardinal(targetwidget),8));
for ClipboardType:=Low(TClipboardType) to High(TClipboardType) do
if EventSelection^.Selection=ClipboardTypeAtoms[ClipboardType] then begin
{$IFDEF DEBUG_CLIPBOARD}
writeln('*** [ClipboardSelectionLostOwnershipHandler] ',ClipboardTypeName[ClipboardType]);
DebugLn('*** [ClipboardSelectionLostOwnershipHandler] ',ClipboardTypeName[ClipboardType]);
{$ENDIF}
if (ClipboardWidget<>nil)
and (gdk_selection_owner_get(ClipboardTypeAtoms[ClipboardType])
@ -3058,7 +3058,7 @@ begin
and Assigned(ClipboardHandler[ClipboardType]) then begin
// handler found for this type of clipboard
{$IFDEF DEBUG_CLIPBOARD}
writeln('[ClipboardSelectionLostOwnershipHandler] ',ClipboardTypeName[ClipboardType]);
DebugLn('[ClipboardSelectionLostOwnershipHandler] ',ClipboardTypeName[ClipboardType]);
{$ENDIF}
ClipboardHandler[ClipboardType](0,nil);
ClipboardHandler[ClipboardType]:=nil;
@ -3098,6 +3098,9 @@ end;
{ =============================================================================
$Log$
Revision 1.230 2004/05/11 11:42:27 mattias
replaced writeln by debugln
Revision 1.229 2004/05/11 09:49:46 mattias
started sending CN_KEYUP

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

File diff suppressed because it is too large Load Diff

30
lcl/intfgraphics.pas
View File

@ -959,7 +959,7 @@ begin
end;
else
writeln('WARNING: TLazIntfImage.ChooseRawBitsProc Unsupported BitsPerPixel=',BitsPerPixel);
DebugLn('WARNING: TLazIntfImage.ChooseRawBitsProc Unsupported BitsPerPixel=',dbgs(BitsPerPixel));
ProcReadRawImageBits := @ReadRawImageBits_NULL;
ProcWriteRawImageBits := @WriteRawImageBits_NULL;
end;
@ -969,7 +969,7 @@ procedure TLazIntfImage.ChooseGetSetColorFunctions;
procedure ChooseRGBAFunctions;
begin
//writeln('ChooseRGBAFunctions ',RawImageDescriptionAsString(@FDataDescription));
//DebugLn('ChooseRGBAFunctions ',RawImageDescriptionAsString(@FDataDescription));
ChooseRawBitsProc(FDataDescription.BitsPerPixel,
FDataDescription.ByteOrder,
FDataDescription.BitOrder,
@ -1047,7 +1047,7 @@ begin
end else begin
// palette
// ToDo
writeln('WARNING: TLazIntfImage.ChooseGetSetColorFunctions Palette is unsupported');
DebugLn('WARNING: TLazIntfImage.ChooseGetSetColorFunctions Palette is unsupported');
end;
end;
@ -1401,7 +1401,7 @@ procedure TLazIntfImage.SetInternalColor(x, y: integer; const Value: TFPColor);
begin
{if (x=0) and (y=0) then begin
// a common bug in the readers is that Alpha is reversed
writeln('TLazIntfImage.SetInternalColor ',x,',',y,' ',Value.Red,',',Value.Green,',',Value.Blue,',',Value.Alpha);
DebugLn('TLazIntfImage.SetInternalColor ',x,',',y,' ',Value.Red,',',Value.Green,',',Value.Blue,',',Value.Alpha);
if Value.Alpha<>alphaOpaque then
RaiseGDBException('');
end;}
@ -1538,7 +1538,7 @@ function TLazIntfImage.CheckDescription(
procedure DoError(const Msg: string);
begin
if ExceptionOnError then Raise FPImageException.Create(Msg);
writeln('TLazIntfImage.CheckDescription: ',Msg);
DebugLn('TLazIntfImage.CheckDescription: ',Msg);
end;
begin
@ -1750,7 +1750,7 @@ begin
while ArrNode<>nil do begin
Entry:=PXPMPixelToColorEntry(ArrNode.Data);
if Entry<>nil then begin
//writeln('TLazReaderXPM.ClearPixelToColorTree A ',HexStr(Cardinal(ArrNode),8),' ',HexStr(Cardinal(Entry),8));
//DebugLn('TLazReaderXPM.ClearPixelToColorTree A ',HexStr(Cardinal(ArrNode),8),' ',HexStr(Cardinal(Entry),8));
Dispose(Entry);
end;
ArrNode:=ArrNode.FindNext;
@ -1828,7 +1828,7 @@ var
if (Src[SrcPos]='"') and (Src[SrcPos-1]<>'\') then begin
// string end found
Line.EndPos:=SrcPos;
//writeln(' "',copy(Src,Line.StartPos,SrcPos-Line.StartPos),'"');
//DebugLn(' "',copy(Src,Line.StartPos,SrcPos-Line.StartPos),'"');
inc(SrcPos);
Result:=true;
exit;
@ -1873,7 +1873,7 @@ var
FCharsPerPixel:=ReadNumber(FirstLine.StartPos,true);
fXHot:=ReadNumber(FirstLine.StartPos,false);
fYHot:=ReadNumber(FirstLine.StartPos,fXHot<>0);
//writeln('ReadHeader A Width=',FWidth,' Height=',FHeight,' ColorCount=',FColorCount,' CharsPerPixel=',FCharsPerPixel);
//DebugLn('ReadHeader A Width=',FWidth,' Height=',FHeight,' ColorCount=',FColorCount,' CharsPerPixel=',FCharsPerPixel);
// ToDo: parse XPMExt tag
end;
@ -1998,7 +1998,7 @@ var
NewEntry: PXPMPixelToColorEntry;
i: Integer;
begin
{writeln('TLazReaderXPM.InternalRead.AddColor A "',PixelString,'"=',
{DebugLn('TLazReaderXPM.InternalRead.AddColor A "',PixelString,'"=',
HexStr(Cardinal(AColor.Red),4),',',
HexStr(Cardinal(AColor.Green),4),',',
HexStr(Cardinal(AColor.Blue),4),',',
@ -2087,14 +2087,14 @@ var
FPixelToColorTree.FindData(IntArray,FCharsPerPixel));
CurColor:=CurEntry^.Color;
{if CurEntry2<>CurEntry then begin
writeln('x=',x,' y=',y,' Pixel=',Entry^.Pixel,
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));
writeln('Entry2: Pixel=',CurEntry2^.Pixel,
DebugLn('Entry2: Pixel=',CurEntry2^.Pixel,
' RefPixel=',CurEntry2^.Pixel,
' Color=',
HexStr(Cardinal(CurEntry2^.Color.Red),4),',',
@ -2103,7 +2103,7 @@ var
HexStr(Cardinal(CurEntry2^.Color.Alpha),4));
end;}
{writeln('x=',x,' y=',y,' Pixel=',Entry^.Pixel,
{DebugLn('x=',x,' y=',y,' Pixel=',Entry^.Pixel,
' RefPixel=',PXPMPixelToColorEntry(Node.Data)^.Pixel,
' Color=',
HexStr(Cardinal(CurColor.Red),4),',',
@ -2567,7 +2567,7 @@ end;
constructor TArrayNode.Create;
begin
//writeln('TArrayNode.Create ',Capacity,' Self=',HexStr(Cardinal(Self),8));
//DebugLn('TArrayNode.Create ',Capacity,' Self=',HexStr(Cardinal(Self),8));
end;
destructor TArrayNode.Destroy;
@ -2640,7 +2640,7 @@ var
NewCapacity: Integer;
OldSize: Integer;
begin
//writeln('TArrayNode.Expand A ',ValueToInclude,' Capacity=',Capacity,' StartValue=',StartValue);
//DebugLn('TArrayNode.Expand A ',ValueToInclude,' Capacity=',Capacity,' StartValue=',StartValue);
if Childs=nil then begin
NewStartValue:=ValueToInclude;
NewCapacity:=4;
@ -2856,7 +2856,7 @@ begin
Root:=TArrayNode.Create;
Result:=Root;
for i:=0 to Count-1 do begin
//writeln('TArrayNodesTree.SetNode A ',HexStr(Cardinal(Result),8));
//DebugLn('TArrayNodesTree.SetNode A ',HexStr(Cardinal(Result),8));
Result:=Result.GetChildNode(IntArray[i],true);
end;
Result.Data:=Data;

100
lcl/lclproc.pas
View File

@ -89,6 +89,13 @@ function BreakString(const s: string; MaxLineLength, Indent: integer): string;
function ComparePointers(p1, p2: Pointer): integer;
function RoundToInt(const e: Extended): integer;
function RoundToCardinal(const e: Extended): cardinal;
function TruncToInt(const e: Extended): integer;
function TruncToCardinal(const e: Extended): cardinal;
function StrToDouble(const s: string): double;
// debugging
procedure RaiseGDBException(const Msg: string);
@ -107,9 +114,15 @@ procedure DebugLn(const s1,s2,s3,s4,s5,s6,s7,s8,s9,s10: string);
procedure DbgOut(const s: string);
procedure DbgOut(const s1,s2: string);
function DbgS(const c: cardinal): string;
function DbgS(const i: integer): string;
function DbgS(const r: TRect): string;
function DbgS(const p: TPoint): string;
function DbgS(const p: pointer): string;
function DbgS(const e: extended): string;
function DbgS(const b: boolean): string;
function DbgS(const i1,i2,i3,i4: integer): string;
implementation
@ -563,9 +576,49 @@ begin
Result:=0;
end;
function RoundToInt(const e: Extended): integer;
begin
Result:=integer(Round(e));
{$IFDEF VerboseRound}
DebugLn('RoundToInt ',e,' ',Result);
{$ENDIF}
end;
function RoundToCardinal(const e: Extended): cardinal;
begin
Result:=cardinal(Round(e));
{$IFDEF VerboseRound}
DebugLn('RoundToCardinal ',e,' ',Result);
{$ENDIF}
end;
function TruncToInt(const e: Extended): integer;
begin
Result:=integer(Trunc(e));
{$IFDEF VerboseRound}
DebugLn('TruncToInt ',e,' ',Result);
{$ENDIF}
end;
function TruncToCardinal(const e: Extended): cardinal;
begin
Result:=cardinal(Trunc(e));
{$IFDEF VerboseRound}
DebugLn('TruncToCardinal ',e,' ',Result);
{$ENDIF}
end;
function StrToDouble(const s: string): double;
begin
{$IFDEF VerboseRound}
DebugLn('StrToDouble "',s,'"');
{$ENDIF}
Result:=Double(StrToFloat(s));
end;
procedure DebugLn;
begin
writeln;
DebugLn('');
end;
procedure DebugLn(const s: string);
@ -575,47 +628,47 @@ end;
procedure DebugLn(const s1, s2: string);
begin
writeln(s1,s2);
DebugLn(s1+s2);
end;
procedure DebugLn(const s1, s2, s3: string);
begin
writeln(s1,s2,s3);
writeln(s1+s2+s3);
end;
procedure DebugLn(const s1, s2, s3, s4: string);
begin
writeln(s1,s2,s3,s4);
DebugLn(s1+s2+s3+s4);
end;
procedure DebugLn(const s1, s2, s3, s4, s5: string);
begin
writeln(s1,s2,s3,s4,s5);
DebugLn(s1+s2+s3+s4+s5);
end;
procedure DebugLn(const s1, s2, s3, s4, s5, s6: string);
begin
writeln(s1,s2,s3,s4,s5,s6);
DebugLn(s1+s2+s3+s4+s5+s6);
end;
procedure DebugLn(const s1, s2, s3, s4, s5, s6, s7: string);
begin
writeln(s1,s2,s3,s4,s5,s6,s7);
DebugLn(s1+s2+s3+s4+s5+s6+s7);
end;
procedure DebugLn(const s1, s2, s3, s4, s5, s6, s7, s8: string);
begin
writeln(s1,s2,s3,s4,s5,s6,s7,s8);
DebugLn(s1+s2+s3+s4+s5+s6+s7+s8);
end;
procedure DebugLn(const s1, s2, s3, s4, s5, s6, s7, s8, s9: string);
begin
writeln(s1,s2,s3,s4,s5,s6,s7,s8,s9);
DebugLn(s1+s2+s3+s4+s5+s6+s7+s8+s9);
end;
procedure DebugLn(const s1, s2, s3, s4, s5, s6, s7, s8, s9, s10: string);
begin
writeln(s1,s2,s3,s4,s5,s6,s7,s8,s9,s10);
DebugLn(s1+s2+s3+s4+s5+s6+s7+s8+s9+s10);
end;
procedure DBGOut(const s: string);
@ -625,7 +678,12 @@ end;
procedure DBGOut(const s1, s2: string);
begin
write(s1,s2);
DbgOut(s1+s2);
end;
function DbgS(const c: cardinal): string;
begin
Result:=IntToStr(c);
end;
function DbgS(const i: integer): string;
@ -644,6 +702,26 @@ begin
Result:=' x='+IntToStr(p.x)+',y='+IntToStr(p.y);
end;
function DbgS(const p: pointer): string;
begin
Result:=HexStr(Cardinal(p),8);
end;
function DbgS(const e: extended): string;
begin
Result:=FloatToStr(e);
end;
function DbgS(const b: boolean): string;
begin
if b then Result:='True' else Result:='False';
end;
function DbgS(const i1, i2, i3, i4: integer): string;
begin
Result:=dbgs(i1)+','+dbgs(i2)+','+dbgs(i3)+','+dbgs(i4);
end;
initialization
SendApplicationMessageFunction:=nil;
OwnerFormDesignerModifiedProc:=nil;

22
lcl/widgetset/wslclclasses.pp
View File

@ -42,7 +42,7 @@ interface
// the uses clause of the XXXintf.pp
////////////////////////////////////////////////////
uses
Classes, LCLType, InterfaceBase;
Classes, LCLType, LCLProc, InterfaceBase;
type
{ TWSLCLComponent }
@ -231,11 +231,11 @@ procedure RegisterWSComponent(const AComponent: TComponentClass;
ParentWSNode := FindParentWSClassNode(ANode);
if ParentWSNode = nil then Exit; // nothing to do
{$IFDEF VerboseWSRegistration}
WriteLN('Virtual parent: ', ParentWSNode^.WSClass.ClassName);
DebugLn('Virtual parent: ', ParentWSNode^.WSClass.ClassName);
{$ENDIF}
CommonClass := FindCommonAncestor(ANode^.WSClass, ParentWSNode^.WSClass);
{$IFDEF VerboseWSRegistration}
WriteLN('Common: ', CommonClass.ClassName);
DebugLn('Common: ', CommonClass.ClassName);
Indent := '';
{$ENDIF}
@ -249,7 +249,7 @@ procedure RegisterWSComponent(const AComponent: TComponentClass;
if Cmnt <> nil
then begin
{$IFDEF VerboseWSRegistration}
WriteLN(Indent, '*', CommonClass.Classname, ' method count: ', Cmnt^.Count);
DebugLn(Indent, '*', CommonClass.Classname, ' method count: ', Cmnt^.Count);
Indent := Indent + ' ';
{$ENDIF}
@ -260,7 +260,7 @@ procedure RegisterWSComponent(const AComponent: TComponentClass;
for n := 0 to Cmnt^.Count - 1 do
begin
{$IFDEF VerboseWSRegistration}
WriteLN(Indent, 'Search: ', Cmnt^.Entries[n].Name^);
DebugLn(Indent, 'Search: ', Cmnt^.Entries[n].Name^);
{$ENDIF}
SearchAddr := Cmnt^.Entries[n].Addr;
@ -269,13 +269,13 @@ procedure RegisterWSComponent(const AComponent: TComponentClass;
if Cvmt^[idx] = SearchAddr
then begin
{$IFDEF VerboseWSRegistration}
WriteLN(Indent, 'Found at index: ', idx);
DebugLn(Indent, 'Found at index: ', idx);
{$ENDIF}
if Processed[idx]
then begin
{$IFDEF VerboseWSRegistration}
WriteLN(Indent, 'Procesed -> skipping');
DebugLn(Indent, 'Procesed -> skipping');
{$ENDIF}
Break;
end;
@ -285,7 +285,7 @@ procedure RegisterWSComponent(const AComponent: TComponentClass;
and (Pvmt^[idx] <> SearchAddr) //overridden by parent
then begin
{$IFDEF VerboseWSRegistration}
WriteLN(Indent, Format('Updating %p -> %p', [Vvmt^[idx], Pvmt^[idx]]));
DebugLn(Indent, Format('Updating %p -> %p', [Vvmt^[idx], Pvmt^[idx]]));
{$ENDIF}
Vvmt^[idx] := Pvmt^[idx];
end;
@ -294,7 +294,7 @@ procedure RegisterWSComponent(const AComponent: TComponentClass;
end;
if idx = VIRTUAL_VMT_COUNT - 1
then begin
WriteLN('[WARNING] VMT entry "', Cmnt^.Entries[n].Name^, '" not found in "', CommonClass.ClassName, '"');
DebugLn('[WARNING] VMT entry "', Cmnt^.Entries[n].Name^, '" not found in "', CommonClass.ClassName, '"');
Break;
end;
end;
@ -323,7 +323,7 @@ procedure RegisterWSComponent(const AComponent: TComponentClass;
if Node^.WSClass <> nil
then begin
{$IFDEF VerboseWSRegistration}
WriteLN('Update VClass for: ', Node^.WSClass.ClassName);
DebugLn('Update VClass for: ', Node^.WSClass.ClassName);
{$ENDIF}
CreateVClass(Node);
end;
@ -343,7 +343,7 @@ begin
Node^.WSClass := AWSComponent;
{$IFDEF VerboseWSRegistration}
WriteLN('Create VClass for: ', Node^.WSClass.ClassName);
DebugLn('Create VClass for: ', Node^.WSClass.ClassName);
{$ENDIF}
CreateVClass(Node);

4
packager/pkgoptionsdlg.pas
View File

@ -38,8 +38,8 @@ unit PkgOptionsDlg;
interface
uses
Classes, SysUtils, FPCAdds, Forms, Controls, Buttons, LResources, ExtCtrls,
StdCtrls, Spin, Dialogs, PathEditorDlg, IDEProcs, IDEOptionDefs,
Classes, SysUtils, FPCAdds, LCLProc, Forms, Controls, Buttons, LResources,
ExtCtrls, StdCtrls, Spin, Dialogs, PathEditorDlg, IDEProcs, IDEOptionDefs,
LazarusIDEStrConsts, BrokenDependenciesDlg, PackageDefs, PackageSystem,
CompilerOptions;