+ Added header to all files

+ Added const to calls that accept structure as arguments.
+ Re-Implemented TPostscriptcanvas as descendent of TFPCustomCanvas
  (initial tests work)

fcl/image/Makefile

@@ -1,5 +1,5 @@
 #
-# Don't edit, this file is generated by FPCMake Version 1.1 [2003/07/11]
+# Don't edit, this file is generated by FPCMake Version 1.1 [2003/06/26]
 #
 default: all
 MAKEFILETARGETS=linux go32v2 win32 os2 freebsd beos netbsd amiga atari sunos qnx netware openbsd wdosx palmos macos darwin emx
@@ -204,7 +204,7 @@ UNITSDIR:=$(wildcard $(FPCDIR)/units/$(OS_TARGET))
 endif
 PACKAGESDIR:=$(wildcard $(FPCDIR) $(FPCDIR)/packages/base $(FPCDIR)/packages/extra)
 override PACKAGE_NAME=fcl
-override TARGET_UNITS+=fpimgcmn fpimage pngcomn fpreadpng  fpreadxpm fpwritexpm clipping fpcanvas pixtools fppixlcanv fpimgcanv
+override TARGET_UNITS+=fpimgcmn fpimage pngcomn fpreadpng  fpreadxpm fpwritexpm clipping fpcanvas pixtools fppixlcanv fpimgcanv pscanvas
 override TARGET_EXAMPLES+=imgconv
 override INSTALL_FPCPACKAGE=y
 override COMPILER_TARGETDIR+=../$(OS_TARGET)

fcl/image/Makefile.fpc

@@ -10,7 +10,7 @@ packages=paszlib
 
 [target]
 units=fpimgcmn fpimage pngcomn fpreadpng  fpreadxpm fpwritexpm clipping \
-      fpcanvas pixtools fppixlcanv fpimgcanv  
+      fpcanvas pixtools fppixlcanv fpimgcanv pscanvas
 examples=imgconv
 
 [compiler]

fcl/image/clipping.pp

@@ -1,3 +1,18 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2003 by the Free Pascal development team
+
+    Clipping support.
+    
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
 {$mode objfpc}{$h+}
 unit Clipping;
 

fcl/image/fpbrush.inc

@@ -1,3 +1,18 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2003 by the Free Pascal development team
+
+    TFPCustomBrush implementation.
+    
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
 { TFPCustomBrush }
 
 procedure TFPCustomBrush.SetStyle (AValue : TFPBrushStyle);

fcl/image/fpcanvas.inc

@@ -1,3 +1,18 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2003 by the Free Pascal development team
+
+    TFPCustomCanvas implementation.
+    
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
 { TFPCustomCanvas }
 
 constructor TFPCustomCanvas.Create;
@@ -326,13 +341,13 @@ begin
   Line (p1.x,p1.y,p2.x,p2.y);
 end;
 
-procedure TFPCustomCanvas.Line (points:TRect);
+procedure TFPCustomCanvas.Line (const points:TRect);
 begin
   with points do
     Line (left,top, right,bottom);
 end;
 
-procedure TFPCustomCanvas.Polyline (points:array of TPoint);
+procedure TFPCustomCanvas.Polyline (Const points:array of TPoint);
 begin
   if Pen.Style <> psClear then
    if Pen is TFPCustomDrawPen then
@@ -357,25 +372,25 @@ begin
     end;
 end;
 
-procedure TFPCustomCanvas.DoRectangleAndFill (Bounds:TRect);
+procedure TFPCustomCanvas.DoRectangleAndFill (const Bounds:TRect);
 begin
   DoRectangleFill (Bounds);
   DoRectangle (Bounds);
 end;
 
-procedure TFPCustomCanvas.DoEllipseAndFill (Bounds:TRect);
+procedure TFPCustomCanvas.DoEllipseAndFill (const Bounds:TRect);
 begin
   DoEllipseFill (Bounds);
   DoEllipse (Bounds);
 end;
 
-procedure TFPCustomCanvas.DoPolygonAndFill (points:array of TPoint);
+procedure TFPCustomCanvas.DoPolygonAndFill (const points:array of TPoint);
 begin
   DoPolygonFill (points);
   DoPolygon (points);
 end;
 
-procedure TFPCustomCanvas.Ellipse (Bounds:TRect);
+procedure TFPCustomCanvas.Ellipse (const Bounds:TRect);
 var p,b,dp,db,pb : boolean;
 begin
   p := Pen.style <> psClear;
@@ -424,7 +439,7 @@ begin
   Rectangle (Rect(left,top,right,bottom));
 end;
 
-procedure TFPCustomCanvas.Rectangle (Bounds:TRect);
+procedure TFPCustomCanvas.Rectangle (const Bounds:TRect);
 var p,b,dp,db,pb : boolean;
 begin
   p := Pen.style <> psClear;
@@ -473,7 +488,7 @@ begin
     end;
 end;
 
-procedure TFPCustomCanvas.Polygon (points:array of TPoint);
+procedure TFPCustomCanvas.Polygon (const points:array of TPoint);
 var p,b,dp,db,pb : boolean;
 begin
   p := Pen.style <> psClear;

fcl/image/fpcanvas.pp

@@ -1,3 +1,18 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2003 by the Free Pascal development team
+
+    Basic canvas definitions.
+    
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
 {$mode objfpc}{$h+}
 unit FPCanvas;
 
@@ -151,7 +166,8 @@ type
     function  DoAllowPen (APen : TFPCustomPen) : boolean; virtual;
     function  DoAllowBrush (ABrush : TFPCustomBrush) : boolean; virtual;
     procedure SetColor (x,y:integer; Value:TFPColor); Virtual; abstract;
