diff --git a/lcl/postscriptcanvas.pas b/lcl/postscriptcanvas.pas index 1cdc4e5f5d..3bce96fe15 100644 --- a/lcl/postscriptcanvas.pas +++ b/lcl/postscriptcanvas.pas @@ -70,22 +70,17 @@ Type fPenPos : TPoint; FPsUnicode : TPSUnicode; FFs : TFormatSettings; - FXDPI,FYDPI : Integer; - function GetXDPI: Integer; - function GetYDPI: Integer; procedure psDrawRect(ARect:TRect); - procedure SetUserXDPI(const AValue: Integer); - procedure SetUserYDPI(const AValue: Integer); procedure WriteHeader(St : String); procedure Write(const St : String; Lst : TstringList = nil); overload; procedure WriteB(const St : string); procedure ClearBuffer; procedure Write(Lst : TStringList); overload; procedure WriteComment(const St : string); - procedure WriteOrientation; - procedure WriteOrientationHeader; - procedure WriteBoundingBox; + procedure WritePageTransform; + procedure WriteOrientation(UseHeader: boolean); + procedure WriteBoundingBox(UseHeader: boolean); function TranslateCoord(cnvX,cnvY : Integer):TpsPoint; procedure SetPosition(X,Y : Integer); @@ -172,8 +167,6 @@ Type property OutPutFileName : string read fFileName write fFileName; - property XDPI: Integer read GetXDPI write SetUserXDPI; - property YDPI: Integer read GetYDPI write SetUserYDPI; end; TPostScriptCanvas = Class(TPostScriptPrinterCanvas) @@ -528,6 +521,10 @@ Const ) ); +const + PageOpArr: array[boolean] of string[5] = ('Page',''); + OrientArr: array[boolean] of string[10] = ('Landscape','Portrait'); + {$IFDEF ASCII85} type @@ -671,69 +668,68 @@ begin fDocument.Add('%'+St); end; -procedure TPostScriptPrinterCanvas.WriteOrientation; +procedure TPostScriptPrinterCanvas.WritePageTransform; var h,w:integer; begin - if Printer=nil then - exit; - case Printer.Orientation of + case Orientation of poReversePortrait: begin - w:=round(Printer.PaperSize.Width*72/printer.XDPI); - h:=round(Printer.PaperSize.Height*72/printer.YDPI); + w:=round(PaperWidth*72/XDPI); + h:=round(PaperHeight*72/YDPI); Write(format('%d %d translate 180 rotate',[w,h])); end; poLandscape: begin - h:=round(Printer.PaperSize.Width*72/printer.XDPI); + h:=round(PaperWidth*72/XDPI); Write(format('0 %d translate 90 neg rotate',[h])); end; poReverseLandscape: begin - h:=round(Printer.PaperSize.Height*72/printer.YDPI); + h:=round(PaperHeight*72/YDPI); Write(format('%d 0 translate 90 rotate',[h])); end; end; end; -procedure TPostScriptPrinterCanvas.WriteOrientationHeader; +procedure TPostScriptPrinterCanvas.WriteOrientation(UseHeader: boolean); +var + L: TStringList; begin - if (Printer<>nil) and - ((Printer.Orientation=poLandscape) or - (Printer.Orientation=poReverseLandscape)) - then - WriteHeader('%%Orientation: Landscape'); + + if UseHeader then + L := Fheader + else + L := nil; + + Write('%%'+PageOpArr[UseHeader]+'Orientation: '+ + OrientArr[(Orientation=poPortrait)or(Orientation=poReversePortrait)], L); end; -procedure TPostScriptPrinterCanvas.WriteBoundingBox; +procedure TPostScriptPrinterCanvas.WriteBoundingBox(UseHeader: boolean); var a,l,t,w,h: Integer; + Lst: TStringList; begin - if (Printer<>nil) then + + l := round(LeftMargin * 72 / XDPI); + t := round(TopMargin * 72 / YDPI); + w := round((PaperWidth - RightMargin) * 72 / XDPI); + h := round((PaperHeight - BottomMargin) * 72 / YDPI); + + if (Orientation=poLandscape) or (Orientation=poReverseLandscape) then begin - with Printer.PaperSize.PaperRect.WorkRect do - begin - l:=round(Left*72/printer.XDPI); - t:=round(Top*72/Printer.XDPI); - w:=round(Right*72/Printer.XDPI); - h:=round(Bottom*72/Printer.YDPI); - if (Printer.Orientation=poLandscape) or - (Printer.Orientation=poReverseLandscape) then - begin - a := l; l := t; t := a; - a := w; w := h; h := a; - end; - end; - end - else // should not be - begin - l:=0; - t:=0; - w:=round(PageWidth*72/XDPI); // page in pixels, printer in points - h:=round(PageHeight*72/YDPI); + a := l; l := t; t := a; + a := w; w := h; h := a; end; - WriteHeader('%%'+Format('BoundingBox: %d %d %d %d',[l,t,w,h])); + + if UseHeader then + Lst := FHeader + else + Lst := nil; + + Write('%%'+PageOpArr[UseHeader]+Format('BoundingBox: %d %d %d %d',[l,t,w,h]), + Lst); end; //Convert an TCanvas Y point to PostScript Y point @@ -1178,11 +1174,11 @@ begin Font.Color:=clBlack; WriteHeader('%!PS-Adobe-3.0'); - WriteBoundingBox; + WriteBoundingBox(True); WriteHeader('%%'+Format('Creator: Lazarus PostScriptCanvas for %s',[Application.ExeName])); WriteHeader('%%'+Format('Title: %s',[Title])); WriteHeader('%%CreationDate: '+DateTimeToStr(Now)); - WriteOrientationHeader; + WriteOrientation(true); WriteHeader('%%Pages: (atend)'); WriteHeader('%%PageResources: (atend)'); WriteHeader('%%PageOrder: Ascend'); @@ -1419,9 +1415,8 @@ begin WriteHeader('%%EndSetup'); WriteHeader('%%====================== END SETUP ========================='); WriteHeader(''); - WriteOrientation; - WriteHeader(''); WriteHeader('%%Page: 1 1'); + WritePageTransform; end; procedure TPostScriptPrinterCanvas.EndDoc; @@ -1455,6 +1450,9 @@ begin Write('stroke'); Write('showpage'); Write('%%'+Format('Page: %d %d',[PageNumber, PageNumber])); + WriteBoundingBox(false); + WriteOrientation(false); + WritePageTransform; write('newpath'); Self.fcPenWidth:=-1; // prevent cached line width affect new page @@ -1594,38 +1592,6 @@ begin end; -procedure TPostScriptPrinterCanvas.SetUserXDPI(const AValue: Integer); -begin - FXDPI := AValue; -end; - -procedure TPostScriptPrinterCanvas.SetUserYDPI(const AValue: Integer); -begin - FYDPI := AValue; -end; - -function TPostScriptPrinterCanvas.GetXDPI: Integer; -begin - if Printer<>nil then - result := Printer.XDPI - else - if FXDPI <= 0 then - result := 300 - else - result := FXDPI; -end; - -function TPostScriptPrinterCanvas.GetYDPI: Integer; -begin - if Printer<>nil then - result := Printer.YDPI - else - if FYDPI <= 0 then - result := 300 - else - result := FYDPI; -end; - //Draw an Rectangle procedure TPostScriptPrinterCanvas.Rectangle(X1, Y1, X2, Y2: Integer); begin diff --git a/lcl/printers.pas b/lcl/printers.pas index 7074a81db3..e5fefee36e 100644 --- a/lcl/printers.pas +++ b/lcl/printers.pas @@ -45,25 +45,44 @@ type associated with TPrinter or override few values. BeginDoc,NewPage and EndDoc it's called in Printer.BeginDoc ... + + PaperWidth: physical width of paper + PaperHeight: Physical height of paper + PageWidth: Printable width on page + PageHeight: Printable height of paper } + + { TPrinterCanvas } + TPrinterCanvas = class(TCanvas) private fPrinter : TPrinter; fTitle : String; - fPageHeight : Integer; - fPageWidth : Integer; fPageNum : Integer; fTopMargin : Integer; fLeftMargin : Integer; fBottomMargin : Integer; fRightMargin : Integer; - + fPaperWidth : Integer; + fPaperHeight : Integer; + fOrientation : TPrinterOrientation; + fXDPI,fYDPI : Integer; + + function GetOrientation: TPrinterOrientation; function GetPageHeight: Integer; function GetPageWidth: Integer; + function GetPaperHeight: Integer; + function GetPaperWidth: Integer; function GetTitle: string; - procedure SetPageHeight(const AValue: Integer); - procedure SetPageWidth(const AValue: Integer); + function GetXDPI: Integer; + function GetYDPI: Integer; + procedure SetOrientation(const AValue: TPrinterOrientation); + procedure SetPaperHeight(const AValue: Integer); + procedure SetPaperWidth(const AValue: Integer); procedure SetTitle(const AValue: string); + function HasDefaultMargins: boolean; + procedure SetXDPI(const AValue: Integer); + procedure SetYDPI(const AValue: Integer); protected procedure BeginDoc; virtual; procedure NewPage; virtual; @@ -79,13 +98,18 @@ type property Printer : TPrinter read fPrinter; property Title : string read GetTitle write SetTitle; - property PageHeight : Integer read GetPageHeight write SetPageHeight; - property PageWidth : Integer read GetPageWidth write SetPageWidth; + property PageHeight : Integer read GetPageHeight; + property PageWidth : Integer read GetPageWidth; + property PaperWidth : Integer read GetPaperWidth write SetPaperWidth; + property PaperHeight: Integer read GetPaperHeight write SetPaperHeight; property PageNumber : Integer read fPageNum; property TopMargin : Integer read GetTopMargin write FTopMargin; property LeftMargin: Integer read GetLeftMargin write FLeftMargin; property BottomMargin: Integer read GetBottomMargin write FBottomMargin; property RightMargin: Integer read GetRightMargin write FRightMargin; + property Orientation: TPrinterOrientation read GetOrientation Write SetOrientation; + property XDPI: Integer read GetXDPI write SetXDPI; + property YDPI: Integer read GetYDPI write SetYDPI; end; @@ -889,30 +913,84 @@ begin Result:=fTitle; end; +function TPrinterCanvas.GetXDPI: Integer; +begin + if Printer<>nil then + result := Printer.XDPI + else + if fXDPI <= 0 then + result := 300 + else + result := fXDPI; +end; + +function TPrinterCanvas.GetYDPI: Integer; +begin + if Printer<>nil then + result := Printer.YDPI + else + if fYDPI <= 0 then + result := 300 + else + result := fYDPI; +end; + +procedure TPrinterCanvas.SetOrientation(const AValue: TPrinterOrientation); +begin + if Assigned(fPrinter) then + fPrinter.Orientation := AValue + else + fOrientation := AValue; +end; + +function TPrinterCanvas.GetOrientation: TPrinterOrientation; +begin + if fPrinter<>nil then + result := fPrinter.Orientation + else + result := fOrientation; +end; + function TPrinterCanvas.GetPageHeight: Integer; begin - if Assigned(fPrinter) and (fPageHeight=0) then - Result:=fPrinter.PageHeight + if Assigned(fPrinter) and HasDefaultMargins then + Result:=fPrinter.PageHeight else - Result:=fPageHeight; + Result:= PaperHeight - TopMargin - BottomMargin; end; function TPrinterCanvas.GetPageWidth: Integer; begin - if Assigned(fPrinter) and (fPageWidth=0) then - Result:=fPrinter.PageWidth + if Assigned(fPrinter) and HasDefaultMargins then + Result:=fPrinter.PageWidth else - Result:=fPageWidth; + Result:= PaperWidth - LeftMargin - RightMargin; end; -procedure TPrinterCanvas.SetPageHeight(const AValue: Integer); +function TPrinterCanvas.GetPaperHeight: Integer; begin - fPageHeight:=aValue; + if Assigned(fPrinter) then + result := fPrinter.PaperSize.Height + else + result := fPaperHeight; end; -procedure TPrinterCanvas.SetPageWidth(const AValue: Integer); +function TPrinterCanvas.GetPaperWidth: Integer; begin - fPageWidth:=aValue; + if Assigned(fPrinter) then + result := fPrinter.PaperSize.Width + else + result := fPaperWidth; +end; + +procedure TPrinterCanvas.SetPaperHeight(const AValue: Integer); +begin + fPaperHeight := AValue; +end; + +procedure TPrinterCanvas.SetPaperWidth(const AValue: Integer); +begin + fPaperWidth := AValue; end; procedure TPrinterCanvas.SetTitle(const AValue: string); @@ -923,15 +1001,25 @@ begin fTitle:=aValue; end; +function TPrinterCanvas.HasDefaultMargins: boolean; +begin + result := (FLeftMargin=0) and (FRightMargin=0) and + (FTopMargin=0) and (FBottomMargin=0); +end; + +procedure TPrinterCanvas.SetXDPI(const AValue: Integer); +begin + fXDPI := AValue; +end; + +procedure TPrinterCanvas.SetYDPI(const AValue: Integer); +begin + fYDPI := AValue; +end; + constructor TPrinterCanvas.Create(APrinter: TPrinter); begin - Inherited Create; - fPageWidth :=0; - fPageHeight :=0; - fTopMargin :=0; - fLeftMargin :=0; - fRightMargin :=0; - fBottomMargin :=0; + inherited Create; fPrinter:=aPrinter; end; @@ -962,7 +1050,7 @@ begin if (fLeftMargin=0) and (fPrinter<>nil) then Result:=fPrinter.PaperSize.PaperRect.WorkRect.Left else - Result:=FLeftMargin; + Result:=fLeftMargin; end; function TPrinterCanvas.GetTopMargin: Integer;