paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-18 16:39:19 +02:00
Code Issues Packages Projects Releases Wiki Activity

LazReport, printer debug info

Browse Source 
git-svn-id: trunk@44347 -
This commit is contained in:
jesus 2014-03-04 23:54:39 +00:00
parent f65306bccd
commit 41bbe0bb16
2 changed files with 124 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

54
components/lazreport/source/lr_class.pas
View File

@ -6418,11 +6418,18 @@ const
constructor TfrPage.Create(ASize, AWidth, AHeight: Integer; constructor TfrPage.Create(ASize, AWidth, AHeight: Integer;
AOr: TPrinterOrientation); AOr: TPrinterOrientation);
begin begin
{$ifdef DbgPrinter}
DebugLnEnter('TfrPage.Create INIT');
{$endif}
Self.Create(nil); Self.Create(nil);
ChangePaper(ASize, AWidth, AHeight, AOr); ChangePaper(ASize, AWidth, AHeight, AOr);
PrintToPrevPage := False; PrintToPrevPage := False;
UseMargins := True; UseMargins := True;
{$ifdef DbgPrinter}
DebugLnExit('TfrPage.Create END');
{$endif}
end; end;
constructor TfrPage.CreatePage; constructor TfrPage.CreatePage;
@ -6444,12 +6451,18 @@ end;
procedure TfrPage.ChangePaper(ASize, AWidth, AHeight: Integer; procedure TfrPage.ChangePaper(ASize, AWidth, AHeight: Integer;
AOr: TPrinterOrientation); AOr: TPrinterOrientation);
begin begin
{$ifdef DbgPrinter}
DebugLnEnter('TfrPage.ChangePaper INIT');
{$endif}
try try
Prn.SetPrinterInfo(ASize, AWidth, AHeight, AOr); Prn.SetPrinterInfo(ASize, AWidth, AHeight, AOr);
Prn.FillPrnInfo(PrnInfo); Prn.FillPrnInfo(PrnInfo);
except except
on E:exception do on E:exception do
begin begin
{$ifdef DbgPrinter}
Debugln(['Exception: selecting custom paper ']);
{$endif}
Prn.SetPrinterInfo($100, AWidth, AHeight, AOr); Prn.SetPrinterInfo($100, AWidth, AHeight, AOr);
Prn.FillPrnInfo(PrnInfo); Prn.FillPrnInfo(PrnInfo);
end; end;
@ -6458,6 +6471,10 @@ begin
Width := Prn.PaperWidth; Width := Prn.PaperWidth;
Height := Prn.PaperHeight; Height := Prn.PaperHeight;
Orientation:= Prn.Orientation; Orientation:= Prn.Orientation;
{$ifdef DbgPrinter}
DebugLnExit('TfrPage.ChangePaper END pgSize=%d Width=%d Height=%d Orientation=%d',
[pgSize,Width,Height,ord(Orientation)]);
{$endif}
end; end;
procedure TfrPage.Clear; procedure TfrPage.Clear;
@ -8303,6 +8320,9 @@ var
end; end;
begin begin
{$ifdef DebugLR}
DebugLnEnter('TfrEMFPages.LoadFromStream: INIT',[]);
{$endif}
Clear; Clear;
compr := 0; compr := 0;
AStream.Read(compr, 1); AStream.Read(compr, 1);
@ -8313,6 +8333,9 @@ begin
Exit; Exit;
end; end;
AddPagesFromStream(AStream, false); AddPagesFromStream(AStream, false);
{$ifdef DebugLR}
DebugLnExit('TfrEMFPages.LoadFromStream: DONE',[]);
{$endif}
end; end;
procedure TfrEMFPages.AddPagesFromStream(AStream: TStream; procedure TfrEMFPages.AddPagesFromStream(AStream: TStream;
@ -8324,6 +8347,9 @@ var
s: TMemoryStream; s: TMemoryStream;
begin begin
{$ifdef DebugLR}
DebugLnEnter('TfrEMFPages.AddPagesFromStream: INIT',[]);
{$endif}
Compr := 0; Compr := 0;
if AReadHeader then begin if AReadHeader then begin
AStream.Read(compr, 1); AStream.Read(compr, 1);
@ -8371,6 +8397,9 @@ begin
AStream.Seek(o, soFromBeginning); AStream.Seek(o, soFromBeginning);
Inc(i); Inc(i);
until i >= c; until i >= c;
{$ifdef DebugLR}
DebugLnExit('TfrEMFPages.AddPagesFromStream: DONE',[]);
{$endif}
end; end;
procedure TfrEMFPages.LoadFromXML(XML: TLrXMLConfig; const Path: String); procedure TfrEMFPages.LoadFromXML(XML: TLrXMLConfig; const Path: String);
@ -10243,6 +10272,9 @@ var
procedure PrintPage(n: Integer); procedure PrintPage(n: Integer);
begin begin
{$ifdef DebugLR}
DebugLnEnter('PrintPage: INIT ',[]);
{$endif}
with Printer, EMFPages[n]^ do with Printer, EMFPages[n]^ do
begin begin
if not Prn.IsEqual(pgSize, pgWidth, pgHeight, pgOr) then if not Prn.IsEqual(pgSize, pgWidth, pgHeight, pgOr) then
@ -10271,6 +10303,9 @@ var
InternalOnProgress(n + 1); InternalOnProgress(n + 1);
Application.ProcessMessages; Application.ProcessMessages;
f := False; f := False;
{$ifdef DebugLR}
DebugLnExit('PrintPage: DONE',[]);
{$endif}
end; end;
{$IFDEF DebugLR} {$IFDEF DebugLR}
procedure DebugPrnInfo(msg: string); procedure DebugPrnInfo(msg: string);
@ -10317,10 +10352,10 @@ var
end; end;
begin begin
{$IFDEF DebugLR} {$ifdef DebugLR}
DebugLn('DoPrintReport INIT'); DebugLnEnter('TfrReport.DoPrintReport: INIT ',[]);
DebugPrnInfo('=== INIT'); DebugPrnInfo('=== INIT');
{$ENDIF} {$endif}
Prn.Printer := Printer; Prn.Printer := Printer;
pgList := TStringList.Create; pgList := TStringList.Create;
@ -10358,9 +10393,10 @@ begin
Printer.EndDoc; Printer.EndDoc;
pgList.Free; pgList.Free;
{$IFDEF DebugLR} {$ifdef DebugLR}
DebugPrnInfo('=== END'); DebugPrnInfo('=== END');
{$ENDIF} DebugLnExit('TfrReport.DoPrintReport: DONE',[]);
{$endif}
end; end;
procedure TfrReport.SetComments(const AValue: TStringList); procedure TfrReport.SetComments(const AValue: TStringList);
@ -10389,7 +10425,7 @@ begin
// own virtual default printer // own virtual default printer
end; end;
{$ifdef dbgPrinter} {$ifdef dbgPrinter}
DebugLnExit('TfrReport.SetPrinterTo DONE Printer="%s"',[Prn.Printer.PrinterName]); DebugLnExit('TfrReport.SetPrinterTo DONE CurPrinter="%s"',[Prn.Printer.PrinterName]);
{$endif} {$endif}
end; end;
@ -11942,6 +11978,9 @@ procedure TfrPageReport.LoadFromXML(XML: TLrXMLConfig; const Path: String);
var var
Rc : TRect; Rc : TRect;
begin begin
{$ifdef DbgPrinter}
DebugLnEnter('TfrPageReport.LoadFromXML INIT');
{$endif}
inherited LoadFromXML(XML, Path); inherited LoadFromXML(XML, Path);
@ -11959,6 +11998,9 @@ begin
ColGap := XML.GetValue(Path+'ColGap/Value'{%H-}, 0); ColGap := XML.GetValue(Path+'ColGap/Value'{%H-}, 0);
RestoreProperty('LayoutOrder',XML.GetValue(Path+'LayoutOrder/Value','loColumns')); RestoreProperty('LayoutOrder',XML.GetValue(Path+'LayoutOrder/Value','loColumns'));
ChangePaper(pgSize, Width, Height, Orientation); ChangePaper(pgSize, Width, Height, Orientation);
{$ifdef DbgPrinter}
DebugLnExit('TfrPageReport.LoadFromXML END');
{$endif}
end; end;
procedure TfrPageReport.SavetoXML(XML: TLrXMLConfig; const Path: String); procedure TfrPageReport.SavetoXML(XML: TLrXMLConfig; const Path: String);

86
components/lazreport/source/lr_prntr.pas
View File

@ -60,6 +60,9 @@ type
function GetArrayPos(pgSize: Integer): Integer; function GetArrayPos(pgSize: Integer): Integer;
function DefaultPaperIndex: Integer; function DefaultPaperIndex: Integer;
function DefaultPageSize: Integer; function DefaultPageSize: Integer;
{$IFDEF DbgPrinter}
procedure DumpPrinterInfo;
{$ENDIF}
property PaperNames: TStringList read GetPaperNames; property PaperNames: TStringList read GetPaperNames;
property Printer: TPrinter read FPrinter write SetPrinter; property Printer: TPrinter read FPrinter write SetPrinter;
@ -663,7 +666,7 @@ begin
if CompareText(aPaperName, Name)=0 then if CompareText(aPaperName, Name)=0 then
begin begin
// perfect name match, no need to look anymore // perfect name match, no need to look anymore
{$ifdef DbgPrinter}DebugLn('i=%d Perfect Name Match %s',[i, Name]);{$Endif} {$ifdef DbgPrinter_detail}DebugLn('i=%d Perfect Name Match %s',[i, Name]);{$Endif}
BIndex := i; BIndex := i;
Break; Break;
end else end else
@ -675,20 +678,20 @@ begin
if (Cw=0) and (Ch=0) then if (Cw=0) and (Ch=0) then
begin begin
// no need to look more, perfect match // no need to look more, perfect match
{$ifdef DbgPrinter}DebugLn('i=%d Perfect Size Match w=%d h=%d "%s"->%s',[i,X,Y,aPaperName,Name]);{$Endif} {$ifdef DbgPrinter_detail}DebugLn('i=%d Perfect Size Match w=%d h=%d "%s"->%s',[i,X,Y,aPaperName,Name]);{$Endif}
BIndex := i; BIndex := i;
break; break;
end else end else
if (Cw<6) and (Ch<6) and (Cw<=BDeltaW) and (Cw<=BDeltaH) then if (Cw<6) and (Ch<6) and (Cw<=BDeltaW) and (Cw<=BDeltaH) then
begin begin
{$ifdef DbgPrinter}DebugLn('i=%d Close Size cw=%d ch=%d "%s"->%s',[i,cw,ch,aPaperName,Name]);{$endif} {$ifdef DbgPrinter_detail}DebugLn('i=%d Close Size cw=%d ch=%d "%s"->%s',[i,cw,ch,aPaperName,Name]);{$endif}
// we are interested only on differences with searched paper of // we are interested only on differences with searched paper of
// about 2 mm or less (1 mm is aprox 3 points) // about 2 mm or less (1 mm is aprox 3 points)
BIndex := i; BIndex := i;
BDeltaW := Cw; BDeltaW := Cw;
BDeltaH := CH; BDeltaH := CH;
end end
{$ifdef DbgPrinter} {$ifdef DbgPrinter_detail}
//else //else
// DebugLn('i=%d Missed cw=%d ch=%d %s',[i, cw, ch, Name]) // DebugLn('i=%d Missed cw=%d ch=%d %s',[i, cw, ch, Name])
{$endif} {$endif}
@ -700,7 +703,7 @@ begin
begin begin
result := PPDPaperInfo[bIndex].Typ result := PPDPaperInfo[bIndex].Typ
end end
{$ifdef DbgPrinter} {$ifdef DbgPrinter_detail}
else else
DebugLn(['Matching Paper ',aPaperName,' failed']) DebugLn(['Matching Paper ',aPaperName,' failed'])
{$endif} {$endif}
@ -723,6 +726,9 @@ begin
fPaperNames.Assign(fPrinter.PaperSize.SupportedPapers); fPaperNames.Assign(fPrinter.PaperSize.SupportedPapers);
PaperSizesNum:=FPaperNames.Count; PaperSizesNum:=FPaperNames.Count;
end; end;
{$ifdef DbgPrinter}
DebugLn(['Filling windows paper numbers for ', PaperSizesNum,' papers ....']);
{$endif}
{$IFNDEF MSWINDOWS} {$IFNDEF MSWINDOWS}
// Under no windows platforms, there is no unique number that indentify // Under no windows platforms, there is no unique number that indentify
// papers, so we have to fill here our own numbers, this should be based // papers, so we have to fill here our own numbers, this should be based
@ -753,7 +759,9 @@ begin
PaperSizes[i] := PtrInt(FPaperNames.Objects[i]); PaperSizes[i] := PtrInt(FPaperNames.Objects[i]);
{$ENDIF} {$ENDIF}
{$IFDEF DbgPrinter} {$IFDEF DbgPrinter_detail}
DebugLn(['Dump printer List of papers:']);
n := FPapernames.IndexOf(FPrinter.PaperSize.PaperName); n := FPapernames.IndexOf(FPrinter.PaperSize.PaperName);
if n<0 then if n<0 then
// try to get the PaperIndex of the default paper // try to get the PaperIndex of the default paper
@ -774,9 +782,11 @@ begin
DbgOut(' '); DbgOut(' ');
DebugLn(' WinNum=%5d Paper=%s', [PaperSizes[i], FPaperNames[i]]); DebugLn(' WinNum=%5d Paper=%s', [PaperSizes[i], FPaperNames[i]]);
end; end;
DebugLn('PaperSize is %d',[PaperSize]);
{$Endif} {$Endif}
{$IFDEF DbgPrinter}
DebugLn('Current PaperSize is %d',[PaperSize]);
{$ENDIF}
try try
// update paper size in std pt units // update paper size in std pt units
PaperWidth := round(fPrinter.PaperSize.Width * 72 / fPrinter.XDPI); PaperWidth := round(fPrinter.PaperSize.Width * 72 / fPrinter.XDPI);
@ -796,13 +806,17 @@ end;
procedure TfrPrinter.SetSettings; procedure TfrPrinter.SetSettings;
var var
i, n: Integer; i, n: Integer;
{$ifdef DbgPrinter}
s: string;
{$endif}
begin begin
{$ifdef DbgPrinter} {$ifdef DbgPrinter}
WriteStr(s, Orientation);
DebugLnEnter(['TfrPrinter.SetSettings INIT: PrinterIndex=',FPrinterIndex]); DebugLnEnter(['TfrPrinter.SetSettings INIT: PrinterIndex=',FPrinterIndex]);
DebugLn(['PaperSize =', PaperSize]); DebugLn(['PaperSize =', PaperSize]);
DebugLn(['PaperWidth =', PaperWidth]); DebugLn(['PaperWidth =', PaperWidth]);
DebugLn(['PaperHeight=', PaperHeight]); DebugLn(['PaperHeight=', PaperHeight]);
DebugLn(['Orientation=', s]);
{$Endif} {$Endif}
// if selected printer is default printer, ie our virtual printer // if selected printer is default printer, ie our virtual printer
// then select our own set of papers // then select our own set of papers
@ -953,6 +967,10 @@ procedure TfrPrinter.FillPrnInfo(var p: TfrPrnInfo);
var var
kx, ky: Double; kx, ky: Double;
begin begin
{$ifdef DbgPrinter}
DebugLnEnter(['TfrPrinter.FillPrnInfo INIT']);
{$endif}
kx := 93 / 1.022; kx := 93 / 1.022;
ky := 93 / 1.015; ky := 93 / 1.015;
@ -1003,6 +1021,9 @@ begin
{$ENDIF} {$ENDIF}
end; end;
end; end;
{$ifdef DbgPrinter}
DebugLnExit('TfrPrinter.FillPrnInfo END');
{$endif}
end; end;
function TfrPrinter.IsEqual(pgSize, pgWidth, pgHeight: Integer; function TfrPrinter.IsEqual(pgSize, pgWidth, pgHeight: Integer;
@ -1018,12 +1039,25 @@ end;
procedure TfrPrinter.SetPrinterInfo(pgSize, pgWidth, pgHeight: Integer; procedure TfrPrinter.SetPrinterInfo(pgSize, pgWidth, pgHeight: Integer;
pgOr: TPrinterOrientation); pgOr: TPrinterOrientation);
begin begin
if IsEqual(pgSize, pgWidth, pgHeight, pgOr) then Exit; {$ifdef DbgPrinter}
DebugLnEnter('TfrPrinter.SetPrinterInfo INIT pgSize=%d pgWidth=%d pgHeight=%d pgOr=%d',
[pgSize, pgWidth, pgHeight, ord(pgOr)]);
{$endif}
if IsEqual(pgSize, pgWidth, pgHeight, pgOr) then
begin
{$ifdef DbgPrinter}
DebugLnExit('TfrPrinter.SetPrinterInfo EXIT: same properties');
{$endif}
Exit;
end;
PaperSize:=PgSize; PaperSize:=PgSize;
PaperWidth:= pgWidth; PaperWidth:= pgWidth;
PaperHeight:=pgHeight; PaperHeight:=pgHeight;
Orientation:=pgOr; Orientation:=pgOr;
SetSettings; SetSettings;
{$ifdef DbgPrinter}
DebugLnExit('TfrPrinter.SetPrinterInfo END');
{$endif}
end; end;
function TfrPrinter.GetArrayPos(pgSize: Integer): Integer; function TfrPrinter.GetArrayPos(pgSize: Integer): Integer;
@ -1060,8 +1094,29 @@ begin
result := 9; result := 9;
end; end;
{$IFDEF DbgPrinter}
procedure TfrPrinter.DumpPrinterInfo;
begin
DbgOut(['PrinterIndex=',FPrinterIndex]);
if (FPrinters<>nil)and(FPrinters.Count>0) then begin
if FPrinterIndex>=0 then
DbgOut([' (',FPrinters[FPrinterIndex],')'])
end else
DbgOut(' (no defined internal list of printers)');
DebugLn([' Is Default(Virtual) printer=',FPrinterIndex=FDefaultPrinter]);
if FPrinter=nil then
DebugLn('SysPrinter is nil')
else
DebugLn(['Sys Printer: Index = ', FPrinter.PrinterIndex,' Name=',FPrinter.PrinterName]);
end;
{$ENDIF}
procedure TfrPrinter.SetPrinterIndex(Value: Integer); procedure TfrPrinter.SetPrinterIndex(Value: Integer);
begin begin
{$IFDEF DbgPrinter}
DebugLnEnter(['TfrPrinter.SetPrinterIndex INIT: Value=',Value,' IsDefaultPrinter=',Value=FDefaultPrinter]);
{$ENDIF}
FPrinterIndex := Value; FPrinterIndex := Value;
if Value = FDefaultPrinter then if Value = FDefaultPrinter then
SetSettings SetSettings
@ -1071,6 +1126,9 @@ begin
FPrinter.PrinterIndex := Value; FPrinter.PrinterIndex := Value;
GetSettings; GetSettings;
end; end;
{$IFDEF DbgPrinter}
DebugLnExit(['TfrPrinter.SetPrinterIndex DONE']);
{$ENDIF}
end; end;
function TfrPrinter.GetPaperNames: TStringList; function TfrPrinter.GetPaperNames: TStringList;
@ -1106,6 +1164,10 @@ end;
procedure TfrPrinter.SetPrinter(Value: TPrinter); procedure TfrPrinter.SetPrinter(Value: TPrinter);
begin begin
{$ifdef DbgPrinter}
DebugLnEnter('TfrPrinter.SetPrinter: INIT',[]);
DumpPrinterInfo;
{$endif}
FPrinters.Clear; FPrinters.Clear;
FPrinterIndex := 0; FPrinterIndex := 0;
FPrinter:=Value; FPrinter:=Value;
@ -1120,6 +1182,10 @@ begin
FPrinters.Add(sDefaultPrinter); FPrinters.Add(sDefaultPrinter);
FDefaultPrinter := FPrinters.Count - 1; FDefaultPrinter := FPrinters.Count - 1;
end; end;
{$ifdef DbgPrinter}
DumpPrinterInfo;
DebugLnExit('TfrPrinter.SetPrinter: DONE',[]);
{$endif}
end; end;
{ {