-    function  GetColor (x,y:integer) : TFPColor; Virtual; abstract;    procedure SetHeight (AValue : integer); virtual; abstract;
+    function  GetColor (x,y:integer) : TFPColor; Virtual; abstract;    
+    procedure SetHeight (AValue : integer); virtual; abstract;
     function  GetHeight : integer; virtual; abstract;
     procedure SetWidth (AValue : integer); virtual; abstract;
     function  GetWidth : integer; virtual; abstract;
@@ -161,16 +177,16 @@ type
     procedure DoGetTextSize (text:string; var w,h:integer); virtual; abstract;
     function  DoGetTextHeight (text:string) : integer; virtual; abstract;
     function  DoGetTextWidth (text:string) : integer; virtual; abstract;
-    procedure DoRectangle (Bounds:TRect); virtual; abstract;
+    procedure DoRectangle (Const Bounds:TRect); virtual; abstract;
-    procedure DoRectangleFill (Bounds:TRect); virtual; abstract;
+    procedure DoRectangleFill (Const Bounds:TRect); virtual; abstract;
-    procedure DoRectangleAndFill (Bounds:TRect); virtual;
+    procedure DoRectangleAndFill (Const Bounds:TRect); virtual;
-    procedure DoEllipseFill (Bounds:TRect); virtual; abstract;
+    procedure DoEllipseFill (Const Bounds:TRect); virtual; abstract;
-    procedure DoEllipse (Bounds:TRect); virtual; abstract;
+    procedure DoEllipse (Const Bounds:TRect); virtual; abstract;
-    procedure DoEllipseAndFill (Bounds:TRect); virtual;
+    procedure DoEllipseAndFill (Const Bounds:TRect); virtual;
-    procedure DoPolygonFill (points:array of TPoint); virtual; abstract;
+    procedure DoPolygonFill (const points:array of TPoint); virtual; abstract;
-    procedure DoPolygon (points:array of TPoint); virtual; abstract;
+    procedure DoPolygon (const points:array of TPoint); virtual; abstract;
-    procedure DoPolygonAndFill (points:array of TPoint); virtual;
+    procedure DoPolygonAndFill (const points:array of TPoint); virtual;
-    procedure DoPolyline (points:array of TPoint); virtual; abstract;
+    procedure DoPolyline (const points:array of TPoint); virtual; abstract;
     procedure DoFloodFill (x,y:integer); virtual; abstract;
     procedure DoMoveTo (x,y:integer); virtual;
     procedure DoLineTo (x,y:integer); virtual;
@@ -193,11 +209,11 @@ type
     function GetTextHeight (text:string) : integer;
     function GetTextWidth (text:string) : integer;
     // using pen and brush
-    procedure Ellipse (Bounds:TRect);
+    procedure Ellipse (Const Bounds:TRect);
     procedure Ellipse (left,top,right,bottom:integer);
-    procedure Polygon (points:array of TPoint);
+    procedure Polygon (Const points:array of TPoint);
-    procedure Polyline (points:array of TPoint);
+    procedure Polyline (Const points:array of TPoint);
-    procedure Rectangle (Bounds:TRect);
+    procedure Rectangle (Const Bounds:TRect);
     procedure Rectangle (left,top,right,bottom:integer);
     // using brush
     procedure FloodFill (x,y:integer);
@@ -209,7 +225,7 @@ type
     procedure LineTo (p:TPoint);
     procedure Line (x1,y1,x2,y2:integer);
     procedure Line (p1,p2:TPoint);
-    procedure Line (points:TRect);
+    procedure Line (const points:TRect);
     // other procedures
     procedure CopyRect (x,y:integer; canvas:TFPCustomCanvas; SourceRect:TRect);
     procedure Draw (x,y:integer; image:TFPCustomImage);

fcl/image/fpcdrawh.inc

@@ -1,3 +1,18 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2003 by the Free Pascal development team
+
+    TDrawObjects implementation.
+    
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
 { TFPCustomDrawPen }
 
 procedure TFPCustomDrawPen.DrawLine (x1,y1,x2,y2:integer);

fcl/image/fpcolcnv.inc

@@ -1,3 +1,19 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2003 by the Free Pascal development team
+
+    Some color conversion routines.
+    
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
 function FillOtherBits (initial:word;CorrectBits:byte):word;
 var r,c : byte;
 begin

fcl/image/fpcolors.inc

@@ -1,3 +1,18 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2003 by the Free Pascal development team
+
+    Color definitions and functions.
+    
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
 const
   BytesNeeded : array[TColorFormat] of byte =
       (1,1,1,1,2,3,1,2,4,2,2,3,4,6,1,2,4,8,2,2,3,4,6,1,2,4,8);

fcl/image/fpfont.inc

@@ -1,3 +1,18 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2003 by the Free Pascal development team
+
+    Implementation of TFPCustomFont
+    
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
 { FPCustomFont }
 
 procedure TFPCustomFont.SetName (AValue:string);

fcl/image/fphandler.inc

@@ -1,3 +1,18 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2003 by the Free Pascal development team
+
+    TImageHandlers implementations
+    
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
 { TImageHandlersManager }
 
 constructor TImageHandlersManager.Create;

fcl/image/fphelper.inc

@@ -1,3 +1,18 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2003 by the Free Pascal development team
+
+    Implementation of TFPCanvasHelper
+    
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
 { TFPCanvasHelper }
 
 constructor TFPCanvasHelper.Create;

fcl/image/fpimage.inc

@@ -1,3 +1,18 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2003 by the Free Pascal development team
+
+    TFPCustomImage implementation.
+    
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
 { TFPCustomImage }
 
 constructor TFPCustomImage.create (AWidth,AHeight:integer);

fcl/image/fpimage.pp

@@ -1,3 +1,18 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2003 by the Free Pascal development team
+
+    fpImage base definitions.
+    
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
 {$mode objfpc}{$h+}
 unit FPimage;
 

