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

LCL postscriptcanvas.pas:

Browse Source 
- fixed PostScript case
- write number of pages to header on EndDoc
- overriden TCanvas.Create*, TCanvas.*Changing, TCanvas.DeselectHandles and TCanvas.RequiredState to not call handle dependent functions, since handle is dummy  

git-svn-id: trunk@12010 -
This commit is contained in:
tombo 2007-09-12 14:47:57 +00:00
parent a6de3a8e90
commit a0fdad737e
1 changed files with 142 additions and 73 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

215
lcl/postscriptcanvas.pas
View File

@ -1,6 +1,6 @@
{ {
/*************************************************************************** /***************************************************************************
PostscriptCanvas.pas PostScriptCanvas.pas
------------ ------------
PostScript Printer Canvas object PostScript Printer Canvas object
@ -34,7 +34,7 @@
- Implemente few methods - Implemente few methods
} }
unit PostscriptCanvas; unit PostScriptCanvas;
{$mode objfpc}{$H+} {$mode objfpc}{$H+}
@ -46,9 +46,9 @@ uses
Type Type
{ TPostscriptPrinterCanvas } { TPostScriptPrinterCanvas }
TPostscriptPrinterCanvas = Class(TPrinterCanvas) TPostScriptPrinterCanvas = Class(TPrinterCanvas)
private private
fHeader : TStringList; //Header document fHeader : TStringList; //Header document
fDocument : TstringList; //Current document fDocument : TstringList; //Current document
@ -74,7 +74,7 @@ Type
procedure Write(Lst : TStringList); overload; procedure Write(Lst : TStringList); overload;
procedure WriteComment(const St : string); procedure WriteComment(const St : string);
Procedure TranslateCoord(Var X,Y : Integer); procedure TranslateCoord(Var X,Y : Integer);
procedure SetPosition(X,Y : Integer); procedure SetPosition(X,Y : Integer);
procedure UpdateLineWidth; procedure UpdateLineWidth;
@ -93,6 +93,16 @@ Type
function PPCFormat (const Fmt : string; const Args : array of const) : string; function PPCFormat (const Fmt : string; const Args : array of const) : string;
protected protected
procedure CreateHandle; override; procedure CreateHandle; override;
procedure CreateBrush; override;
procedure CreateFont; override;
Procedure CreatePen; override;
Procedure CreateRegion; override;
procedure DeselectHandles; override;
procedure PenChanging(APen: TObject); override;
procedure FontChanging(APen: TObject); override;
procedure BrushChanging(APen: TObject); override;
procedure RegionChanging(APen: TObject); override;
procedure RequiredState(ReqState: TCanvasState); override;
procedure BeginDoc; override; procedure BeginDoc; override;
procedure EndDoc; override; procedure EndDoc; override;
@ -104,18 +114,18 @@ Type
procedure SaveToFile(aFileName : string); procedure SaveToFile(aFileName : string);
Procedure MoveTo(X1,Y1: Integer); override; procedure MoveTo(X1,Y1: Integer); override;
Procedure LineTo(X1,Y1: Integer); override; Procedure LineTo(X1,Y1: Integer); override;
procedure Polyline(Points: PPoint; NumPts: Integer); override; procedure Polyline(Points: PPoint; NumPts: Integer); override;
procedure PolyBezier(Points: PPoint; NumPts: Integer; procedure PolyBezier(Points: PPoint; NumPts: Integer;
Filled: boolean = False; Filled: boolean = False;
Continuous: boolean = False); override; Continuous: boolean = False); override;
Procedure Rectangle(X1,Y1,X2,Y2: Integer); override; procedure Rectangle(X1,Y1,X2,Y2: Integer); override;
procedure Frame(const ARect: TRect); override; // border using pen procedure Frame(const ARect: TRect); override; // border using pen
procedure FrameRect(const ARect: TRect); override; // border using brush procedure FrameRect(const ARect: TRect); override; // border using brush
Procedure FillRect(const ARect: TRect); override; procedure FillRect(const ARect: TRect); override;
Procedure RoundRect(X1, Y1, X2, Y2: Integer; RX,RY: Integer); override; Procedure RoundRect(X1, Y1, X2, Y2: Integer; RX,RY: Integer); override;
procedure Polygon(Points: PPoint; NumPts: Integer; procedure Polygon(Points: PPoint; NumPts: Integer;
Winding: boolean = False); override; Winding: boolean = False); override;
@ -128,13 +138,13 @@ Type
procedure TextOut(X,Y: Integer; const Text: String); override; procedure TextOut(X,Y: Integer; const Text: String); override;
function TextExtent(const Text: string): TSize; override; function TextExtent(const Text: string): TSize; override;
Procedure Draw(X,Y: Integer; SrcGraphic: TGraphic); override; procedure Draw(X,Y: Integer; SrcGraphic: TGraphic); override;
procedure StretchDraw(const DestRect: TRect; SrcGraphic: TGraphic); override; procedure StretchDraw(const DestRect: TRect; SrcGraphic: TGraphic); override;
//** Methods not definined on PostScript //** Methods not definined on PostScript
procedure FloodFill(X, Y: Integer; FillColor: TColor; FillStyle: TFillStyle); override; procedure FloodFill(X, Y: Integer; FillColor: TColor; FillStyle: TFillStyle); override;
Procedure CopyRect(const Dest: TRect; SrcCanvas: TCanvas; const Source: TRect); override; procedure CopyRect(const Dest: TRect; SrcCanvas: TCanvas; const Source: TRect); override;
//** Methods not implemented //** Methods not implemented
procedure Arc(x,y,Right,Bottom,SX,SY,EX,EY: Integer); override; procedure Arc(x,y,Right,Bottom,SX,SY,EX,EY: Integer); override;
@ -150,9 +160,9 @@ Type
property OutPutFileName : string read fFileName write fFileName; property OutPutFileName : string read fFileName write fFileName;
end; end;
TPostscriptCanvas = Class(TPostscriptPrinterCanvas) TPostScriptCanvas = Class(TPostScriptPrinterCanvas)
public public
Constructor Create; overload; constructor Create; overload;
procedure BeginDoc; override; procedure BeginDoc; override;
procedure EndDoc; override; procedure EndDoc; override;
@ -502,16 +512,16 @@ Const
) )
); );
{ TPostscriptPrinterCanvas } { TPostScriptPrinterCanvas }
//Write an instruction in the header of document //Write an instruction in the header of document
procedure TPostscriptPrinterCanvas.WriteHeader(St: String); procedure TPostScriptPrinterCanvas.WriteHeader(St: String);
begin begin
fHeader.Add(St); fHeader.Add(St);
end; end;
//Write an instruction in the document //Write an instruction in the document
procedure TPostscriptPrinterCanvas.Write(const St: String; Lst : TStringList = Nil); procedure TPostScriptPrinterCanvas.Write(const St: String; Lst : TStringList = Nil);
begin begin
If not Assigned(Lst) then If not Assigned(Lst) then
Lst:=fDocument; Lst:=fDocument;
@ -520,47 +530,47 @@ begin
end; end;
//Write data in fBuffer //Write data in fBuffer
procedure TPostscriptPrinterCanvas.WriteB(const St: string); procedure TPostScriptPrinterCanvas.WriteB(const St: string);
begin begin
Write(St,fBuffer); Write(St,fBuffer);
end; end;
//Clear all data of Buffer //Clear all data of Buffer
procedure TPostscriptPrinterCanvas.ClearBuffer; procedure TPostScriptPrinterCanvas.ClearBuffer;
begin begin
fBuffer.Clear; fBuffer.Clear;
end; end;
//Write all Lst.Strings in document //Write all Lst.Strings in document
procedure TPostscriptPrinterCanvas.Write(Lst: TStringList); procedure TPostScriptPrinterCanvas.Write(Lst: TStringList);
begin begin
fDocument.AddStrings(Lst); fDocument.AddStrings(Lst);
end; end;
//Write an comment in the document //Write an comment in the document
procedure TPostscriptPrinterCanvas.WriteComment(const St: string); procedure TPostScriptPrinterCanvas.WriteComment(const St: string);
begin begin
fDocument.Add('%'+St); fDocument.Add('%'+St);
end; end;
//Convert an TCanvas Y point to PostScript Y point //Convert an TCanvas Y point to PostScript Y point
//The TCanvas origine is corner Left,Top and Postscript is Left,Bottom //The TCanvas origine is corner Left,Top and PostScript is Left,Bottom
//Modify X and Y for use Left and Top margin //Modify X and Y for use Left and Top margin
procedure TPostscriptPrinterCanvas.TranslateCoord(var X,Y : Integer); procedure TPostScriptPrinterCanvas.TranslateCoord(var X,Y : Integer);
begin begin
Y:=PageHeight-TopMarging-Y; Y:=PageHeight-TopMarging-Y;
X:=X+LeftMarging; X:=X+LeftMarging;
end; end;
//Save the last position //Save the last position
procedure TPostscriptPrinterCanvas.SetPosition(X, Y: Integer); procedure TPostScriptPrinterCanvas.SetPosition(X, Y: Integer);
begin begin
fPenPos:= Point(X,Y); fPenPos:= Point(X,Y);
SetInternalPenPos(Point(X,Y)); SetInternalPenPos(Point(X,Y));
end; end;
//Init the width of line //Init the width of line
procedure TPostscriptPrinterCanvas.UpdateLineWidth; procedure TPostScriptPrinterCanvas.UpdateLineWidth;
begin begin
if Pen.Width<>fcPenWidth then if Pen.Width<>fcPenWidth then
begin begin
@ -570,7 +580,7 @@ begin
end; end;
//Init the color of line (pen) //Init the color of line (pen)
procedure TPostscriptPrinterCanvas.UpdateLineColor(aColor : TColor = clNone); procedure TPostScriptPrinterCanvas.UpdateLineColor(aColor : TColor = clNone);
Var R,G,B : Real; Var R,G,B : Real;
RGBColor : TColor; RGBColor : TColor;
begin begin
@ -590,7 +600,7 @@ begin
end; end;
//Init the style of line //Init the style of line
procedure TPostscriptPrinterCanvas.UpdateLineStyle; procedure TPostScriptPrinterCanvas.UpdateLineStyle;
Var st : string; Var st : string;
begin begin
if (Pen.Style<>fcPenStyle) and (Pen.Style<>psClear) then if (Pen.Style<>fcPenStyle) and (Pen.Style<>psClear) then
@ -609,7 +619,7 @@ begin
end; end;
//Init the color for fill //Init the color for fill
procedure TPostscriptPrinterCanvas.UpdateFillColor; procedure TPostScriptPrinterCanvas.UpdateFillColor;
Var R,G,B : Real; Var R,G,B : Real;
RGBColor : TColor; RGBColor : TColor;
begin begin
@ -626,7 +636,7 @@ begin
end; end;
//Update current font //Update current font
procedure TPostscriptPrinterCanvas.UpdateFont; procedure TPostScriptPrinterCanvas.UpdateFont;
Var R,G,B : Real; Var R,G,B : Real;
RGBColor : TColor; RGBColor : TColor;
begin begin
@ -659,8 +669,8 @@ begin
end; end;
end; end;
//Return an Postscript font Name //Return an PostScript font Name
function TPostscriptPrinterCanvas.MappedFontName: string; function TPostScriptPrinterCanvas.MappedFontName: string;
Var Atr : string; Var Atr : string;
begin begin
Atr:=''; Atr:='';
@ -691,7 +701,7 @@ begin
end; end;
//Replace the controls chars by PostScript string //Replace the controls chars by PostScript string
function TPostscriptPrinterCanvas.MapedString(const St: string): string; function TPostScriptPrinterCanvas.MapedString(const St: string): string;
begin begin
Result:=St; Result:=St;
Result:=StringReplace(Result,'\','\\',[rfReplaceAll]); Result:=StringReplace(Result,'\','\\',[rfReplaceAll]);
@ -704,14 +714,14 @@ begin
end; end;
//Move pen at last pos //Move pen at last pos
procedure TPostscriptPrinterCanvas.MoveToLastPos; procedure TPostScriptPrinterCanvas.MoveToLastPos;
begin begin
write(Format('%d %d moveto',[fPenPos.X,fPenPos.Y])+' %last pos'); write(Format('%d %d moveto',[fPenPos.X,fPenPos.Y])+' %last pos');
end; end;
//Add at the PstScript sequence, the Fill Pattern/Color and Broder //Add at the PstScript sequence, the Fill Pattern/Color and Broder
//Use SetBorder and SetFill for initialize 1 or 2 sequence //Use SetBorder and SetFill for initialize 1 or 2 sequence
procedure TPostscriptPrinterCanvas.SetBrushFillPattern(Lst: TStringList; procedure TPostScriptPrinterCanvas.SetBrushFillPattern(Lst: TStringList;
SetBorder, SetFill: Boolean); SetBorder, SetFill: Boolean);
begin begin
If not Assigned(Lst) then Exit; If not Assigned(Lst) then Exit;
@ -749,13 +759,13 @@ begin
end; end;
end; end;
procedure TPostscriptPrinterCanvas.SetBrushFillPattern(SetBorder, SetFill: Boolean); procedure TPostScriptPrinterCanvas.SetBrushFillPattern(SetBorder, SetFill: Boolean);
begin begin
SetBrushFillPattern(fBuffer,SetBorder,SetFill); SetBrushFillPattern(fBuffer,SetBorder,SetFill);
end; end;
//Add in Lst, all RGB pixels of SrcGraph picture //Add in Lst, all RGB pixels of SrcGraph picture
procedure TPostscriptPrinterCanvas.GetRGBImage(SrcGraph: TGraphic; procedure TPostScriptPrinterCanvas.GetRGBImage(SrcGraph: TGraphic;
Lst: TStringList); Lst: TStringList);
var var
SrcIntfImg : TLazIntfImage; SrcIntfImg : TLazIntfImage;
@ -795,7 +805,7 @@ begin
end; end;
end; end;
function TPostscriptPrinterCanvas.PPCFormat(const Fmt: string; function TPostScriptPrinterCanvas.PPCFormat(const Fmt: string;
const Args: array of const): string; const Args: array of const): string;
var var
OldDecimalSeparator: char; OldDecimalSeparator: char;
@ -806,13 +816,65 @@ begin
DecimalSeparator := OldDecimalSeparator; DecimalSeparator := OldDecimalSeparator;
end; end;
procedure TPostscriptPrinterCanvas.CreateHandle; procedure TPostScriptPrinterCanvas.CreateHandle;
begin begin
SetHandle(1); SetHandle(1); // set dummy handle
end;
procedure TPostScriptPrinterCanvas.CreateBrush;
begin
// handle is dummy, so do nothing here
end;
procedure TPostScriptPrinterCanvas.CreateFont;
begin
// handle is dummy, so do nothing here
end;
procedure TPostScriptPrinterCanvas.CreatePen;
begin
// handle is dummy, so do nothing here
end;
procedure TPostScriptPrinterCanvas.CreateRegion;
begin
// handle is dummy, so do nothing here
end;
procedure TPostScriptPrinterCanvas.DeselectHandles;
begin
// handle is dummy, so do nothing here
end;
procedure TPostScriptPrinterCanvas.PenChanging(APen: TObject);
begin
// handle is dummy, so do nothing here
end;
procedure TPostScriptPrinterCanvas.FontChanging(APen: TObject);
begin
// handle is dummy, so do nothing here
end;
procedure TPostScriptPrinterCanvas.BrushChanging(APen: TObject);
begin
// handle is dummy, so do nothing here
end;
procedure TPostScriptPrinterCanvas.RegionChanging(APen: TObject);
begin
// handle is dummy, so do nothing here
end;
procedure TPostScriptPrinterCanvas.RequiredState(ReqState: TCanvasState);
begin
if csHandleValid in ReqState then
inherited RequiredState([csHandleValid]);
// other states are anyway impossible, because handle is dummy
end; end;
constructor TPostscriptPrinterCanvas.Create(APrinter: TPrinter); constructor TPostScriptPrinterCanvas.Create(APrinter: TPrinter);
begin begin
inherited Create(APrinter); inherited Create(APrinter);
@ -827,7 +889,7 @@ begin
fDocument:=TStringList.Create; fDocument:=TStringList.Create;
end; end;
destructor TPostscriptPrinterCanvas.Destroy; destructor TPostScriptPrinterCanvas.Destroy;
begin begin
fBuffer.Free; fBuffer.Free;
fHeader.Free; fHeader.Free;
@ -837,7 +899,7 @@ begin
inherited Destroy; inherited Destroy;
end; end;
procedure TPostscriptPrinterCanvas.SaveToFile(aFileName: string); procedure TPostScriptPrinterCanvas.SaveToFile(aFileName: string);
Var Lst : TStringList; Var Lst : TStringList;
begin begin
Lst:=TStringList.Create; Lst:=TStringList.Create;
@ -851,7 +913,7 @@ begin
end; end;
end; end;
procedure TPostscriptPrinterCanvas.BeginDoc; procedure TPostScriptPrinterCanvas.BeginDoc;
begin begin
Inherited BeginDoc; Inherited BeginDoc;
@ -1225,7 +1287,9 @@ begin
WriteHeader(''); WriteHeader('');
end; end;
procedure TPostscriptPrinterCanvas.EndDoc; procedure TPostScriptPrinterCanvas.EndDoc;
var
I: Integer;
begin begin
Inherited EndDoc; Inherited EndDoc;
@ -1233,11 +1297,16 @@ begin
Write('showpage'); Write('showpage');
Write('%%EOF'); Write('%%EOF');
// update number of pages in header
I := FHeader.IndexOf('%%Pages: (atend)');
if I <> -1 then
FHeader[I] := '%%' + Format('Pages: %d', [PageNumber]);
if Trim(fFileName)<>'' then if Trim(fFileName)<>'' then
SaveToFile(ExpandFileName(fFileName)); SaveToFile(ExpandFileName(fFileName));
end; end;
procedure TPostscriptPrinterCanvas.NewPage; procedure TPostScriptPrinterCanvas.NewPage;
begin begin
inherited NewPage; inherited NewPage;
@ -1253,7 +1322,7 @@ begin
end; end;
//Move the current position //Move the current position
procedure TPostscriptPrinterCanvas.MoveTo(X1, Y1: Integer); procedure TPostScriptPrinterCanvas.MoveTo(X1, Y1: Integer);
begin begin
RequiredState([csHandleValid]); RequiredState([csHandleValid]);
WriteComment(Format('MoveTo(%d,%d)',[x1,y1])); WriteComment(Format('MoveTo(%d,%d)',[x1,y1]));
@ -1265,7 +1334,7 @@ begin
end; end;
//Drawe line //Drawe line
procedure TPostscriptPrinterCanvas.LineTo(X1, Y1: Integer); procedure TPostScriptPrinterCanvas.LineTo(X1, Y1: Integer);
begin begin
Changing; Changing;
RequiredState([csHandleValid, csPenValid]); RequiredState([csHandleValid, csPenValid]);
@ -1280,7 +1349,7 @@ begin
changed; changed;
end; end;
procedure TPostscriptPrinterCanvas.Polyline(Points: PPoint; NumPts: Integer); procedure TPostScriptPrinterCanvas.Polyline(Points: PPoint; NumPts: Integer);
Var i : LongInt; Var i : LongInt;
Lst: TStringList; Lst: TStringList;
Pt : TPoint; Pt : TPoint;
@ -1319,7 +1388,7 @@ begin
Changed; Changed;
end; end;
procedure TPostscriptPrinterCanvas.PolyBezier(Points: PPoint; NumPts: Integer; procedure TPostScriptPrinterCanvas.PolyBezier(Points: PPoint; NumPts: Integer;
Filled: boolean; Continuous: boolean); Filled: boolean; Continuous: boolean);
Var i : Integer; Var i : Integer;
St : String; St : String;
@ -1356,7 +1425,7 @@ begin
end; end;
//Draw an Rectangle //Draw an Rectangle
procedure TPostscriptPrinterCanvas.Rectangle(X1, Y1, X2, Y2: Integer); procedure TPostScriptPrinterCanvas.Rectangle(X1, Y1, X2, Y2: Integer);
begin begin
Changing; Changing;
RequiredState([csHandleValid, csBrushValid, csPenValid]); RequiredState([csHandleValid, csBrushValid, csPenValid]);
@ -1381,7 +1450,7 @@ begin
Changed; Changed;
end; end;
procedure TPostscriptPrinterCanvas.Frame(const ARect: TRect); procedure TPostScriptPrinterCanvas.Frame(const ARect: TRect);
Var X1,Y1,X2,Y2 : Integer; Var X1,Y1,X2,Y2 : Integer;
begin begin
Changing; Changing;
@ -1411,7 +1480,7 @@ begin
Changed; Changed;
end; end;
procedure TPostscriptPrinterCanvas.FrameRect(const ARect: TRect); procedure TPostScriptPrinterCanvas.FrameRect(const ARect: TRect);
Var CL : TColor; Var CL : TColor;
begin begin
Changing; Changing;
@ -1429,7 +1498,7 @@ begin
end; end;
//Fill an Rectangular region //Fill an Rectangular region
procedure TPostscriptPrinterCanvas.FillRect(const ARect: TRect); procedure TPostScriptPrinterCanvas.FillRect(const ARect: TRect);
Var X1,Y1,X2,Y2 : Integer; Var X1,Y1,X2,Y2 : Integer;
begin begin
Changing; Changing;
@ -1460,7 +1529,7 @@ begin
Changed; Changed;
end; end;
procedure TPostscriptPrinterCanvas.RoundRect(X1, Y1, X2, Y2: Integer; RX, procedure TPostScriptPrinterCanvas.RoundRect(X1, Y1, X2, Y2: Integer; RX,
RY: Integer); RY: Integer);
Var ellipsePath : string; Var ellipsePath : string;
begin begin
@ -1500,7 +1569,7 @@ begin
Changed; Changed;
end; end;
procedure TPostscriptPrinterCanvas.Polygon(Points: PPoint; NumPts: Integer; procedure TPostScriptPrinterCanvas.Polygon(Points: PPoint; NumPts: Integer;
Winding: boolean); Winding: boolean);
Var i : LongInt; Var i : LongInt;
Pt : TPoint; Pt : TPoint;
@ -1530,7 +1599,7 @@ begin
end; end;
//Draw an Ellipse //Draw an Ellipse
procedure TPostscriptPrinterCanvas.Ellipse(x1, y1, x2, y2: Integer); procedure TPostScriptPrinterCanvas.Ellipse(x1, y1, x2, y2: Integer);
var xScale : Real; var xScale : Real;
yScale : Real; yScale : Real;
cX, cY : Real; cX, cY : Real;
@ -1580,7 +1649,7 @@ begin
end; end;
//Draw an Arc //Draw an Arc
procedure TPostscriptPrinterCanvas.Arc(Left,Top,Right,Bottom, angle1, procedure TPostScriptPrinterCanvas.Arc(Left,Top,Right,Bottom, angle1,
angle2: Integer); angle2: Integer);
var xScale : Real; var xScale : Real;
yScale : Real; yScale : Real;
@ -1630,7 +1699,7 @@ begin
Changed; Changed;
end; end;
procedure TPostscriptPrinterCanvas.RadialPie(Left, Top, Right, Bottom, angle1, procedure TPostScriptPrinterCanvas.RadialPie(Left, Top, Right, Bottom, angle1,
angle2: Integer); angle2: Integer);
var xScale : Real; var xScale : Real;
yScale : Real; yScale : Real;
@ -1686,7 +1755,7 @@ begin
end; end;
//Out the text at the X,Y coord. Set the font //Out the text at the X,Y coord. Set the font
procedure TPostscriptPrinterCanvas.TextOut(X, Y: Integer; const Text: String); procedure TPostScriptPrinterCanvas.TextOut(X, Y: Integer; const Text: String);
Var PenUnder : Real; Var PenUnder : Real;
PosUnder : Integer; PosUnder : Integer;
begin begin
@ -1716,7 +1785,7 @@ begin
MoveToLastPos; MoveToLastPos;
end; end;
function TPostscriptPrinterCanvas.TextExtent(const Text: string): TSize; function TPostScriptPrinterCanvas.TextExtent(const Text: string): TSize;
Var IndexFont,i : Integer; Var IndexFont,i : Integer;
FontName : string; FontName : string;
c: Char; c: Char;
@ -1748,14 +1817,14 @@ begin
end; end;
//Draw an Picture //Draw an Picture
procedure TPostscriptPrinterCanvas.Draw(X, Y: Integer; SrcGraphic: TGraphic); procedure TPostScriptPrinterCanvas.Draw(X, Y: Integer; SrcGraphic: TGraphic);
begin begin
if not Assigned(SrcGraphic) then exit; if not Assigned(SrcGraphic) then exit;
StretchDraw(Rect(X,Y,X+SrcGraphic.Width,Y+SrcGraphic.Height),SrcGraphic); StretchDraw(Rect(X,Y,X+SrcGraphic.Width,Y+SrcGraphic.Height),SrcGraphic);
end; end;
//Draw an picture with scale size //Draw an picture with scale size
procedure TPostscriptPrinterCanvas.StretchDraw(const DestRect: TRect; SrcGraphic: TGraphic); procedure TPostScriptPrinterCanvas.StretchDraw(const DestRect: TRect; SrcGraphic: TGraphic);
var X1,Y1,X2,Y2 : Integer; var X1,Y1,X2,Y2 : Integer;
DrawWidth : Integer; DrawWidth : Integer;
DrawHeight: Integer; DrawHeight: Integer;
@ -1802,13 +1871,13 @@ begin
Changed; Changed;
end; end;
procedure TPostscriptPrinterCanvas.Arc(x, y, Right, Bottom, SX, SY, EX, procedure TPostScriptPrinterCanvas.Arc(x, y, Right, Bottom, SX, SY, EX,
EY: Integer); EY: Integer);
begin begin
//Not implemented //Not implemented
end; end;
procedure TPostscriptPrinterCanvas.Chord(x1, y1, x2, y2, angle1,angle2: Integer); procedure TPostScriptPrinterCanvas.Chord(x1, y1, x2, y2, angle1,angle2: Integer);
var xScale : Real; var xScale : Real;
yScale : Real; yScale : Real;
cX, cY : Real; cX, cY : Real;
@ -1853,59 +1922,59 @@ begin
Changed; Changed;
end; end;
procedure TPostscriptPrinterCanvas.Chord(x1, y1, x2, y2, SX, SY, EX, EY: Integer); procedure TPostScriptPrinterCanvas.Chord(x1, y1, x2, y2, SX, SY, EX, EY: Integer);
begin begin
//Not implemented //Not implemented
end; end;
procedure TPostscriptPrinterCanvas.Frame3d(var ARect: TRect; procedure TPostScriptPrinterCanvas.Frame3d(var ARect: TRect;
const FrameWidth: integer; const Style: TGraphicsBevelCut); const FrameWidth: integer; const Style: TGraphicsBevelCut);
begin begin
//Not implemented //Not implemented
end; end;
procedure TPostscriptPrinterCanvas.Pie(EllipseX1, EllipseY1, EllipseX2, procedure TPostScriptPrinterCanvas.Pie(EllipseX1, EllipseY1, EllipseX2,
EllipseY2, StartX, StartY, EndX, EndY: Integer); EllipseY2, StartX, StartY, EndX, EndY: Integer);
begin begin
//Not implemented //Not implemented
end; end;
procedure TPostscriptPrinterCanvas.TextRect(ARect: TRect; X, Y: integer; procedure TPostScriptPrinterCanvas.TextRect(ARect: TRect; X, Y: integer;
const Text: string; const Style: TTextStyle); const Text: string; const Style: TTextStyle);
begin begin
//Not implemented //Not implemented
end; end;
procedure TPostscriptPrinterCanvas.FloodFill(X, Y: Integer; FillColor: TColor; FillStyle: TFillStyle); procedure TPostScriptPrinterCanvas.FloodFill(X, Y: Integer; FillColor: TColor; FillStyle: TFillStyle);
begin begin
//Not implemented //Not implemented
end; end;
procedure TPostscriptPrinterCanvas.CopyRect(const Dest: TRect; procedure TPostScriptPrinterCanvas.CopyRect(const Dest: TRect;
SrcCanvas: TCanvas; const Source: TRect); SrcCanvas: TCanvas; const Source: TRect);
begin begin
//Not implemented //Not implemented
end; end;
{ TPostscriptCanvas } { TPostScriptCanvas }
constructor TPostscriptCanvas.Create; constructor TPostScriptCanvas.Create;
begin begin
Inherited Create(nil); Inherited Create(nil);
end; end;
procedure TPostscriptCanvas.BeginDoc; procedure TPostScriptCanvas.BeginDoc;
begin begin
inherited BeginDoc; inherited BeginDoc;
end; end;
procedure TPostscriptCanvas.EndDoc; procedure TPostScriptCanvas.EndDoc;
begin begin
inherited EndDoc; inherited EndDoc;
end; end;
procedure TPostscriptCanvas.NewPage; procedure TPostScriptCanvas.NewPage;
begin begin
inherited NewPage; inherited NewPage;
end; end;