mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-09-04 13:43:05 +02:00
LCL, implemented per page orientation/boundingbox, fix issue #13626
git-svn-id: trunk@19744 -
This commit is contained in:
jesus
parent
06acd45a27
commit
0a1f6d9523
@ -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
|
||||
|
||||
138
lcl/printers.pas
138
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;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user