fcl/image/fpimgcanv.pp

@@ -1,3 +1,18 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2003 by the Free Pascal development team
+
+    Image Canvas - canvas which draws on an image.
+    
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
 {$mode objfpc}{$h+}
 unit FPImgCanv;
 

fcl/image/fpimgcmn.pp

@@ -1,3 +1,18 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2003 by the Free Pascal development team
+
+    Auxiliary routines for image support.
+    
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
 {$mode objfpc}{$h+}
 unit FPImgCmn;
 

fcl/image/fppalette.inc

@@ -1,3 +1,18 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2003 by the Free Pascal development team
+
+    TFPPalette implementation.
+    
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
 { TFPPalette }
 
 constructor TFPPalette.create (ACount : integer);

fcl/image/fppen.inc

@@ -1,3 +1,18 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2003 by the Free Pascal development team
+
+    TFPCustomPen implementation
+    
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
 { TFPCustomPen }
 
 procedure TFPCustomPen.SetMode (AValue : TFPPenMode);

fcl/image/fppixlcanv.pp

@@ -1,3 +1,18 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2003 by the Free Pascal development team
+
+    TPixelCanvas class.
+    
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
 {$mode objfpc}{$h+}
 unit FPPixlCanv;
 

fcl/image/fpreadpng.pp

@@ -1,3 +1,18 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2003 by the Free Pascal development team
+
+    PNG reader implementation
+    
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
 {$mode objfpc}{$h+}
 unit FPReadPNG;
 

fcl/image/fpreadxpm.pp

@@ -1,3 +1,18 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2003 by the Free Pascal development team
+
+    XPM reader class.
+    
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
 {$mode objfpc}{$h+}
 unit FPReadXPM;
 

fcl/image/fpwritexpm.pp

@@ -1,3 +1,18 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2003 by the Free Pascal development team
+
+    XPM writer implementation.
+    
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
 {$mode objfpc}{$h+}
 unit FPWriteXPM;
 

fcl/image/imgconv.pp

@@ -1,3 +1,18 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2003 by the Free Pascal development team
+
+    Image conversion example.
+    
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
 {$mode objfpc}{$h+}
 program ImgConv;
 

fcl/image/pixtools.pp

@@ -1,3 +1,18 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2003 by the Free Pascal development team
+
+    Pixel drawing routines.
+    
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
 {$mode objfpc}{$h+}
 unit PixTools;
 

fcl/image/pngcomn.pp

@@ -1,3 +1,18 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2003 by the Free Pascal development team
+
+    PNG reader/writer common code.
+    
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
 {$mode objfpc}{$h+}
 unit PNGcomn;
 

fcl/image/pscanvas.pp

