diff --git a/ide/environmentopts.pp b/ide/environmentopts.pp index 24cc55d33c..5df49e74fd 100644 --- a/ide/environmentopts.pp +++ b/ide/environmentopts.pp @@ -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; diff --git a/ide/project.pp b/ide/project.pp index 206442ebb5..b147ebd36d 100644 --- a/ide/project.pp +++ b/ide/project.pp @@ -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 diff --git a/lcl/dbgrids.pas b/lcl/dbgrids.pas index 8e8988feb8..951bf408df 100644 --- a/lcl/dbgrids.pas +++ b/lcl/dbgrids.pas @@ -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; diff --git a/lcl/dynamicarray.pas b/lcl/dynamicarray.pas index e9e68f6dc7..8523164a6d 100644 --- a/lcl/dynamicarray.pas +++ b/lcl/dynamicarray.pas @@ -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 diff --git a/lcl/editbtn.pas b/lcl/editbtn.pas index 8ff628f3d2..c9f16c33d6 100644 --- a/lcl/editbtn.pas +++ b/lcl/editbtn.pas @@ -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 diff --git a/lcl/extdlgs.pas b/lcl/extdlgs.pas index eee157a3e1..9e493980c7 100644 --- a/lcl/extdlgs.pas +++ b/lcl/extdlgs.pas @@ -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; diff --git a/lcl/fpcadds.pas b/lcl/fpcadds.pas index 41e09684ff..6df14edd0a 100644 --- a/lcl/fpcadds.pas +++ b/lcl/fpcadds.pas @@ -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. diff --git a/lcl/graphmath.pp b/lcl/graphmath.pp index 1f1d297d4b..26480be5d0 100644 --- a/lcl/graphmath.pp +++ b/lcl/graphmath.pp @@ -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 diff --git a/lcl/graphtype.pp b/lcl/graphtype.pp index 388986af49..2452403aae 100644 --- a/lcl/graphtype.pp +++ b/lcl/graphtype.pp @@ -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 diff --git a/lcl/include/application.inc b/lcl/include/application.inc index 0a2267e0b1..729678c7ee 100644 --- a/lcl/include/application.inc +++ b/lcl/include/application.inc @@ -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 diff --git a/lcl/include/bitmap.inc b/lcl/include/bitmap.inc index 296c6570ee..891d8f18ff 100644 --- a/lcl/include/bitmap.inc +++ b/lcl/include/bitmap.inc @@ -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 diff --git a/lcl/include/clipbrd.inc b/lcl/include/clipbrd.inc index 372369822f..d9c19bc586 100644 --- a/lcl/include/clipbrd.inc +++ b/lcl/include/clipbrd.inc @@ -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 (iFormatID) do inc(i); Result := inil 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 diff --git a/lcl/include/control.inc b/lcl/include/control.inc index 58015ab1f3..273510ea58 100644 --- a/lcl/include/control.inc +++ b/lcl/include/control.inc @@ -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 diff --git a/lcl/include/customform.inc b/lcl/include/customform.inc index ba4f3489e0..76cb386566 100644 --- a/lcl/include/customform.inc +++ b/lcl/include/customform.inc @@ -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 diff --git a/lcl/include/customnotebook.inc b/lcl/include/customnotebook.inc index 60079ba148..f54635cf71 100644 --- a/lcl/include/customnotebook.inc +++ b/lcl/include/customnotebook.inc @@ -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 Index0 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 diff --git a/lcl/include/imglist.inc b/lcl/include/imglist.inc index 1f71de9615..fd21cab4ee 100644 --- a/lcl/include/imglist.inc +++ b/lcl/include/imglist.inc @@ -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 diff --git a/lcl/include/treeview.inc b/lcl/include/treeview.inc index 1236604c29..e93456bff3 100644 --- a/lcl/include/treeview.inc +++ b/lcl/include/treeview.inc @@ -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 (iFTopLvlItems[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>>>>>>>>> [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$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; diff --git a/lcl/include/wincontrol.inc b/lcl/include/wincontrol.inc index fccbac029f..a7d59781cc 100644 --- a/lcl/include/wincontrol.inc +++ b/lcl/include/wincontrol.inc @@ -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 diff --git a/lcl/interfaces/gtk/gtkcallback.inc b/lcl/interfaces/gtk/gtkcallback.inc index 4cda3e7254..b5c7c39a4a 100644 --- a/lcl/interfaces/gtk/gtkcallback.inc +++ b/lcl/interfaces/gtk/gtkcallback.inc @@ -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 diff --git a/lcl/interfaces/gtk/gtkwinapi.inc b/lcl/interfaces/gtk/gtkwinapi.inc index 8023b49c53..56b77d6709 100644 --- a/lcl/interfaces/gtk/gtkwinapi.inc +++ b/lcl/interfaces/gtk/gtkwinapi.inc @@ -58,7 +58,7 @@ begin begin if GC = nil then begin - WriteLn('WARNING: [TGtkWidgetSet.Arc] Uninitialized GC'); + DebugLn('WARNING: [TGtkWidgetSet.Arc] Uninitialized GC'); Result := False; end else begin @@ -107,7 +107,7 @@ begin begin if GC = nil then begin - WriteLn('WARNING: [TGtkWidgetSet.AngleChord] Uninitialized GC'); + DebugLn('WARNING: [TGtkWidgetSet.AngleChord] Uninitialized GC'); Result := False; end else @@ -140,7 +140,7 @@ begin PaintWidget:=GetFixedWidget(PGtkWidget(TWinControl(TargetObject).Handle)); IsDoubleBuffered:=(PaintWidget=Widget); //if not IsDoubleBuffered then begin - // writeln('TGtkWidgetSet.BeginPaint Not the paint widget: ', + // DebugLn('TGtkWidgetSet.BeginPaint Not the paint widget: ', // TWinControl(TargetObject).Name,':',TWinControl(TargetObject).ClassName, // ' PaintWidget=',GetWidgetClassName(PaintWidget), // ' Widget=',GetWidgetClassName(Widget)); @@ -197,9 +197,9 @@ begin write('TGtkWidgetSet.BringWindowToTop hWnd=',HexStr(Cardinal(hWnd),8)); LCLObject:=TControl(GetLCLObject(Pointer(hWnd))); if LCLObject<>nil then - writeln(' LCLObject=',LCLObject.Name,':',LCLObject.ClassName) + DebugLn(' LCLObject=',LCLObject.Name,':',LCLObject.ClassName) else - writeln(' LCLObject=nil'); + DebugLn(' LCLObject=nil'); {$ENDIF} Result := GtkWidgetIsA(PGtkWidget(hWnd),GTK_TYPE_WINDOW); if Result then begin @@ -345,7 +345,7 @@ var FormatAtom, FormatTry: Cardinal; Result:=false; AllID:=gdk_atom_intern('TARGETS',GdkFalse); SelData:=RequestSelectionData(ClipboardWidget,ClipboardType,AllID); - {writeln('IsFormatSupported A ',HexStr(Cardinal(SelData.Selection),8), + {DebugLn('IsFormatSupported A ',HexStr(Cardinal(SelData.Selection),8), ' ',HexStr(Cardinal(ClipboardTypeAtoms[ClipboardType]),8), ' SelData.Target=',SelData.Target,' AllID=',AllID, ' SelData.TheType=',SelData.TheType,' ',gdk_atom_intern('ATOM',0), @@ -368,7 +368,7 @@ var FormatAtom, FormatTry: Cardinal; begin {$IfDef DEBUG_CLIPBOARD} - writeln('[TGtkWidgetSet.ClipboardGetData] A ClipboardWidget=',HexStr(Cardinal(ClipboardWidget),8),' Format=',ClipboardFormatToMimeType(FormatID),' Now=',Now); + DebugLn('[TGtkWidgetSet.ClipboardGetData] A ClipboardWidget=',HexStr(Cardinal(ClipboardWidget),8),' Format=',ClipboardFormatToMimeType(FormatID),' Now=',Now); {$EndIf} Result:=false; if (FormatID=0) or (Stream=nil) then exit; @@ -415,7 +415,7 @@ begin end; {$IfDef DEBUG_CLIPBOARD} - writeln('[TGtkWidgetSet.ClipboardGetData] B Format=',ClipboardFormatToMimeType(FormatAtom),' Now=',Now); + DebugLn('[TGtkWidgetSet.ClipboardGetData] B Format=',ClipboardFormatToMimeType(FormatAtom),' Now=',Now); {$EndIf} if FormatAtom=0 then exit; @@ -423,7 +423,7 @@ begin SelData:=RequestSelectionData(ClipboardWidget,ClipboardType,FormatAtom); try {$IfDef DEBUG_CLIPBOARD} - writeln('[TGtkWidgetSet.ClipboardGetData] C Length=',SelData.Length,' Now=',Now); + DebugLn('[TGtkWidgetSet.ClipboardGetData] C Length=',SelData.Length,' Now=',Now); {$EndIf} if (SelData.Selection<>ClipboardTypeAtoms[ClipboardType]) or (SelData.Target<>FormatAtom) then @@ -438,7 +438,7 @@ begin CompoundTextCount:=gdk_text_property_to_text_list(SelData.{$IfDef GTK2}_Type{$Else}theType{$EndIf}, SelData.Format,SelData.Data,SelData.Length,{$IfDef GTK1}@{$EndIf}CompoundTextList); {$IfDef DEBUG_CLIPBOARD} - writeln('[TGtkWidgetSet.ClipboardGetData] D CompoundTextCount=',CompoundTextCount,' Now=',Now); + DebugLn('[TGtkWidgetSet.ClipboardGetData] D CompoundTextCount=',CompoundTextCount,' Now=',Now); {$EndIf} for i:=0 to CompoundTextCount-1 do if (CompoundTextList[i]<>nil) then @@ -452,7 +452,7 @@ begin end; {$IfDef DEBUG_CLIPBOARD} - writeln('[TGtkWidgetSet.ClipboardGetData] END ',' Now=',Now); + DebugLn('[TGtkWidgetSet.ClipboardGetData] END ',' Now=',Now); {$EndIf} finally if SelData.Data<>nil then FreeMem(SelData.Data); @@ -488,7 +488,7 @@ var AllID: cardinal; if Format<>0 then begin for a:=0 to Cnt-1 do begin {$IfDef DEBUG_CLIPBOARD} - writeln(' IsFormatSupported ',Format,' ',FormatAtoms[a]); + DebugLn(' IsFormatSupported ',Format,' ',FormatAtoms[a]); {$EndIf} if FormatAtoms[a]=Format then begin Result:=true; @@ -516,7 +516,7 @@ var AllID: cardinal; begin {$IfDef DEBUG_CLIPBOARD} - writeln('[TGtkWidgetSet.ClipboardGetFormats] A ClipboardWidget=',HexStr(Cardinal(ClipboardWidget),8),' Now=',Now); + DebugLn('[TGtkWidgetSet.ClipboardGetFormats] A ClipboardWidget=',HexStr(Cardinal(ClipboardWidget),8),' Now=',Now); {$EndIf} Result:=false; Count:=0; @@ -530,7 +530,7 @@ begin try {$IfDef DEBUG_CLIPBOARD} - writeln('[TGtkWidgetSet.ClipboardGetFormats] Checking TARGETS answer ', + DebugLn('[TGtkWidgetSet.ClipboardGetFormats] Checking TARGETS answer ', ' selection: ',SelData.Selection,'=',ClipboardTypeAtoms[ClipboardType], ' "',gdk_atom_name(SelData.Selection),'"', ' target: ',SelData.Target,'=',AllID, @@ -574,9 +574,9 @@ begin i:=0; while (i 32) then begin Result := 0; - WriteLn(Format('ERROR: [TGtkWidgetSet.CreateBitmap] Illegal depth %d', [BitCount])); + DebugLn(Format('ERROR: [TGtkWidgetSet.CreateBitmap] Illegal depth %d', [BitCount])); Exit; end; @@ -821,7 +821,7 @@ begin else begin GdiObject^.Visual := gdk_visual_get_best_with_depth(BitCount); if GdiObject^.Visual=nil then begin - writeln('Warning: [TGtkWidgetSet.CreateBitmap] No visual for depth ', + DebugLn('Warning: [TGtkWidgetSet.CreateBitmap] No visual for depth ', BitCount,'. Using default.'); GdiObject^.Visual := gdk_visual_get_system; end; @@ -860,7 +860,7 @@ begin end;} Result := HBITMAP(GdiObject); -//writeln('[TGtkWidgetSet.CreateBitmap] ',HexStr(Result,8)); +//DebugLn('[TGtkWidgetSet.CreateBitmap] ',HexStr(Result,8)); Assert(False, Format('Trace:< [TGtkWidgetSet.CreateBitmap] --> 0x%x', [Integer(Result)])); end; @@ -894,7 +894,7 @@ begin try {$IFDEF VerboseRawImage} - writeln('TGtkWidgetSet.CreateBitmapFromRawImage A ', + DebugLn('TGtkWidgetSet.CreateBitmapFromRawImage A ', ' AlwaysCreateMask=',AlwaysCreateMask, ' Depth=',RawImage.Description.Depth, ' Width=',RawImage.Description.Width, @@ -946,7 +946,7 @@ begin Visual:=gdk_visual_get_best_with_depth(ImgDepth); GdkImage:=gdk_image_new(GDK_IMAGE_FASTEST,Visual,ImgWidth,ImgHeight); {$IFDEF VerboseRawImage} - writeln('TGtkWidgetSet.CreateBitmapFromRawImage GdkImage: ', + DebugLn('TGtkWidgetSet.CreateBitmapFromRawImage GdkImage: ', ' BytesPerLine=',GdkImage^.bpl, ' BytesPerPixel=',GdkImage^.bpp, ' ByteOrder=',GdkImage^.byte_order, @@ -983,7 +983,7 @@ begin if (AlwaysCreateMask or (not RawImageMaskIsEmpty(@RawImage,true))) and (RawImage.Mask<>nil) then begin {$IFDEF VerboseRawImage} - writeln('TGtkWidgetSet.CreateBitmapFromRawImage creating mask .. '); + DebugLn('TGtkWidgetSet.CreateBitmapFromRawImage creating mask .. '); {$ENDIF} GdiObject^.GDIBitmapMaskObject := gdk_bitmap_create_from_data(DefGdkWindow,PGChar(RawImage.Mask), @@ -1029,7 +1029,7 @@ begin //write('CreateBrushIndirect->'); GObject := NewGDIObject(gdiBrush); try - //writeln('[TGtkWidgetSet.CreateBrushIndirect] ',HexStr(Cardinal(GObject),8)); + //DebugLn('[TGtkWidgetSet.CreateBrushIndirect] ',HexStr(Cardinal(GObject),8)); GObject^.IsNullBrush := False; with LogBrush do begin @@ -1112,7 +1112,7 @@ begin except Result:=0; DisposeGDIObject(GObject); - writeln('TGtkWidgetSet.CreateBrushIndirect failed'); + DebugLn('TGtkWidgetSet.CreateBrushIndirect failed'); end; Assert(False, Format('Trace:< [TGtkWidgetSet.CreateBrushIndirect] Got --> %x', [Result])); end; @@ -1187,7 +1187,7 @@ begin if (Depth < 1) or (Depth > 32) then begin Result := 0; - WriteLn(Format('ERROR: [TGtkWidgetSet.CreateCompatibleBitmap] Illegal depth %d', [Depth])); + DebugLn(Format('ERROR: [TGtkWidgetSet.CreateCompatibleBitmap] Illegal depth %d', [Depth])); {$IFDEF DebugGDKTraps} EndGDKErrorTrap; {$ENDIF} @@ -1296,7 +1296,7 @@ function TGtkWidgetSet.CreateFontIndirectEx(const LogFont: TLogFont; const LongFontName: string): HFONT; {$IfDef GTK2} begin - writeln('ToDo: TGtkWidgetSet.CreateFontIndirectEx'); + DebugLn('ToDo: TGtkWidgetSet.CreateFontIndirectEx'); Result:=0; end; {$Else} @@ -1320,7 +1320,7 @@ var GdiObject^.GDIFontObject := gdk_font_load(PChar(s)); {$IFDEF VerboseFonts} - writeln(' Trying "',S,'" Success=',GdiObject^.GDIFontObject<>nil); + DebugLn(' Trying "',S,'" Success=',GdiObject^.GDIFontObject<>nil); {$ENDIF} end; @@ -1329,7 +1329,7 @@ var DisposeGDIObject(GdiObject); GdiObject:=CreateDefaultFont; {$IFDEF VerboseFonts} - writeln('TGtkWidgetSet.CreateFontIndirectEx.LoadDefaultFont'); + DebugLn('TGtkWidgetSet.CreateFontIndirectEx.LoadDefaultFont'); {$ENDIF} end; @@ -1355,7 +1355,7 @@ begin // Lets fill in all the xlfd parts. Assume we have scalable fonts {$IFDEF VerboseFonts} - writeln('TGtkWidgetSet.CreateFontIndirectEx A Name=',LogFont.lfFaceName,' Height=',LogFont.lfHeight); + DebugLn('TGtkWidgetSet.CreateFontIndirectEx A Name=',LogFont.lfFaceName,' Height=',LogFont.lfHeight); {$ENDIF} Result := 0; @@ -1385,7 +1385,7 @@ begin // This way, the user can set X fonts that are not supported by TFont. {$IFDEF VerboseFonts} - writeln('TGtkWidgetSet.CreateFontIndirectEx Name="',LogFont.lfFaceName,'"', + DebugLn('TGtkWidgetSet.CreateFontIndirectEx Name="',LogFont.lfFaceName,'"', ' Long="',LongFontName,'" IsXLFD=',IsFontNameXLogicalFontDesc(LongFontName) ,' ',ord(LogFont.lfFaceName[0])); {$ENDIF} @@ -1426,7 +1426,7 @@ begin if AnsiCompareText(FamilyName,'default')=0 then begin {$IFDEF VerboseFonts} - writeln('TGtkWidgetSet.CreateFontIndirectEx FamilyName="',FamilyName,'" PixelSize=',PixelSize,' LogFont.lfHeight=',LogFont.lfHeight); + DebugLn('TGtkWidgetSet.CreateFontIndirectEx FamilyName="',FamilyName,'" PixelSize=',PixelSize,' LogFont.lfHeight=',LogFont.lfHeight); {$ENDIF} if (LogFont.lfHeight=0) then begin LoadDefaultFont; @@ -1626,7 +1626,7 @@ begin if GdiObject^.GDIFontObject = nil then begin {$IFDEF VerboseFonts} - writeln('[TGtkWidgetSet.CreateFontIndirect] ',HexStr(Cardinal(GdiObject),8),' ',FGDIObjects.Count); + DebugLn('[TGtkWidgetSet.CreateFontIndirect] ',HexStr(Cardinal(GdiObject),8),' ',FGDIObjects.Count); {$ENDIF} DisposeGDIObject(GdiObject); Result := 0; @@ -1636,7 +1636,7 @@ begin end; if Result = 0 - then WriteLn(Format('WARNING: [TGtkWidgetSet.CreateFontIndirectEx] NOT found XLFD: <%s>', [S])) + then DebugLn(Format('WARNING: [TGtkWidgetSet.CreateFontIndirectEx] NOT found XLFD: <%s>', [S])) else Assert(False, Format('Trace: [TGtkWidgetSet.CreateFontIndirectEx] found XLFD: <%s>', [S])); end; end; @@ -1871,7 +1871,7 @@ begin gdk_region_destroy(RRGN); Result := HRGN(GObject); - //writeln('TGtkWidgetSet.CreateRectRgn A ',GDKRegionAsString(RegionObj)); + //DebugLn('TGtkWidgetSet.CreateRectRgn A ',GDKRegionAsString(RegionObj)); end; {------------------------------------------------------------------------------ @@ -1918,7 +1918,7 @@ begin Continue := IsValidGDIObject(Dest) and IsValidGDIObject(Src1) and IsValidGDIObject(Src2); If Not Continue then begin - WriteLn('WARNING: [TGtkWidgetSet.CombineRgn] Invalid HRGN'); + DebugLn('WARNING: [TGtkWidgetSet.CombineRgn] Invalid HRGN'); Result := Error; end else begin @@ -1928,7 +1928,7 @@ begin end; S1 := S1Obj^.GDIRegionObject; S2 := S2Obj^.GDIRegionObject; - //writeln('TGtkWidgetSet.CombineRgn A fnCombineMode=',fnCombineMode); + //DebugLn('TGtkWidgetSet.CombineRgn A fnCombineMode=',fnCombineMode); Case fnCombineMode of RGN_AND : D := PGDKRegion(gdk_region_intersect(S1, S2)); @@ -1947,7 +1947,7 @@ begin end; DObj^.GDIRegionObject := D; Result := RegionType(D); - //writeln('TGtkWidgetSet.CombineRgn B Mode=',fnCombineMode, + //DebugLn('TGtkWidgetSet.CombineRgn B Mode=',fnCombineMode, // ' S1=',GDKRegionAsString(S1),' S2=',GDKRegionAsString(S2),' D=',GDKRegionAsString(D),''); end; end; @@ -2183,14 +2183,14 @@ begin end; else begin Result:= false; - writeln('[TGtkWidgetSet.DeleteObject] TODO : Unimplemented GDI type'); + DebugLn('[TGtkWidgetSet.DeleteObject] TODO : Unimplemented GDI type'); Assert(False, 'Trace:TODO : Unimplemented GDI object in delete object'); end; end; end; { Dispose of the GDI object } - //writeln('[TGtkWidgetSet.DeleteObject] ',Result,' ',HexStr(GDIObject,8),' ',FGDIObjects.Count); + //DebugLn('[TGtkWidgetSet.DeleteObject] ',Result,' ',HexStr(GDIObject,8),' ',FGDIObjects.Count); DisposeGDIObject(PGDIObject(GDIObject)); end; @@ -2441,11 +2441,11 @@ begin DrawCheck; end; else - WriteLn(Format('ERROR: [TGtkWidgetSet.DrawFrameControl] Unknown State 0x%x', [uState])); + DebugLn(Format('ERROR: [TGtkWidgetSet.DrawFrameControl] Unknown State 0x%x', [uState])); end; end; else - WriteLn(Format('ERROR: [TGtkWidgetSet.DrawFrameControl] Unknown type %d', [uType])); + DebugLn(Format('ERROR: [TGtkWidgetSet.DrawFrameControl] Unknown type %d', [uType])); end; end; @@ -2492,7 +2492,7 @@ Var R: TRect; DCOrigin: TPoint; begin - //writeln('TGtkWidgetSet.DrawEdge Edge=',HexStr(Cardinal(Edge),8),' grfFlags=',HexStr(Cardinal(grfFlags),8)); + //DebugLn('TGtkWidgetSet.DrawEdge Edge=',HexStr(Cardinal(Edge),8),' grfFlags=',HexStr(Cardinal(grfFlags),8)); Result := IsValidDC(DC); if Result then with TDeviceContext(DC) do @@ -2744,7 +2744,7 @@ begin begin if GC = nil then begin - WriteLn('WARNING: [TGtkWidgetSet.DrawText] Uninitialized GC'); + DebugLn('WARNING: [TGtkWidgetSet.DrawText] Uninitialized GC'); Result := 0; end else begin @@ -2877,7 +2877,7 @@ begin // copy gdk_window_get_size(DCDrawable,@Width,@Height); {$IFDEF VerboseDoubleBuffer} - writeln('TGtkWidgetSet.EndPaint Copying from buffer to window: ',Width,' ',Height); + DebugLn('TGtkWidgetSet.EndPaint Copying from buffer to window: ',Width,' ',Height); {$ENDIF} gdk_gc_set_clip_region(DevContext.GC, nil); gdk_gc_set_clip_rectangle(DevContext.GC, nil); @@ -2892,7 +2892,7 @@ begin if (LCLObject is TPanel) and (csDesigning in TPanel(LCLObject).ComponentState) then begin gdk_window_get_origin(Widget^.Window,@x,@y); - writeln('TGtkWidgetSet.EndPaint ',TPanel(LCLObject).Name,':',TPanel(LCLObject).ClassName, + DebugLn('TGtkWidgetSet.EndPaint ',TPanel(LCLObject).Name,':',TPanel(LCLObject).ClassName, ' Widget=',GetWidgetClassName(Widget), ' Origin=',x,',',y, ' ',Widget^.allocation.x,',',Widget^.allocation.y); @@ -2927,7 +2927,7 @@ begin begin if GC = nil then begin - WriteLn('WARNING: [TGtkWidgetSet.Ellipse] Uninitialized GC'); + DebugLn('WARNING: [TGtkWidgetSet.Ellipse] Uninitialized GC'); Result := False; end else begin @@ -2999,7 +2999,7 @@ begin begin if GC = nil then begin - WriteLn('WARNING: [TGtkWidgetSet.ExcludeClipRect] Uninitialized GC'); + DebugLn('WARNING: [TGtkWidgetSet.ExcludeClipRect] Uninitialized GC'); Result := ERROR; end else @@ -3049,11 +3049,11 @@ begin begin if GC = nil then begin - WriteLn('WARNING: [TGtkWidgetSet.ExtSelectClipRGN] Uninitialized GC'); + DebugLn('WARNING: [TGtkWidgetSet.ExtSelectClipRGN] Uninitialized GC'); Result := ERROR; end else begin - //writeln('TGtkWidgetSet.ExtSelectClipRGN A ClipRegValid=',DCClipRegionValid(DC), + //DebugLn('TGtkWidgetSet.ExtSelectClipRGN A ClipRegValid=',DCClipRegionValid(DC), // ' Mode=',Mode,' RGN=',GDKRegionAsString(PGdiObject(RGN)^.GDIRegionObject)); If ClipRegion=0 then begin // there is no clipping region in the DC @@ -3098,7 +3098,7 @@ function TGtkWidgetSet.ExtTextOut(DC: HDC; X, Y: Integer; Options: Longint; Rect: PRect; Str: PChar; Count: Longint; Dx: PInteger): Boolean; {$Ifdef GTK2} begin - writeln('ToDo: TGtkWidgetSet.ExtTextOut'); + DebugLn('ToDo: TGtkWidgetSet.ExtTextOut'); Result:=false; end; {$Else} @@ -3166,12 +3166,12 @@ begin begin if GC = nil then begin - WriteLn('WARNING: [TGtkWidgetSet.ExtTextOut] Uninitialized GC'); + DebugLn('WARNING: [TGtkWidgetSet.ExtTextOut] Uninitialized GC'); Result := False; end else if ((Options and (ETO_OPAQUE+ETO_CLIPPED)) <> 0) and (Rect=nil) then begin - WriteLn('WARNING: [TGtkWidgetSet.ExtTextOut] Rect=nil'); + DebugLn('WARNING: [TGtkWidgetSet.ExtTextOut] Rect=nil'); Result := False; end else begin // TODO: implement other parameters. @@ -3202,7 +3202,7 @@ begin Rect^.Right, Rect^.Bottom); end; end else begin - WriteLn('WARNING: [TGtkWidgetSet.ExtTextOut] Missing Font'); + DebugLn('WARNING: [TGtkWidgetSet.ExtTextOut] Missing Font'); Result := False; end; end; @@ -3304,7 +3304,7 @@ begin begin if GC = nil then begin - WriteLn('WARNING: [TGtkWidgetSet.FillRect] Uninitialized GC'); + DebugLn('WARNING: [TGtkWidgetSet.FillRect] Uninitialized GC'); Result := False; exit; end; @@ -3319,7 +3319,7 @@ begin CurrentBrush := PGdiObject(Brush); SelectedColors:=dcscCustom; end; - //writeln('TGtkWidgetSet.FillRect Color=',HexStr(Cardinal(CurrentBrush^.GDIBrushColor.ColorRef),8)); + //DebugLn('TGtkWidgetSet.FillRect Color=',HexStr(Cardinal(CurrentBrush^.GDIBrushColor.ColorRef),8)); SelectGDKBrushProps(DC); @@ -3405,7 +3405,7 @@ begin if not Result then exit; if FrameWidth=0 then exit; TheStyle:=GetStyle(lgsButton); - //writeln('TGtkWidgetSet.Frame3d A ',HexStr(Cardinal(TheStyle),8)); + //DebugLn('TGtkWidgetSet.Frame3d A ',HexStr(Cardinal(TheStyle),8)); if TheStyle=nil then exit; with TDeviceContext(DC) do @@ -3447,7 +3447,7 @@ begin ShadowType:=GTKThinShadowType[Style] else ShadowType:=GTKStrongShadowType[Style]; - //writeln('ShadowType ',ShadowType, + //DebugLn('ShadowType ',ShadowType, //' dark_gc=',HexStr(Cardinal(TheStyle^.dark_gc[GTK_STATE_NORMAL]),8), //' light_gc=',HexStr(Cardinal(TheStyle^.light_gc[GTK_STATE_NORMAL]),8), //''); @@ -3469,7 +3469,7 @@ begin gdk_draw_line(Drawable, RightBottomGC, ARect.Left+DCOrigin.X, ARect.Bottom+DCOrigin.Y, ARect.Right+DCOrigin.X, ARect.Bottom+DCOrigin.Y);} - //writeln('TGtkWidgetSet.Frame3d A TheStyle=',HexStr(Cardinal(TheStyle),8), + //DebugLn('TGtkWidgetSet.Frame3d A TheStyle=',HexStr(Cardinal(TheStyle),8), // ' Drawable=',GetDrawableDebugReport(Drawable), // ' ClientWidget=',GetWidgetDebugReport(ClientWidget) // ); @@ -3572,11 +3572,11 @@ begin Result := InternalGetDIBits(DC, Bitmap, StartScan, NumScans, -1, Bits, BitInfo, Usage, True); else - writeln('WARNING: [TGtkWidgetSet.GetDIBits] not a Bitmap!'); + DebugLn('WARNING: [TGtkWidgetSet.GetDIBits] not a Bitmap!'); end; end else - writeln('WARNING: [TGtkWidgetSet.GetDIBits] invalid Bitmap!'); + DebugLn('WARNING: [TGtkWidgetSet.GetDIBits] invalid Bitmap!'); end; {------------------------------------------------------------------------------ @@ -3597,11 +3597,11 @@ begin gdiBitmap: Result := InternalGetDIBits(0, Bitmap, 0, 0, Count, Bits, BitInfo, 0, False); else - writeln('WARNING: [TGtkWidgetSet.GetBitmapBits] not a Bitmap!'); + DebugLn('WARNING: [TGtkWidgetSet.GetBitmapBits] not a Bitmap!'); end; end else - writeln('WARNING: [TGtkWidgetSet.GetBitmapBits] invalid Bitmap!'); + DebugLn('WARNING: [TGtkWidgetSet.GetBitmapBits] invalid Bitmap!'); end; {------------------------------------------------------------------------------ @@ -3619,7 +3619,7 @@ var begin Result:=false; if not IsValidGDIObject(Bitmap) then begin - writeln('WARNING: [TGtkWidgetSet.GetBitmapRawImageDescription] invalid Bitmap!'); + DebugLn('WARNING: [TGtkWidgetSet.GetBitmapRawImageDescription] invalid Bitmap!'); exit; end; GDIObject:=PGDIObject(Bitmap); @@ -3628,7 +3628,7 @@ begin gbPixmap: GdkPixmap:=PGdkPixmap(PGdiObject(Bitmap)^.GDIPixmapObject); else GdkPixmap:=nil; - writeln('WARNING: [TGtkWidgetSet.GetBitmapRawImageDescription] GDI_RGBImage not implemented'); + DebugLn('WARNING: [TGtkWidgetSet.GetBitmapRawImageDescription] GDI_RGBImage not implemented'); exit; end; Result:=GetWindowRawImageDescription(PGdkWindow(GdkPixmap),Desc); @@ -3689,7 +3689,7 @@ begin Result := False; end; end - else WriteLn('[TGtkWidgetSet.GetCaretPos] got focusObject nil'); + else DebugLn('[TGtkWidgetSet.GetCaretPos] got focusObject nil'); } Assert(False, 'Trace:GetCaretPos'); @@ -3840,13 +3840,13 @@ begin end; {$IfDef VerboseGetClientRect} if ClientWidget<>nil then begin - writeln('GetClientRect Widget=',HexStr(Cardinal(handle),8), + DebugLn('GetClientRect Widget=',HexStr(Cardinal(handle),8), ' Client=',HexStr(Cardinal(ClientWidget),8), ' WindowSize=',ARect.Right,',',ARect.Bottom, ' Allocation=',ClientWidget^.Allocation.Width,',',ClientWidget^.Allocation.Height ); end else begin - writeln('GetClientRect Widget=',HexStr(Cardinal(handle),8), + DebugLn('GetClientRect Widget=',HexStr(Cardinal(handle),8), ' Client=',HexStr(Cardinal(ClientWidget),8), ' WindowSize=',ARect.Right,',',ARect.Bottom, ' Allocation=',Widget^.Allocation.Width,',',Widget^.Allocation.Height @@ -3972,7 +3972,7 @@ Function TGtkWidgetSet.GetClipRGN(DC : hDC; RGN : hRGN) : longint; if GdiObject^.GDIRegionObject<>nil then gdk_region_destroy(GdiObject^.GDIRegionObject); GdiObject^.GDIRegionObject:=CreateRectGDKRegion(ARect); - //writeln('TGtkWidgetSet.GetClipRGN A DC=',HexStr(Cardinal(DC),8), + //DebugLn('TGtkWidgetSet.GetClipRGN A DC=',HexStr(Cardinal(DC),8), // ' RGN=',GDKRegionAsString(PGdiObject(RGN)^.GDIRegionObject), // ' Result=',Result); end; @@ -3986,7 +3986,7 @@ begin Result := ERROR else If Not IsValidGDIObject(RGN) then begin Result := ERROR; - WriteLn('WARNING: [TGtkWidgetSet.GetClipRGN] Invalid HRGN'); + DebugLn('WARNING: [TGtkWidgetSet.GetClipRGN] Invalid HRGN'); end else if TDeviceContext(DC).ClipRegion=0 then Result:=GetDefaultClipRgn @@ -4008,7 +4008,7 @@ begin PGdiObject(RGN)^.GDIRegionObject := ClipRegionWithDCOffset; Result := RegionType(ClipRegionWithDCOffset); - //writeln('TGtkWidgetSet.GetClipRGN B DC=',HexStr(Cardinal(DC),8), + //DebugLn('TGtkWidgetSet.GetClipRGN B DC=',HexStr(Cardinal(DC),8), // ' DCOrigin=',DCOrigin.X,',',DCOrigin.Y,' RGN=',GDKRegionAsString(ClipRegionWithDCOffset),' Result=',Result); If Result = NULLREGION then Result := 0 @@ -4059,7 +4059,7 @@ function TGtkWidgetSet.GetCursorPos(var lpPoint: TPoint ): Boolean; {$IFDEF GTK2} begin // TODO: GTK2 GetCursorPos - writeln('TGtkWidgetSet.GetCursorPos ToDo'); + DebugLn('TGtkWidgetSet.GetCursorPos ToDo'); Result:=false; end; {$ELSE} @@ -4207,7 +4207,7 @@ begin Result:=0; else - writeln('TGtkWidgetSet.GetDeviceCaps not supported: Type=',Index); + DebugLn('TGtkWidgetSet.GetDeviceCaps not supported: Type=',dbgs(Index)); end; end; @@ -4246,7 +4246,7 @@ begin {$IFDEF RaiseExceptionOnNilPointers} RaiseException('TGtkWidgetSet.GetDeviceSize Window=nil'); {$ENDIF} - writeln('TGtkWidgetSet.GetDeviceSize:', + DebugLn('TGtkWidgetSet.GetDeviceSize:', ' WARNING: DC ',HexStr(Cardinal(DC),8),' without gdkwindow.', ' Widget=',HexStr(Cardinal(wnd),8)); end; @@ -4272,7 +4272,7 @@ function TGtkWidgetSet.GetDCOriginRelativeToWindow(PaintDC: HDC; {$IFDEF RaiseExceptionOnNilPointers} RaiseException('TGtkWidgetSet.GetDCOriginRelativeToWindow Window=nil'); {$ENDIF} - writeln('TGtkWidgetSet.GetDCOriginRelativeToWindow:', + DebugLn('TGtkWidgetSet.GetDCOriginRelativeToWindow:', ' WARNING: PaintDC ',HexStr(Cardinal(PaintDC),8),' without gdkwindow.', ' Widget=',HexStr(Cardinal(TDeviceContext(PaintDC).wnd),8)); end; @@ -4318,7 +4318,7 @@ end; ------------------------------------------------------------------------------} function TGtkWidgetSet.GetDesignerDC(WindowHandle: HWND): HDC; begin - //writeln('TGtkWidgetSet.GetDesignerDC A'); + //DebugLn('TGtkWidgetSet.GetDesignerDC A'); Result:=CreateDCForWidget(PGtkWidget(WindowHandle),nil,true); end; @@ -4632,7 +4632,7 @@ begin Assert(False, 'Trace:TODO: [TGtkWidgetSet.GetObject] gdiRegion'); end; else - WriteLn(Format('WARNING: [TGtkWidgetSet.GetObject] Unknown type %d', [Integer(PGDIObject(GDIObj)^.GDIType)])); + DebugLn(Format('WARNING: [TGtkWidgetSet.GetObject] Unknown type %d', [Integer(PGDIObject(GDIObj)^.GDIType)])); end; end; end; @@ -4645,7 +4645,7 @@ end; ------------------------------------------------------------------------------} Function TGtkWidgetSet.GetParent(Handle : HWND): HWND; begin - //writeln('TGtkWidgetSet.GetParent ',HexStr(Cardinal(Handle),8)); + //DebugLn('TGtkWidgetSet.GetParent ',HexStr(Cardinal(Handle),8)); Result:=0; if Handle<>0 then Result:=HWnd(PGtkWidget(Handle)^.Parent); @@ -4677,13 +4677,13 @@ var begin Result:=false; if not IsValidDC(SrcDC) then begin - writeln('WARNING: TGtkWidgetSet.GetRawImageFromDevice invalid SrcDC'); + DebugLn('WARNING: TGtkWidgetSet.GetRawImageFromDevice invalid SrcDC'); exit; end; DCOrigin:=GetDCOffset(TDeviceContext(SrcDC)); {$IFDEF VerboseRawImage} - writeln('TGtkWidgetSet.GetRawImageFromDevice A DCOrigin=',DCOrigin.X,',',DCOrigin.Y,' SrcRect=',SrcRect.Left,',',SrcRect.Top,',',SrcRect.Right,',',SrcRect.Bottom); + DebugLn('TGtkWidgetSet.GetRawImageFromDevice A DCOrigin=',DCOrigin.X,',',DCOrigin.Y,' SrcRect=',SrcRect.Left,',',SrcRect.Top,',',SrcRect.Right,',',SrcRect.Bottom); {$ENDIF} ARect:=SrcRect; OffSetRect(ARect,DCOrigin.x,DCOrigin.y); @@ -4706,16 +4706,16 @@ var begin Result:=false; {$IFDEF VerboseRawImage} - writeln('TGtkWidgetSet.GetRawImageFromBitmap A'); + DebugLn('TGtkWidgetSet.GetRawImageFromBitmap A'); {$ENDIF} FillChar(NewRawImage,SizeOf(NewRawImage),0); if (not IsValidGDIObject(SrcBitmap)) then begin - writeln('WARNING: [TGtkWidgetSet.GetRawImageFromBitmap] invalid SrcBitmap!'); + DebugLn('WARNING: [TGtkWidgetSet.GetRawImageFromBitmap] invalid SrcBitmap!'); exit; end; if ((SrcMaskBitmap<>0) and not IsValidGDIObject(SrcMaskBitmap)) then begin - writeln('WARNING: [TGtkWidgetSet.GetRawImageFromBitmap] invalid MaskBitmap!'); + DebugLn('WARNING: [TGtkWidgetSet.GetRawImageFromBitmap] invalid MaskBitmap!'); exit; end; @@ -4727,11 +4727,11 @@ begin gbBitmap: GdkPixmap:=PGdkPixmap(GDIImg^.GDIBitmapObject); gbPixmap: GdkPixmap:=PGdkPixmap(GDIImg^.GDIPixmapObject); else - writeln('WARNING: [TGtkWidgetSet.GetRawImageFromBitmap] GDI_RGBImage not implemented'); + DebugLn('WARNING: [TGtkWidgetSet.GetRawImageFromBitmap] GDI_RGBImage not implemented'); exit; end; {$IFDEF VerboseRawImage} - writeln('TGtkWidgetSet.GetRawImageFromBitmap A GdkPixmap=',HexStr(Cardinal(GdkPixmap),8),' SrcMaskBitmap=',HexStr(Cardinal(SrcMaskBitmap),8)); + DebugLn('TGtkWidgetSet.GetRawImageFromBitmap A GdkPixmap=',HexStr(Cardinal(GdkPixmap),8),' SrcMaskBitmap=',HexStr(Cardinal(SrcMaskBitmap),8)); {$ENDIF} GDIMaskImg:=nil; @@ -4742,7 +4742,7 @@ begin case GDIMaskImg^.GDIBitmapType of gbBitmap: GdkMaskBitmap:=GDIMaskImg^.GDIBitmapObject; else - writeln('WARNING: [TGtkWidgetSet.GetRawImageFromBitmap] invalid MaskBitmap'); + DebugLn('WARNING: [TGtkWidgetSet.GetRawImageFromBitmap] invalid MaskBitmap'); exit; end; end else if GDIImg^.GDIBitmapMaskObject<>nil then begin @@ -4755,7 +4755,7 @@ begin if not GetRawImageFromGdkWindow(PGdkWindow(GdkPixmap),GdkMaskBitmap,SrcRect, NewRawImage) then begin - writeln('WARNING: [TGtkWidgetSet.GetRawImageFromBitmap] unable to GetRawImageFromGdkWindow Image'); + DebugLn('WARNING: [TGtkWidgetSet.GetRawImageFromBitmap] unable to GetRawImageFromGdkWindow Image'); exit; end; @@ -5011,7 +5011,7 @@ begin then begin Result := 0; //RaiseException(''); - WriteLn(Format('ERROR: [TGtkWidgetSet.GetSysColor] Bad Value: %8x Valid Range between 0 and %d', [nIndex, MAX_SYS_COLORS])); + DebugLn(Format('ERROR: [TGtkWidgetSet.GetSysColor] Bad Value: %8x Valid Range between 0 and %d', [nIndex, MAX_SYS_COLORS])); end else Result := SysColorMap[nIndex]; //Assert(False, Format('Trace:[TGtkWidgetSet.GetSysColor] Index %d --> %8x', [nIndex, Result])); @@ -5343,7 +5343,7 @@ function TGtkWidgetSet.GetTextExtentPoint(DC: HDC; Str: PChar; Count: Integer; var Size: TSize): Boolean; {$IfDef GTK2} begin - writeln('TGtkWidgetSet.GetTextExtentPoint ToDo'); + DebugLn('TGtkWidgetSet.GetTextExtentPoint ToDo'); Result:=false; end; {$Else} @@ -5366,7 +5366,7 @@ begin UnRef := False; end; If UseFont = nil then - WriteLn('WARNING: [TGtkWidgetSet.GetTextExtentPoint] Missing font') + DebugLn('WARNING: [TGtkWidgetSet.GetTextExtentPoint] Missing font') else begin gdk_text_extents(UseFont, Str, Count, @lbearing, @rBearing, @width, @ascent, @descent); @@ -5503,7 +5503,7 @@ var Widget: PGTKWidget; Window: PGdkWindow; begin - //Writeln('GetWindowRect'); + //DebugLn('GetWindowRect'); Result := 0; //default if Handle <> 0 then begin @@ -5749,7 +5749,7 @@ var GTKObject: PGTKObject; WasVisible: boolean; begin -//writeln('[TGtkWidgetSet.HideCaret] A'); +//DebugLn('[TGtkWidgetSet.HideCaret] A'); Assert(False, Format('Trace: [TGtkWidgetSet.HideCaret] HWND: 0x%x', [hWnd])); //TODO: [TGtkWidgetSet.HideCaret] Finish (in gtkwinapi.inc) @@ -5767,7 +5767,7 @@ begin Result := False; end; end - else WriteLn('WARNING: [TGtkWidgetSet.HideCaret] Got null HWND'); + else DebugLn('WARNING: [TGtkWidgetSet.HideCaret] Got null HWND'); end; @@ -5797,7 +5797,7 @@ begin begin if GC = nil then begin - WriteLn('WARNING: [TGtkWidgetSet.IntersectClipRect] Uninitialized GC'); + DebugLn('WARNING: [TGtkWidgetSet.IntersectClipRect] Uninitialized GC'); Result := ERROR; end else begin @@ -5821,12 +5821,12 @@ var Widget, PaintWidget: PGtkWidget; LCLObject: TObject; begin - // Writeln(format('Rect = %d,%d,%d,%d',[rect^.left,rect^.top,rect^.Right,rect^.Bottom])); + // DebugLn(format('Rect = %d,%d,%d,%d',[rect^.left,rect^.top,rect^.Right,rect^.Bottom])); Widget:=PGtkWidget(aHandle); LCLObject:=GetLCLObject(Widget); if (LCLObject<>nil) then begin if (LCLObject=CurrentSentPaintMessageTarget) then begin - writeln('NOTE: TGtkWidgetSet.InvalidateRect during paint message: ', + DebugLn('NOTE: TGtkWidgetSet.InvalidateRect during paint message: ', LCLObject.ClassName); //RaiseException('Double paint'); end; @@ -5838,7 +5838,7 @@ begin write(LCLObject.ClassName); with Rect^ do write(' Rect=',Left,',',Top,',',Right,',',Bottom); - writeln(' Erase=',bErase); + DebugLn(' Erase=',bErase); end; {$ENDIF} end; @@ -5910,7 +5910,7 @@ begin end else Result := False; end else begin - WriteLn('WARNING: [TGtkWidgetSet.LineTo] Uninitialized GC'); + DebugLn('WARNING: [TGtkWidgetSet.LineTo] Uninitialized GC'); Result := False; end; end; @@ -5929,7 +5929,7 @@ end; function MessageButtonClicked(Widget : PGtkWidget; data: gPointer) : GBoolean; cdecl; begin -writeln('[MessageButtonClicked] ',Integer(data^),' ',Integer(gtk_object_get_data(PGtkObject(Widget), 'modal_result'))); +DebugLn('[MessageButtonClicked] ',dbgs(data),' ',dbgs(gtk_object_get_data(PGtkObject(Widget), 'modal_result'))); if Integer(data^) = 0 then Integer(data^):= Integer(gtk_object_get_data(PGtkObject(Widget), 'modal_result')); Result:=false; @@ -5944,7 +5944,7 @@ begin { Don't allow to close if we don't have a default return value } Result:= (ModalResult = 0); if not Result then Integer(data^):= ModalResult - else WriteLn('Do not close !!!'); + else DebugLn('Do not close !!!'); end else Result:= false; end; @@ -6067,7 +6067,7 @@ begin Result:=IsValidDC(DC); if Result then with TDeviceContext(DC) do begin - //writeln('[TGtkWidgetSet.MoveWindowOrgEx] B DC=',HexStr(Cardinal(DC),8), + //DebugLn('[TGtkWidgetSet.MoveWindowOrgEx] B DC=',HexStr(Cardinal(DC),8), // ' Old=',Origin.X,',',Origin.Y,' d=',dX,',',dY,' '); inc(Origin.X,dX); inc(Origin.Y,dY); @@ -6106,7 +6106,7 @@ function TGtkWidgetSet.PairSplitterRemoveSide(SplitterHandle, SideHandle: hWnd; Side: integer): Boolean; begin Result:=false; - writeln('WARNING: TGtkWidgetSet.PairSplitterRemoveSide not implemented'); + DebugLn('WARNING: TGtkWidgetSet.PairSplitterRemoveSide not implemented'); end; {------------------------------------------------------------------------------ @@ -6143,7 +6143,7 @@ var vlItem : TGtkMessageQueueItem; begin //TODO Filtering - writeln('Peek !!!' ); + DebugLn('Peek !!!' ); vlItem := fMessageQueue.FirstMessageItem; Result := vlItem <> nil; @@ -6181,7 +6181,7 @@ Begin begin if GC = nil then begin - WriteLn('WARNING: [TGtkWidgetSet.PolyBezier] Uninitialized GC'); + DebugLn('WARNING: [TGtkWidgetSet.PolyBezier] Uninitialized GC'); Result := False; end else @@ -6224,7 +6224,7 @@ begin if NumPts<=0 then exit; if GC = nil then begin - WriteLn('WARNING: [TGtkWidgetSet.Polygon] Uninitialized GC'); + DebugLn('WARNING: [TGtkWidgetSet.Polygon] Uninitialized GC'); Result := False; end else begin @@ -6304,7 +6304,7 @@ begin begin if GC = nil then begin - WriteLn('WARNING: [TGtkWidgetSet.Polyline] Uninitialized GC'); + DebugLn('WARNING: [TGtkWidgetSet.Polyline] Uninitialized GC'); Result := False; end else begin @@ -6459,7 +6459,7 @@ Begin begin if GC = nil then begin - WriteLn('WARNING: [TGtkWidgetSet.RadialArc] Uninitialized GC'); + DebugLn('WARNING: [TGtkWidgetSet.RadialArc] Uninitialized GC'); Result := False; end else @@ -6485,7 +6485,7 @@ begin begin if GC = nil then begin - WriteLn('WARNING: [TGtkWidgetSet.RadialChord] Uninitialized GC'); + DebugLn('WARNING: [TGtkWidgetSet.RadialChord] Uninitialized GC'); Result := False; end else @@ -6511,7 +6511,7 @@ begin begin if GC = nil then begin - WriteLn('WARNING: [TGtkWidgetSet.RadialPie] Uninitialized GC'); + DebugLn('WARNING: [TGtkWidgetSet.RadialPie] Uninitialized GC'); Result := False; end else @@ -6576,7 +6576,7 @@ begin begin if GC = nil then begin - WriteLn('WARNING: [TGtkWidgetSet.Rectangle] Uninitialized GC'); + DebugLn('WARNING: [TGtkWidgetSet.Rectangle] Uninitialized GC'); Result := False; end else begin @@ -6692,7 +6692,7 @@ begin if not gtk_is_radio_menu_item(Pointer(hndMenu)) then begin - writeln('WARNING: TGtkWidgetSet.RegroupMenuItem: handle is not a GTK_RADIO_MENU_ITEM'); + DebugLn('WARNING: TGtkWidgetSet.RegroupMenuItem: handle is not a GTK_RADIO_MENU_ITEM'); Exit; end; @@ -6755,7 +6755,7 @@ end; then begin Result:=gtk_radio_menu_item_group( GTK_RADIO_MENU_ITEM(ParentMenuItem[i].Handle)); - //writeln('TGtkWidgetSet.RegroupMenuItem.GetGroup A i=',i,' ',ParentMenuItem[i].Name,' GrpIndex=',ParentMenuItem[i].GroupIndex,' LastRadioItem=',LastRadioItem,' Result=',HexStr(Cardinal(Result),8)); + //DebugLn('TGtkWidgetSet.RegroupMenuItem.GetGroup A i=',i,' ',ParentMenuItem[i].Name,' GrpIndex=',ParentMenuItem[i].GroupIndex,' LastRadioItem=',LastRadioItem,' Result=',HexStr(Cardinal(Result),8)); exit; end; end; @@ -6774,7 +6774,7 @@ begin if AMenuItem=nil then exit; ParentMenuItem:=AMenuItem.Parent; if ParentMenuItem=nil then exit; - //writeln('TGtkWidgetSet.RegroupMenuItem A ',AMenuItem.Name,' ',ParentMenuItem.Name,' GroupIndex=',AMenuItem.GroupIndex); + //DebugLn('TGtkWidgetSet.RegroupMenuItem A ',AMenuItem.Name,' ',ParentMenuItem.Name,' GroupIndex=',AMenuItem.GroupIndex); LastRadioGroupStart:=-1; for i:=0 to ParentMenuItem.Count-1 do begin if ParentMenuItem[i].RadioItem @@ -6782,7 +6782,7 @@ begin and GtkWidgetIsA(Pointer(ParentMenuItem[i].Handle), GTK_RADIO_MENU_ITEM_TYPE) then begin - //writeln('TGtkWidgetSet.RegroupMenuItem B i=',i,' ',ParentMenuItem[i].Name, + //DebugLn('TGtkWidgetSet.RegroupMenuItem B i=',i,' ',ParentMenuItem[i].Name, //' GrpIndex=',ParentMenuItem[i].GroupIndex, //' LastRadioGroupStart=',LastRadioGroupStart, //' LastGroup=',HexStr(Cardinal(gtk_radio_menu_item_group( @@ -6815,7 +6815,7 @@ begin UpdateRadioGroupChecks(RadioGroup); Result:=true; end else begin - writeln('WARNING: TGtkWidgetSet.RegroupMenuItem: handle is not a GTK_RADIO_MENU_ITEM'); + DebugLn('WARNING: TGtkWidgetSet.RegroupMenuItem: handle is not a GTK_RADIO_MENU_ITEM'); Result:=false; end; end; @@ -6846,7 +6846,7 @@ function TGtkWidgetSet.ReleaseDC(hWnd: HWND; DC: HDC): Integer; var aDC, pSavedDC: TDeviceContext; begin -//writeln('[TGtkWidgetSet.ReleaseDC] ',HexStr(DC,8),' ',FDeviceContexts.Count); +//DebugLn('[TGtkWidgetSet.ReleaseDC] ',HexStr(DC,8),' ',FDeviceContexts.Count); Assert(False, Format('trace:> [TGtkWidgetSet.ReleaseDC] DC:0x%x', [DC])); Result := 0; @@ -6902,7 +6902,7 @@ begin on E:Exception do begin //Nothing, just try to unref it //(it segfaults if the window doesnt exist anymore :-) - writeln('TGtkWidgetSet.ReleaseDC: ',E.Message); + DebugLn('TGtkWidgetSet.ReleaseDC: ',E.Message); end; end; @@ -6959,7 +6959,7 @@ begin pSavedDC.SavedContext := nil; if ClipRegionChanged then SelectGDIRegion(HDC(aDC)); - //writeln('TGtkWidgetSet.RestoreDC A ',GDKRegionAsString(PGdiObject(aDC.ClipRegion)^.GDIRegionObject)); + //DebugLn('TGtkWidgetSet.RestoreDC A ',GDKRegionAsString(PGdiObject(aDC.ClipRegion)^.GDIRegionObject)); // free saved DC @@ -7027,7 +7027,7 @@ begin begin if GC = nil then begin - WriteLn('WARNING: [TGtkWidgetSet.RoundRect] Uninitialized GC'); + DebugLn('WARNING: [TGtkWidgetSet.RoundRect] Uninitialized GC'); Result := False; end else @@ -7107,7 +7107,7 @@ Begin end; end; - //writeln('[TGtkWidgetSet.ScreenToClient] ',x,',',y,' P=',P.X,',',P.Y); + //DebugLn('[TGtkWidgetSet.ScreenToClient] ',x,',',y,' P=',P.X,',',P.Y); dec(P.X, X); dec(P.Y, Y); Result := -1; @@ -7161,7 +7161,7 @@ begin begin if (GC = nil) and (RGN <> 0) then begin - WriteLn('WARNING: [TGtkWidgetSet.SelectClipRGN] Uninitialized GC'); + DebugLn('WARNING: [TGtkWidgetSet.SelectClipRGN] Uninitialized GC'); Result := ERROR; end else begin @@ -7182,12 +7182,12 @@ begin DCOrigin:=GetDCOffset(TDeviceContext(DC)); gdk_region_offset(RegObj,DCOrigin.x,DCOrigin.Y); Result := RegionType(RegObj); - //writeln('TGtkWidgetSet.SelectClipRGN RGN=',GDKRegionAsString(RegObj),' DCOrigin=',DCOrigin.X,',',DCOrigin.Y); + //DebugLn('TGtkWidgetSet.SelectClipRGN RGN=',GDKRegionAsString(RegObj),' DCOrigin=',DCOrigin.X,',',DCOrigin.Y); SelectGDIRegion(DC); end else begin Result := ERROR; - WriteLn('WARNING: [TGtkWidgetSet.SelectClipRGN] Invalid RGN'); + DebugLn('WARNING: [TGtkWidgetSet.SelectClipRGN] Invalid RGN'); end; end; end; @@ -7211,15 +7211,15 @@ begin Result := 0; {if not IsValidDC(DC) then begin - writeln('TGtkWidgetSet.SelectObject invalid DC ',HexStr(Cardinal(DC),8)); + DebugLn('TGtkWidgetSet.SelectObject invalid DC ',HexStr(Cardinal(DC),8)); end; if not IsValidGDIObject(GDIObj) then begin - writeln('TGtkWidgetSet.SelectObject invalid GDIObj ',HexStr(Cardinal(GDIObj),8)); + DebugLn('TGtkWidgetSet.SelectObject invalid GDIObj ',HexStr(Cardinal(GDIObj),8)); end;} if IsValidDC(DC) and IsValidGDIObject(GDIObj) then begin - //writeln('TGtkWidgetSet.SelectObject DC=',HexStr(Cardinal(DC),8),' GDIObj=',HexStr(Cardinal(GDIObj),8),' GDIType=',ord(PGdiObject(GDIObj)^.GDIType),' ',ord(gdiBitmap),' ',ord(gdiRegion)); + //DebugLn('TGtkWidgetSet.SelectObject DC=',HexStr(Cardinal(DC),8),' GDIObj=',HexStr(Cardinal(GDIObj),8),' GDIType=',ord(PGdiObject(GDIObj)^.GDIType),' ',ord(gdiBitmap),' ',ord(gdiRegion)); case PGdiObject(GDIObj)^.GDIType of gdiBitmap: @@ -7240,7 +7240,7 @@ begin else Drawable := nil; end; - //writeln('TGtkWidgetSet.SelectObject DC=',HexStr(Cardinal(DC),8),' GDIBitmap=',HexStr(Cardinal(CurrentBitmap),8), + //DebugLn('TGtkWidgetSet.SelectObject DC=',HexStr(Cardinal(DC),8),' GDIBitmap=',HexStr(Cardinal(CurrentBitmap),8), //' GDIBitmapType=',ord(CurrentBitmap^.GDIBitmapType),' Drawable=',HexStr(Cardinal(Drawable),8)); GC := gdk_gc_new(Drawable); @@ -7307,7 +7307,7 @@ begin RaiseInvalidGDIType; end; end; -//writeln('[TGtkWidgetSet.SelectObject] GDI=',HexStr(Cardinal(GDIObj),8) +//DebugLn('[TGtkWidgetSet.SelectObject] GDI=',HexStr(Cardinal(GDIObj),8) // ,' Old=',Hexstr(Cardinal(Result),8)); end; @@ -7362,7 +7362,7 @@ var if FindPaintMessage(ParentHandle)<>nil then begin {$IFDEF VerboseDsgnPaintMsg} if (csDesigning in TComponent(Target).ComponentState) then begin - writeln('TGtkWidgetSet.SendMessage A ', + DebugLn('TGtkWidgetSet.SendMessage A ', TComponent(Target).Name,':',Target.ClassName, ' Parent Message found: ',ParentControl.Name,':',ParentControl.ClassName ); @@ -7394,7 +7394,7 @@ var write(' GtkPaintData=nil'); end; end; - writeln(''); + DebugLn(''); end; {$ENDIF} if AMessage.Msg=LM_GtkPAINT then begin @@ -7571,7 +7571,7 @@ begin if NewWidth [TGtkWidgetSet.SetCapture] 0x%x', [Value])); Widget:=PGtkWidget(Value); {$IfDef VerboseMouseCapture} - writeln('TGtkWidgetSet.SetCapture NewValue=[',GetWidgetDebugReport(Widget),']'); + DebugLn('TGtkWidgetSet.SetCapture NewValue=[',GetWidgetDebugReport(Widget),']'); {$EndIf} // return old capture handle @@ -7685,13 +7685,13 @@ begin if hWnd=0 then exit; Widget:=PGtkWidget(hWnd); {$IfDef VerboseFocus} - writeln(''); + DebugLn(''); write('[TGtkWidgetSet.SetFocus] A hWnd=',HexStr(Cardinal(hWnd),8)); LCLObject:=TWinControl(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} if hwnd = 0 then begin Result:=0; @@ -7708,7 +7708,7 @@ begin write(' HndVisible=',GTK_WIDGET_VISIBLE(Widget)); write(' HndRealized=',GTK_WIDGET_REALIZED(Widget)); write(' HndMapped=',GTK_WIDGET_MAPPED(Widget)); - writeln(''); write(' '); + DebugLn(''); write(' '); write(' TopLevel=',HexStr(Cardinal(TopLevel),8)); write(' OldFocus=',HexStr(Cardinal(Result),8)); AWinControl:=TWinControl(GetNearestLCLObject(PGtkWidget(Result))); @@ -7716,7 +7716,7 @@ begin write(' OldLCLParent=',AWinControl.Name,':',AWinControl.ClassName) else write(' OldLCLParent=nil'); - writeln(''); + DebugLn(''); if not GTK_WIDGET_VISIBLE(Widget) then RaiseException('TGtkWidgetSet.SetFocus: Widget is not visible'); {$EndIf} @@ -7732,13 +7732,13 @@ begin write(' LCLParent=',AWinControl.Name,':',AWinControl.ClassName) else write(' LCLParent=nil'); - writeln(''); + DebugLn(''); {$EndIf} if (NewFocusWidget=nil) and GtkWidgetIsA(Widget, gtk_combo_get_type) then begin // handle is a gtk combo {$IfDef VerboseFocus} - writeln(' D taking gtkcombo entry'); + DebugLn(' D taking gtkcombo entry'); {$EndIf} NewFocusWidget:=PgtkWidget(PGtkCombo(Widget)^.entry); end; @@ -7750,7 +7750,7 @@ begin if ImplWidget <> nil then begin // handle has a ImplementationWidget {$IfDef VerboseFocus} - writeln(' E taking ImplementationWidget'); + DebugLn(' E taking ImplementationWidget'); {$EndIf} NewFocusWidget:=ImplWidget; end; @@ -7759,7 +7759,7 @@ begin if (NewFocusWidget=nil) then begin NewFocusWidget:=Widget; {$IfDef VerboseFocus} - writeln(' F taking default '); + DebugLn(' F taking default '); {$EndIf} end; {$IfDef VerboseFocus} @@ -7769,17 +7769,17 @@ begin write(' WidMapped=',GTK_WIDGET_MAPPED(PGtkWidget(NewFocusWidget))); write(' WidCanfocus=',GTK_WIDGET_CAN_FOCUS(PGtkWidget(NewFocusWidget))); write(' TopLvlVisible=',GTK_WIDGET_VISIBLE(PGtkWidget(TopLevel))); - writeln(''); + DebugLn(''); {$EndIf} if (NewFocusWidget<>nil) and GTK_WIDGET_CAN_FOCUS(NewFocusWidget) then begin if (PGtkWindow(TopLevel)^.Focus_Widget<>NewFocusWidget) then begin {$IfDef VerboseFocus} - writeln(' H SETTING NewFocusWidget=',HexStr(Cardinal(NewFocusWidget),8)); + DebugLn(' H SETTING NewFocusWidget=',HexStr(Cardinal(NewFocusWidget),8)); {$EndIf} gtk_window_set_focus(PGtkWindow(TopLevel),NewFocusWidget); {$IfDef VerboseFocus} - writeln(' I NewTopLevel FocusWidget=',HexStr(Cardinal(PGtkWindow(TopLevel)^.Focus_Widget),8),' Success=',PGtkWindow(TopLevel)^.Focus_Widget=NewFocusWidget); + DebugLn(' I NewTopLevel FocusWidget=',HexStr(Cardinal(PGtkWindow(TopLevel)^.Focus_Widget),8),' Success=',PGtkWindow(TopLevel)^.Focus_Widget=NewFocusWidget); {$EndIf} end; end; @@ -7795,11 +7795,11 @@ begin and (fsModal in Screen.FocusedForm.FormState) and (GetNearestLCLObject(TopLevel)<>Screen.FocusedForm) then begin {$IFDEF VerboseFocus} - writeln('[TGtkWidgetSet.SetFocus] there is a modal form -> not grabbing'); + DebugLn('[TGtkWidgetSet.SetFocus] there is a modal form -> not grabbing'); {$ENDIF} end else begin {$IfDef VerboseFocus} - writeln(' J Grabbing focus'); + DebugLn(' J Grabbing focus'); {$EndIf} gtk_widget_grab_focus(NewFocusWidget); end; @@ -7814,7 +7814,7 @@ begin write(' NewLCLParent=',AWinControl.Name,':',AWinControl.ClassName) else write(' NewLCLParent=nil'); - writeln(''); + DebugLn(''); {$EndIf} end; @@ -7848,7 +7848,7 @@ begin Result := 0; if (Handle = 0) then exit; - //writeln('TGtkWidgetSet.SetScrollInfo A Widget=',GetWidgetClassName(PGtkWidget(Handle))); + //DebugLn('TGtkWidgetSet.SetScrollInfo A Widget=',GetWidgetClassName(PGtkWidget(Handle))); Adjustment := nil; Scroll := GTK_Object_Get_Data(PGTKObject(Handle), odnScrollArea); @@ -7888,7 +7888,7 @@ begin if Adjustment = nil then exit; with ScrollInfo, Adjustment^ do begin - //writeln('SetScrollInfo Value=',Value); + //DebugLn('SetScrollInfo Value=',Value); // workaround for strange floating point bug for i:=0 to 2 do begin try @@ -7896,12 +7896,12 @@ begin break; except on e: Exception do begin - writeln('TGtkWidgetSet.SetScrollInfo Workaround for ',E.Message,' try: ',i); + DebugLn('TGtkWidgetSet.SetScrollInfo Workaround for ',E.Message,' try: ',dbgs(i)); Result:=0; end; end; end; - //writeln('SetScrollInfo Result=',Result); + //DebugLn('SetScrollInfo Result=',Result); if (fMask and SIF_POS) <> 0 then Value := nPos; if (fMask and SIF_RANGE) <> 0 @@ -7915,8 +7915,8 @@ begin Page_Increment := nPage; end; - {writeln(''); - writeln('[TGtkWidgetSet.SetScrollInfo] Result=',Result, + {DebugLn(''); + DebugLn('[TGtkWidgetSet.SetScrollInfo] Result=',Result, ' Lower=',RoundToInt(Lower), ' Upper=',RoundToInt(Upper), ' Page_Size=',RoundToInt(Page_Size), @@ -7946,8 +7946,8 @@ begin else gtk_widget_hide(PGTKWidget(Scroll)) end; - {writeln(''); - writeln('TGtkWidgetSet.SetScrollInfo: ', + {DebugLn(''); + DebugLn('TGtkWidgetSet.SetScrollInfo: ', ' lower=',RoundToInt(lower),'/',nMin, ' upper=',RoundToInt(upper),'/',nMax, ' value=',RoundToInt(value),'/',nPos, @@ -8091,7 +8091,7 @@ Function TGtkWidgetSet.SetWindowOrgEx(DC : HDC; NewX, NewY : Integer; var OldP: TPoint; begin - //writeln('[TGtkWidgetSet.SetWindowOrgEx] ',NewX,' ',NewY); + //DebugLn('[TGtkWidgetSet.SetWindowOrgEx] ',NewX,' ',NewY); GetWindowOrgEx(DC,@OldP); Result := MoveWindowOrgEx(DC,NewX-OldP.X,NewY-OldP.Y); if OldPoint<>nil then @@ -8126,7 +8126,7 @@ function TGtkWidgetSet.SetWindowPos(hWnd: HWND; hWndInsertAfter: HWND; begin OldListItem:=FindFixedChildListItem(PGtkFixed(FixedWidget),Widget); if OldListItem=nil then begin - writeln('TGtkWidgetSet.SetWindowPos WARNING: Widget not on parents fixed widget'); + DebugLn('TGtkWidgetSet.SetWindowPos WARNING: Widget not on parents fixed widget'); exit; end; AfterWidget:=nil; @@ -8142,12 +8142,12 @@ function TGtkWidgetSet.SetWindowPos(hWnd: HWND; hWndInsertAfter: HWND; AfterListItem:=FindFixedChildListItem(PGtkFixed(FixedWidget),AfterWidget); end; if (AfterListItem=nil) and (AfterWidget<>nil) then begin - writeln('TGtkWidgetSet.SetWindowPos WARNING: AfterWidget not on parents fixed widget'); + DebugLn('TGtkWidgetSet.SetWindowPos WARNING: AfterWidget not on parents fixed widget'); exit; end; if (OldListItem=AfterListItem) or (OldListItem^.next=AfterListItem) then exit; - //writeln('TGtkWidgetSet.SetWindowPos Moving GList entry'); + //DebugLn('TGtkWidgetSet.SetWindowPos Moving GList entry'); // reorder // This trick does not work properly @@ -8162,7 +8162,7 @@ function TGtkWidgetSet.SetWindowPos(hWnd: HWND; hWndInsertAfter: HWND; procedure SetZOrderOnLayoutWidget(Widget, LayoutWidget: PGtkWidget); begin - //writeln('ToDO: SetZOrderOnLayoutWidget'); + //DebugLn('ToDO: SetZOrderOnLayoutWidget'); end; var @@ -8170,7 +8170,7 @@ var FixedWidget: PGtkWidget; begin Widget:=PGtkWidget(hWnd); - {writeln('[TGtkWidgetSet.SetWindowPos] ',GetWidgetDebugReport(Widget), + {DebugLn('[TGtkWidgetSet.SetWindowPos] ',GetWidgetDebugReport(Widget), ' Top=',hWndInsertAfter=HWND_TOP, ' SWP_NOZORDER=',(SWP_NOZORDER and uFlags)<>0, ' SWP_NOSIZE=',(SWP_NOSIZE and uFlags)<>0, @@ -8187,7 +8187,7 @@ begin FixedWidget:=Widget^.Parent; if FixedWidget=nil then exit; - //writeln('TGtkWidgetSet.SetWindowPos ZOrdering .. on ',GetWidgetDebugReport(FixedWidget)); + //DebugLn('TGtkWidgetSet.SetWindowPos ZOrdering .. on ',GetWidgetDebugReport(FixedWidget)); if GtkWidgetIsA(FixedWidget,GTK_Fixed_Get_Type) then begin // parent's client area is a gtk_fixed widget SetZOrderOnFixedWidget(Widget,FixedWidget); @@ -8227,7 +8227,7 @@ begin Result := False; end; end - else WriteLn('WARNING: [TGtkWidgetSet.ShowCaret] Got null HWND'); + else DebugLn('WARNING: [TGtkWidgetSet.ShowCaret] Got null HWND'); Assert(False, Format('Trace:< [TGtkWidgetSet.ShowCaret] HWND: 0x%x --> %s', [hWnd, BOOL_TEXT[Result]])); end; @@ -8325,7 +8325,7 @@ begin end; SW_MINIMIZE, SW_SHOWMAXIMIZED: - writeln('TGtkWidgetSet.ShowWindow: not implemented yet'); + DebugLn('TGtkWidgetSet.ShowWindow: not implemented yet'); end; @@ -8405,7 +8405,7 @@ Function TGtkWidgetSet.TextOut(DC: HDC; X,Y : Integer; Str : Pchar; Count: Integer) : Boolean; {$IfDef GTK2} begin - writeln('TGtkWidgetSet.TextOut ToDo'); + DebugLn('TGtkWidgetSet.TextOut ToDo'); Result:=false; end; {$ELSE} @@ -8429,7 +8429,7 @@ begin begin if GC = nil then begin - WriteLn('WARNING: [TGtkWidgetSet.TextOut] Uninitialized GC'); + DebugLn('WARNING: [TGtkWidgetSet.TextOut] Uninitialized GC'); end else begin if (CurrentFont = nil) or (CurrentFont^.GDIFontObject = nil) @@ -8446,12 +8446,12 @@ begin StrikeOut := LongBool(CurrentFont^.LogFont.lfStrikeOut); end; If UseFont = nil then - WriteLn('WARNING: [TGtkWidgetSet.TextOut] Missing Font') + DebugLn('WARNING: [TGtkWidgetSet.TextOut] Missing Font') else begin DCOrigin:=GetDCOffset(TDeviceContext(DC)); GetTextExtentPoint(DC, Str, Count, Sz); aRect := Rect(X+DCOrigin.X,Y+DCOrigin.Y,X + Sz.CX, Sz.CY); - //writeln('TGtkWidgetSet.TextOut ',ARect.Left,',',ARect.Top,',',ARect.RIght,',',ARect.Bottom); + //DebugLn('TGtkWidgetSet.TextOut ',ARect.Left,',',ARect.Top,',',ARect.RIght,',',ARect.Bottom); FillRect(DC,aRect,hBrush(CurrentBrush)); UpdateDCTextMetric(TDeviceContext(DC)); TxtPt.X := X; @@ -8697,6 +8697,9 @@ end; { ============================================================================= $Log$ + Revision 1.350 2004/05/11 11:42:27 mattias + replaced writeln by debugln + Revision 1.349 2004/05/07 08:07:57 mattias ifdefd UseSimpleJpeg diff --git a/lcl/intfgraphics.pas b/lcl/intfgraphics.pas index 8bc05b5181..49ddd64a2c 100644 --- a/lcl/intfgraphics.pas +++ b/lcl/intfgraphics.pas @@ -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; diff --git a/lcl/lclproc.pas b/lcl/lclproc.pas index 04e4f14eac..e3909beb27 100644 --- a/lcl/lclproc.pas +++ b/lcl/lclproc.pas @@ -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; diff --git a/lcl/widgetset/wslclclasses.pp b/lcl/widgetset/wslclclasses.pp index 0c36de9ab9..fb49dd445e 100644 --- a/lcl/widgetset/wslclclasses.pp +++ b/lcl/widgetset/wslclclasses.pp @@ -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); diff --git a/packager/pkgoptionsdlg.pas b/packager/pkgoptionsdlg.pas index 8f7e01c954..2c4714eda3 100644 --- a/packager/pkgoptionsdlg.pas +++ b/packager/pkgoptionsdlg.pas @@ -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;