@@ -0,0 +1,939 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2003 by the Free Pascal development team
+
+    TPostScriptCanvas implementation.
+    
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+{ ---------------------------------------------------------------------
+  This code is heavily based on Tony Maro's initial TPostScriptCanvas
+  implementation in the LCL, but was adapted to work with the custom
+  canvas code and to work with streams instead of strings.
+  ---------------------------------------------------------------------}
+  
+
+{$mode objfpc}
+{$H+}
+
+unit pscanvas;
+
+interface
+
+uses
+  Classes, SysUtils,fpimage,fpcanvas;
+  
+type
+  TPostScript = class;
+
+  TPSPaintType = (ptColored, ptUncolored);
+  TPSTileType = (ttConstant, ttNoDistortion, ttFast);
+  TPostScriptCanvas = class; // forward reference
+
+  {Remember, modifying a pattern affects that pattern for the ENTIRE document!}
+  TPSPattern = class(TFPCanvasHelper)
+  private
+    FStream : TMemoryStream;
+    FPatternCanvas : TPostScriptCanvas;
+    FOldName: String;
+    FOnChange: TNotifyEvent;
+    FBBox: TRect;
+    FName: String;
+    FPaintType: TPSPaintType;
+    FPostScript: TStringList;
+    FTilingType: TPSTileType;
+    FXStep: Real;
+    FYStep: Real;
+    function GetpostScript: TStringList;
+    procedure SetBBox(const AValue: TRect);
+    procedure SetName(const AValue: String);
+    procedure SetPaintType(const AValue: TPSPaintType);
+    procedure SetTilingType(const AValue: TPSTileType);
+    procedure SetXStep(const AValue: Real);
+    procedure SetYStep(const AValue: Real);
+  protected
+  public
+    constructor Create;
+    destructor Destroy; override;
+    procedure Changed;
+    property BBox: TRect read FBBox write SetBBox;
+    property PaintType: TPSPaintType read FPaintType write SetPaintType;
+    property TilingType: TPSTileType read FTilingType write SetTilingType;
+    property XStep: Real read FXStep write SetXStep;
+    property YStep: Real read FYStep write SetYStep;
+    property Name: String read FName write SetName;
+    property GetPS: TStringList read GetPostscript;
+    property OldName: string read FOldName write FOldName; // used when notifying that name changed
+    property OnChange: TNotifyEvent read FOnChange write FOnChange;
+    Property PatternCanvas : TPostScriptCanvas Read FPatternCanvas;
+  end;
+  PPSPattern = ^TPSPattern; // used for array
+
+  { Pen and brush object both right now...}
+  TPSPen = class(TFPCustomPen)
+  private
+    FPattern: TPSPattern;
+    procedure SetPattern(const AValue: TPSPattern);
+  public
+    destructor Destroy; override;
+    property Pattern: TPSPattern read FPattern write SetPattern;
+    function AsString: String;
+  end;
+
+  TPSBrush = Class(TFPCustomBrush)
+  Private 
+    Function GetAsString : String;
+  Public
+    Property AsString : String Read GetAsString;
+  end;
+
+  TPSFont = Class(TFPCustomFont)
+  end;
+
+  { Custom canvas-like object that handles postscript code }
+  TPostScriptCanvas = class(TFPCustomCanvas)
+  private
+    FHeight,FWidth : Integer;
+    FStream : TStream;
+    FLineSpacing: Integer;
+    LastX: Integer;
+    LastY: Integer;
+    function TranslateY(Ycoord: Integer): Integer; // Y axis is backwards in postscript
+    procedure AddFill;
+    procedure ResetPos; // reset back to last moveto location
+    procedure SetWidth (AValue : integer); override;
+    function  GetWidth : integer; override;
+    procedure SetHeight (AValue : integer); override;
+    function  GetHeight : integer; override;
+  Protected
+    Procedure WritePS(Const Cmd : String);
+    Procedure WritePS(Const Fmt : String; Args : Array of Const);
+    procedure DrawRectangle(const Bounds: TRect; DoFill : Boolean);
+    procedure DrawEllipse(const Bounds: TRect; DoFill : Boolean);
+  public
+    constructor Create(AStream : TStream);
+    destructor Destroy; override;
+    function DoCreateDefaultFont : TFPCustomFont; override;
+    function DoCreateDefaultPen : TFPCustomPen; override;
+    function DoCreateDefaultBrush : TFPCustomBrush; override;
+    property LineSpacing: Integer read FLineSpacing write FLineSpacing;
+    Procedure DoMoveTo(X1,Y1 : Integer); override;
+    Procedure DoLineTo(X1,Y1 : Integer); override;
+    Procedure DoLine(X1,Y1,X2,Y2 : Integer); override;
+    Procedure DoRectangle(Const Bounds : TRect); override;
+    Procedure DoRectangleFill(Const Bounds : TRect); override;
+    procedure DoPolyline(Const Points: Array of TPoint); override;
+    procedure DoEllipse(const Bounds: TRect); override;
+    procedure DoEllipseFill(const Bounds: TRect); override;
+    procedure DoPie(x,y,awidth,aheight,angle1,angle2 : Integer);
+    //procedure Pie(x,y,width,height,SX,SY,EX,EY : Integer);
+    procedure Writeln(AString: String);
+    procedure TextOut(X,Y: Integer; const Text: String);
+    //procedure Chord(x,y,width,height,angle1,angle2 : Integer);
+    //procedure Chord(x,y,width,height,SX,SY,EX,EY : Integer);
+    //procedure PolyBezier(Points: PPoint; NumPts: Integer;
+    //                     Filled: boolean{$IFDEF VER1_1} = False{$ENDIF};
+    //                     Continuous: boolean{$IFDEF VER1_1} = False{$ENDIF});
+    //procedure PolyBezier(const Points: array of TPoint;
+    //                     Filled: boolean{$IFDEF VER1_1} = False{$ENDIF};
+    //                     Continuous: boolean{$IFDEF VER1_1} = False{$ENDIF});
+    //procedure PolyBezier(const Points: array of TPoint);
+    //procedure Polygon(const Points: array of TPoint;
+    //                  Winding: Boolean{$IFDEF VER1_1} = False{$ENDIF};
+    //                  StartIndex: Integer{$IFDEF VER1_1} = 0{$ENDIF};
+    //                  NumPts: Integer {$IFDEF VER1_1} = -1{$ENDIF});
+    //procedure Polygon(Points: PPoint; NumPts: Integer;
+    //                  Winding: boolean{$IFDEF VER1_1} = False{$ENDIF});
+    //Procedure Polygon(const Points: array of TPoint);
+    //Procedure FillRect(const Rect : TRect);
+    //procedure FloodFill(X, Y: Integer; FillColor: TFPColor; FillStyle: TFillStyle);
+    //Procedure RoundRect(X1, Y1, X2, Y2: Integer; RX,RY : Integer);
+    //Procedure RoundRect(const Rect : TRect; RX,RY : Integer);
+    Property Stream : TStream read FStream;
+  end;
+
+  { Encapsulates ALL the postscript and uses the TPostScriptCanvas object for a single page }
+  TPostScript = class(TComponent)
+  private
+    FDocStarted : Boolean;
+    FCreator : String;
+    FStream : TStream;
+    FCanvas: TPostScriptCanvas;
+    FHeight: Integer;
+    FLineSpacing: Integer;
+    FPageNumber: Integer;
+    FTitle: String;
+    FWidth: Integer;
+    FPatterns: TList;   // array of pointers to pattern objects
+    procedure SetHeight(const AValue: Integer);
+    procedure SetLineSpacing(const AValue: Integer);
+    procedure SetWidth(const AValue: Integer);
+    procedure UpdateBoundingBox;
+    procedure PatternChanged(Sender: TObject);
+    procedure InsertPattern(APattern: TPSPattern); // adds the pattern to the postscript
+    Procedure SetStream (Value : TStream);
+    Function GetCreator : String;
+  Protected
+    Procedure WritePS(Const Cmd : String);
+    Procedure WritePS(Const Fmt : String; Args : Array of Const);
+    Procedure WriteDocumentHeader; virtual;
+    Procedure WriteStandardFont; virtual;
+    Procedure WritePage; virtual;
+    Procedure FreePatterns;
+    Procedure CheckStream;
+  public
+    Constructor Create(AOwner : TComponent);
+    destructor Destroy; override;
+   
+    procedure AddPattern(APSPattern: TPSPattern);
+    function FindPattern(AName: String): TPSPattern;
+    function DelPattern(AName: String): Boolean;
+    function NewPattern(AName: String): TPSPattern;
+    property Canvas: TPostScriptCanvas read FCanvas;
+    property Height: Integer read FHeight write SetHeight;
+    property Width: Integer read FWidth write SetWidth;
+    property PageNumber: Integer read FPageNumber;
+    property Title: String read FTitle write FTitle;
+    property LineSpacing: Integer read FLineSpacing write SetLineSpacing;
+    procedure BeginDoc;
+    procedure NewPage;
+    procedure EndDoc;
+    Property Stream : TStream Read FStream Write SetStream;
+    Property Creator : String Read GetCreator Write FCreator;
+  end;
+
+implementation
+
+Resourcestring
+  SErrNoStreamAssigned = 'Invalid operation: No stream assigned';
+  SErrDocumentAlreadyStarted = 'Cannot start document twice.';
+  
+{ TPostScriptCanvas ----------------------------------------------------------}
+
+Procedure TPostScriptCanvas.WritePS(const Cmd : String);
+
+begin
+  If length(Cmd)>0 then
+    FStream.Write(Cmd[1],Length(Cmd));
+  FStream.Write(LineEnding,SizeOf(LineEnding));
+end;
+
+Procedure TPostScriptCanvas.WritePS(Const Fmt : String; Args : Array of Const);
+
+begin
+  WritePS(Format(Fmt,Args));
+end;
+
+{ Y coords in postscript are backwards... }
+function TPostScriptCanvas.TranslateY(Ycoord: Integer): Integer;
+begin
+  Result:=Height-Ycoord;
+end;
+
+{ Adds a fill finishing line to any path we desire to fill }
+procedure TPostScriptCanvas.AddFill;
+begin
+  WritePs('gsave '+(Brush as TPSBrush).AsString+' fill grestore');
+end;
+
+{ Return to last moveto location }
+procedure TPostScriptCanvas.ResetPos;
+begin
+  WritePS(inttostr(LastX)+' '+inttostr(TranslateY(LastY))+' moveto');
+end;
+
+constructor TPostScriptCanvas.Create(AStream : TStream);
+
+begin
+  inherited create;
+  FStream:=AStream;
+  Height := 792; // length of page in points at 72 ppi
+  { // Choose a standard font in case the user doesn't
+  FFontFace := 'AvantGarde-Book';
+  SetFontSize(10);
+    FLineSpacing := MPostScript.LineSpacing;
+  end;
+  FPen := TPSPen.Create;
+  FPen.Width := 1;
+  FPen.Color := 0;
+  FPen.OnChange := @PenChanged;
+     
+  FBrush := TPSPen.Create;
+  FBrush.Width := 1;
+  FBrush.Color := -1;
+  // don't notify us that the brush changed...
+  }
+end;
+
+destructor TPostScriptCanvas.Destroy;
+begin
+{
+  FPostScript.Free;
+  FPen.Free;
+  FBrush.Free;
+}
+  inherited Destroy;
+end;
+
+procedure TPostScriptCanvas.SetWidth (AValue : integer); 
+
+begin
+  FWidth:=AValue;
+end;
+
+function  TPostScriptCanvas.GetWidth : integer; 
+
+begin
+  Result:=FWidth;
+end;
+
+procedure TPostScriptCanvas.SetHeight (AValue : integer); 
+
+begin
+  FHeight:=AValue;
+end;
+
+function  TPostScriptCanvas.GetHeight : integer; 
+
+begin
+  Result:=FHeight;
+end;
+
+
+{ Move draw location }
+procedure TPostScriptCanvas.DoMoveTo(X1, Y1: Integer);
+
+var
+  Y: Integer;
+   
+begin
+  Y := TranslateY(Y1);
+  WritePS(inttostr(X1)+' '+inttostr(Y)+' moveto');
+  LastX := X1;
+  LastY := Y1;
+end;
+
+{ Draw a line from current location to these coords }
+procedure TPostScriptCanvas.DoLineTo(X1, Y1: Integer);
+
+var
+   Y: Integer;
+   
+begin
+  Y := TranslateY(Y1);
+  WritePS(inttostr(X1)+' '+inttostr(Y)+' lineto');
+  LastX := X1;
+  LastY := Y1;
+end;
+
+procedure TPostScriptCanvas.DoLine(X1, Y1, X2, Y2: Integer);
+var
+  Y12, Y22: Integer;
+  
+begin
+  Y12 := TranslateY(Y1);
+  Y22 := TranslateY(Y2);
+  WritePS('newpath '+inttostr(X1)+' '+inttostr(Y12)+' moveto '+
+          inttostr(X2)+' '+inttostr(Y22)+' lineto closepath stroke');
+  // go back to last moveto position
+  ResetPos;
+end;
+
+{ Draw a rectangle }
+
+procedure TPostScriptCanvas.DoRectangleFill(const Bounds: TRect);
+
+begin
+  DrawRectangle(Bounds,true)
+end;
+
+procedure TPostScriptCanvas.DoRectangle(const Bounds: TRect);
+
+begin
+  DrawRectangle(Bounds,False);
+end;
+
+procedure TPostScriptCanvas.DrawRectangle(const Bounds: TRect; DoFill : Boolean);
+
+var
+   Y12, Y22: Integer;
+   
+begin
+  Y12 := TranslateY(Bounds.Top);
+  Y22 := TranslateY(Bounds.Bottom);
+  WritePS('stroke newpath');
+  With Bounds do
+    begin
+    WritePS(inttostr(Left)+' '+inttostr(Y12)+' moveto');
+    WritePS(inttostr(Right)+' '+inttostr(Y12)+' lineto');
+    WritePS(inttostr(Right)+' '+inttostr(Y22)+' lineto');
+    WritePS(inttostr(Left)+' '+inttostr(Y22)+' lineto');
+    end;
+  WritePS('closepath');
+  If DoFill and (Brush.Style<>bsClear) then 
+    AddFill;
+  WritePS('stroke');
+  ResetPos;
+end;
+
+{ Draw a series of lines }
+procedure TPostScriptCanvas.DoPolyline(Const Points: Array of TPoint);
+var
+  i : Longint;
+begin
+  MoveTo(Points[0].X, Points[0].Y);
+  For i := 1 to High(Points) do
+    LineTo(Points[i].X, Points[i].Y);
+  ResetPos;
+end;
+
+{ This was a pain to figure out... }
+
+procedure TPostScriptCanvas.DoEllipse(Const Bounds : TRect);
+
+begin
+  DrawEllipse(Bounds,False);
+end;
+
+procedure TPostScriptCanvas.DoEllipseFill(Const Bounds : TRect);
+
+begin
+  DrawEllipse(Bounds,true);
+end;
+
+procedure TPostScriptCanvas.DrawEllipse(Const Bounds : TRect; DoFill : Boolean);
+
+var
+  radius: Integer;
+  YRatio: Real;
+  centerX, centerY: Integer;
+   
+begin
+  // set radius to half the width
+  With Bounds do
+    begin
+    radius := (Right-Left) div 2;
+    if radius <1 then 
+      exit; 
+    YRatio := (Bottom - Top) / (Right-Left);
+    // find center
+    CenterX := (Right+Left) div 2;
+    CenterY := (Top+Bottom) div 2;
+    end;
+  WritePS('newpath '+inttostr(CenterX)+' '+inttostr(TranslateY(CenterY))+' translate');
+  // move to edge
+  WritePS(inttostr(radius)+' 0 moveto');
+  // now draw it
+  WritePS('gsave 1 '+format('%.3f',[YRatio])+' scale');
+  WritePS('0 0 '+inttostr(radius)+' 0 360 arc');
+  if DoFill and (Brush.Style<>bsClear) then 
+    AddFill;
+  // reset scale for drawing line thickness so it doesn't warp
+  YRatio := 1 / YRatio;
+  WritePS('1 '+format('%.2f',[YRatio])+' scale stroke grestore');
+  // move origin back
+  WritePS(inttostr(-CenterX)+' '+inttostr(-TranslateY(CenterY))+' translate closepath stroke');
+  ResetPos;
+end;
+
+procedure TPostScriptCanvas.DoPie(x, y, AWidth, AHeight, angle1, angle2: Integer);
+begin
+  // set zero at center
+  WritePS('newpath '+inttostr(X)+' '+inttostr(TranslateY(Y))+' translate');
+  // scale it
+  WritePS('gsave '+inttostr(AWidth)+' '+inttostr(Aheight)+' scale');
+  //WritePS('gsave 1 1 scale');
+  // draw line to edge
+  WritePS('0 0 moveto');
+  WritePS('0 0 1 '+inttostr(angle1)+' '+inttostr(angle2)+' arc closepath');
+  if Brush.Style<>bsClear then 
+    AddFill;
+  // reset scale so we don't change the line thickness
+  // adding 0.01 to compensate for scaling error - there may be a deeper problem here...
+  WritePS(format('%.6f',[(real(1) / X)+0.01])+' '+format('%.6f',[(real(1) / Y)+0.01])+' scale stroke grestore');
+  // close out and return origin
+  WritePS(inttostr(-X)+' '+inttostr(-TranslateY(Y))+' translate closepath stroke');
+  resetpos;
+end;
+
+{ Writes text with a carriage return }
+procedure TPostScriptCanvas.Writeln(AString: String);
+begin
+  TextOut(LastX, LastY, AString);
+  LastY := LastY+Font.Size+FLineSpacing;
+  MoveTo(LastX, LastY);
+end;
+
+
+{ Output text, restoring draw location }
+procedure TPostScriptCanvas.TextOut(X, Y: Integer; const Text: String);
+var
+   Y1: Integer;
+begin
+  Y1 := TranslateY(Y);
+  WritePS(inttostr(X)+' '+inttostr(Y1)+' moveto');
+  WritePS('('+Text+') show');
+  ResetPos; // move back to last moveto location
+end;
+
+function TPostScriptCanvas.DoCreateDefaultFont : TFPCustomFont;
+
+begin
+  Result:=TPSFont.Create;
+end;
+
+
+function TPostScriptCanvas.DoCreateDefaultPen : TFPCustomPen;
+
+begin
+  Result:=TPSPen.Create;
+end;
+
+function TPostScriptCanvas.DoCreateDefaultBrush : TFPCustomBrush; 
+
+begin
+  Result:=TPSBrush.Create;
+end;
+
+
+
+{ TPostScript -------------------------------------------------------------- }
+
+procedure TPostScript.SetHeight(const AValue: Integer);
+begin
+  if FHeight=AValue then exit;
+  FHeight:=AValue;
+  UpdateBoundingBox;
+  // filter down to the canvas height property
+  if assigned(FCanvas) then 
+    FCanvas.Height := FHeight;
+end;
+
+procedure TPostScript.SetLineSpacing(const AValue: Integer);
+begin
+  if FLineSpacing=AValue then exit;
+  FLineSpacing:=AValue;
+  // filter down to the canvas
+  if assigned(FCanvas) then FCanvas.LineSpacing := AValue;
+end;
+
+procedure TPostScript.SetWidth(const AValue: Integer);
+begin
+  if FWidth=AValue then exit;
+    FWidth:=AValue;
+  UpdateBoundingBox;
+end;
+
+{ Take our sizes and change the boundingbox line }
+procedure TPostScript.UpdateBoundingBox;
+begin
+{
+
+     // need to not hard-link this to line 1
+     FDocument[1] := '%%BoundingBox: 0 0 '+inttostr(FWidth)+' '+inttostr(FHeight);
+}
+end;
+
+{ Pattern changed so update the postscript code }
+procedure TPostScript.PatternChanged(Sender: TObject);
+begin
+     // called anytime a pattern changes.  Update the postscript code.
+     // look for and delete the current postscript code for this pattern
+     // then paste the pattern back into the code before the first page
+     InsertPattern(Sender As TPSPattern);
+end;
+
+{ Places a pattern definition into the bottom of the header in postscript }
+procedure TPostScript.InsertPattern(APattern: TPSPattern);
+var
+   I, J: Integer;
+   MyStrings: TStringList;
+begin
+{     I := 0;
+     if FDocument.Count < 1 then begin
+        // added pattern when no postscript exists - this shouldn't happen
+        raise exception.create('Pattern inserted with no postscript existing');
+        exit;
+     end;
+     
+     for I := 0 to FDocument.count - 1 do begin
+         if (FDocument[I] = '%%Page: 1 1') then begin
+            // found it!
+            // insert into just before that
+            MyStrings := APattern.GetPS;
+            for J := 0 to MyStrings.Count - 1 do begin
+                FDocument.Insert(I-1+J, MyStrings[j]);
+            end;
+            exit;
+         end;
+     end;
+}
+end;
+
+constructor TPostScript.Create(AOwner : TComponent);
+begin
+  inherited create(AOwner);
+  // Set some defaults
+  FHeight := 792; // 11 inches at 72 dpi
+  FWidth := 612; // 8 1/2 inches at 72 dpi
+end;
+
+Procedure TPostScript.WritePS(const Cmd : String);
+
+begin
+  If length(Cmd)>0 then
+    FStream.Write(Cmd[1],Length(Cmd));
+  FStream.Write(LineEnding,SizeOf(LineEnding));
+end;
+
+Procedure TPostScript.WritePS(Const Fmt : String; Args : Array of Const);
+
+begin
+  WritePS(Format(Fmt,Args));
+end;
+
+Procedure TPostScript.WriteDocumentHeader;
+
+begin
+  WritePS('%!PS-Adobe-3.0');
+  WritePS('%%BoundingBox: 0 0 612 792');
+  WritePS('%%Creator: '+Creator);
+  WritePS('%%Title: '+FTitle);
+  WritePS('%%Pages: (atend)');
+  WritePS('%%PageOrder: Ascend');
+  WriteStandardFont;
+end;
+
+Procedure TPostScript.WriteStandardFont;
+
+begin
+  // Choose a standard font in case the user doesn't
+  WritePS('/AvantGarde-Book findfont');
+  WritePS('10 scalefont');
+  WritePS('setfont');
+end;
+
+Procedure TPostScript.FreePatterns;
+
+Var
+  i : Integer;
+
+begin
+  If Assigned(FPatterns) then
+    begin
+    For I:=0 to FPatterns.Count-1 do
+      TObject(FPatterns[i]).Free;
+    FreeAndNil(FPatterns);
+    end;
+end;
+
+destructor TPostScript.Destroy;
+
+begin
+  Stream:=Nil;
+  FreePatterns;
+  inherited Destroy;
+end;
+
+{ add a pattern to the array }
+procedure TPostScript.AddPattern(APSPattern: TPSPattern);
+begin
+  If Not Assigned(FPatterns) then
+    FPatterns:=Tlist.Create;
+  FPatterns.Add(APSPattern);
+end;
+
+{ Find a pattern object by it's name }
+
+function TPostScript.FindPattern(AName: String): TPSPattern;
+
+var
+   I: Integer;
+   
+begin
+  Result := nil;
+  If Assigned(FPatterns) then
+    begin
+    I:=Fpatterns.Count-1;
+    While (Result=Nil) and (I>=0) do
+      if TPSPattern(FPatterns[I]).Name = AName then 
+        result := TPSPattern(FPatterns[i])
+      else
+        Dec(i)   
+   end;
+end;
+
+function TPostScript.DelPattern(AName: String): Boolean;
+begin
+  // can't do that yet...
+  Result:=false;
+end;
+
+
+{ Create a new pattern and inserts it into the array for safe keeping }
+function TPostScript.NewPattern(AName: String): TPSPattern;
+var
+   MyPattern: TPSPattern;
+begin
+  MyPattern := TPSPattern.Create;
+  AddPattern(MyPattern);
+  MyPattern.Name := AName;
+  MyPattern.OnChange := @PatternChanged;
+  MyPattern.OldName := '';
+  // add this to the postscript now...
+  InsertPattern(MyPattern);
+  result := MyPattern;
+end;
+
+{ Start a new document }
+procedure TPostScript.BeginDoc;
+
+var
+   I: Integer;
+   
+begin
+  CheckStream;
+  If FDocStarted then
+    Raise Exception.Create(SErrDocumentAlreadyStarted);
+  FCanvas:=TPostScriptCanvas.Create(FStream);
+  FCanvas.Height:=Self.Height;
+  FCanvas.Width:=Self.width;
+  FreePatterns;
+  WriteDocumentHeader;    
+  // start our first page
+  FPageNumber := 1;
+  WritePage;
+  UpdateBoundingBox;
+end;
+
+Procedure TPostScript.WritePage;
+
+begin
+  WritePS('%%Page: '+inttostr(FPageNumber)+' '+inttostr(FPageNumber));
+  WritePS('newpath');
+end;
+
+{ Copy current page into the postscript and start a new one }
+procedure TPostScript.NewPage;
+begin
+  // dump the current page into our postscript first
+  // put end page definition...
+  WritePS('stroke');
+  WritePS('showpage');
+  FPageNumber := FPageNumber+1;
+  WritePage;
+end;
+
+{ Finish off the document }
+procedure TPostScript.EndDoc;
+begin
+  // Start printing the document after closing out the pages
+  WritePS('stroke');
+  WritePS('showpage');
+  WritePS('%%Pages: '+inttostr(FPageNumber));
+  // okay, the postscript is all ready, so dump it to the text file
+  // or to the printer
+  FDocStarted:=False;
+  FreeAndNil(FCanvas);
+end;
+
+Function TPostScript.GetCreator : String;
+
+begin
+  If (FCreator='') then
+    Result:=ClassName
+  else  
+    Result:=FCreator;
+end;
+
+
+Procedure TPostScript.SetStream (Value : TStream);
+
+begin
+  if (FStream<>Value) then
+    begin
+    If (FStream<>Nil) and FDocStarted then
+      EndDoc;
+    FStream:=Value;
+    FDocStarted:=False;
+    end;
+end;
+
+Procedure TPostScript.CheckStream;
+
+begin
+  If Not Assigned(FStream) then
+    Raise Exception.Create(SErrNoStreamAssigned);
+end;
+
+{ TPSPen }
+
+procedure TPSPen.SetPattern(const AValue: TPSPattern);
+begin
+  if FPattern<>AValue then 
+    begin
+    FPattern:=AValue;
+    // NotifyCanvas;
+    end;
+end;
+
+
+destructor TPSPen.Destroy;
+begin
+  // Do NOT free the pattern object from here...
+  inherited Destroy;
+end;
+
+
+{ Return the pen definition as a postscript string }
+function TPSPen.AsString: String;
+
+begin
+  Result:='';
+  if FPattern <> nil then 
+    begin
+    if FPattern.PaintType = ptColored then
+      Result:='/Pattern setcolorspace '+FPattern.Name+' setcolor '
+    else 
+      begin
+      Result:='[/Pattern /DeviceRGB] setcolorspace '+inttostr(Color.Red)+' '+inttostr(Color.Green)+' '+
+       inttostr(Color.Blue)+' '+FPattern.Name+' setcolor ';
+      end;
+    end 
+  else // no pattern do this:
+    Result:=inttostr(Color.Red)+' '+inttostr(Color.Green)+' '+
+           inttostr(Color.Blue)+' setrgbcolor ';
+  Result := Result + format('%f',[Width])+' setlinewidth ';
+end;
+
+{ TPSPattern }
+
+{ Returns the pattern definition as postscript }
+function TPSPattern.GetpostScript: TStringList;
+
+var
+   I: Integer;
+   S : String;
+   
+begin
+  // If nothing in the canvas, error
+  if FStream.Size=0 then 
+    raise exception.create('Empty pattern');
+  FPostScript.Clear;
+  With FPostScript do 
+    begin
+    add('%% PATTERN '+FName);
+    add('/'+FName+'proto 12 dict def '+FName+'proto begin');
+    add('/PatternType 1 def');
+    add(Format('/PaintType %d def',[ord(FPaintType)+1]));
+    add(Format('/TilingType %d def',[ord(FTilingType)+1]));
+    add('/BBox ['+inttostr(FBBox.Left)+' '+inttostr(FBBox.Top)+' '+inttostr(FBBox.Right)+' '+inttostr(FBBox.Bottom)+'] def');
+    add('/XStep '+format('%f',[FXStep])+' def');
+    add('/YStep '+format('%f',[FYstep])+' def');
+    add('/PaintProc { begin');
+    // insert the canvas
+    SetLength(S,FStream.Size);
+    FStream.Seek(0,soFromBeginning);
+    FStream.Read(S[1],FStream.Size);
+    Add(S);
+    // add support for custom matrix later
+    add('end } def end '+FName+'proto [1 0 0 1 0 0] makepattern /'+FName+' exch def');
+    add('%% END PATTERN '+FName);
+    end;
+  Result := FPostScript;
+end;
+
+procedure TPSPattern.SetBBox(const AValue: TRect);
+begin
+{  if FBBox<>AValue then 
+    begin
+    FBBox:=AValue;
+    FPatternCanvas.Height := FBBox.Bottom - FBBox.Top;
+//    NotifyCanvas;
+    end;
+}
+end;
+
+procedure TPSPattern.SetName(const AValue: String);
+begin
+  FOldName := FName;
+  if (FName<>AValue) then 
+    begin
+    FName:=AValue;
+    // NotifyCanvas;
+    end;
+end;
+
+procedure TPSPattern.Changed;
+begin
+  if Assigned(FOnChange) then FOnChange(Self);
+end;
+
+procedure TPSPattern.SetPaintType(const AValue: TPSPaintType);
+begin
+  if FPaintType=AValue then exit;
+  FPaintType:=AValue;
+  changed;
+end;
+
+procedure TPSPattern.SetTilingType(const AValue: TPSTileType);
+begin
+  if FTilingType=AValue then exit;
+  FTilingType:=AValue;
+  changed;
+end;
+
+procedure TPSPattern.SetXStep(const AValue: Real);
+begin
+  if FXStep=AValue then exit;
+  FXStep:=AValue;
+  changed;
+end;
+
+procedure TPSPattern.SetYStep(const AValue: Real);
+begin
+  if FYStep=AValue then exit;
+  FYStep:=AValue;
+  changed;
+end;
+
+constructor TPSPattern.Create;
+begin
+  FPostScript := TStringList.Create;
+  FPaintType := ptColored;
+  FTilingType := ttConstant;
+  FStream:=TmemoryStream.Create;
+  FPatternCanvas := TPostScriptCanvas.Create(FStream);
+  FName := 'Pattern1';
+end;
+
+destructor TPSPattern.Destroy;
+begin
+  FPostScript.Free;
+  FPatternCanvas.Free;
+  FStream.Free;
+  inherited Destroy;
+end;
+
+{ ---------------------------------------------------------------------
+    TPSBrush
+  ---------------------------------------------------------------------}
+  
+
+Function TPSBrush.GetAsString : String;
+
+begin
+  Result:='';
+end;
+
+
+
+end.
+