printp.pas

Canvas打印内容

unit Printp;

(*
** PrintPreview - TPreview. Copyright Richard Vowles, August 1995
**  ([e-mail])
**
**  This is Version 1.0, released August 23rd, 1995.
**
** Please see the accompanying README.TXT file for help on how to use this
** component. It isn't hard, but those not used to drawing as such may find
** it more complicated.
**
** This work is copyrighted by Richard Vowles, [e-mail].
** You can use it as you like it, you can publish as part of shareware
** collections and so forth. What you cannot do is take it am claim it
** as your own and/or sell it as part of a collection of your own work.
** Oh, and you must leave this entire text at the top of the unit
** declaration. Oh, and any bugs, please send them to me at the above
** Internet address.
**
** This unit costs $US15 - If you wish to use it, I would appreciate it
** if you could send me $US15. It helps cover costs, y'know <grin>. See the
** README.TXT for more details.
*)

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, Printers, ExtCtrls, StdCtrls, Buttons, printcan;

type
    TPreviewCanvas = class(TObject)
      twipX, twipY                : double; (* twips per pixel *)
      screenScaleX, screenScaleY  : double;
      maxX, maxY                  : longint;
      screenFont                  : TFont;  (* font used for the screen *)
      pixelsperinchdevice         : longint;
      pixelsperinchprinter        : longint;
      offsetx, offsety            : longint; (* margins for the printer *)
        (*
        ** often, you cannot print at exactly the place you want to
        ** as the printer has some margins. HP's for example have around
        ** 227 pixels of offset
        *)
    private
      PCanvas                     : TCanvas;  (* just allocated the panel's one *)
    public
      preview                     : Boolean;
      Brush                       : TBrush;
      Pen                         : TPen;
      Font                        : TFont;
      PageNumber                  : Longint;
      twipMaxX, twipMaxY          : longint;

      constructor Create;
      destructor Destroy;
      procedure SetCanvas( Canvas : TCanvas );
      procedure ClearCanvas;
      procedure DrawMargins;
        (* drawing routines, intercepted. We expect our coordinates
        ** in TWIPS - 1/1440 of an INCH *)
      function  GetFont : TFont;
      procedure SetFont( font : TFont );
      procedure Arc( x1, y1, x2, y2, x3, y3, x4, y4 : integer );
      procedure BrushCopy( const dest : TRect; Bitmap : TBitmap;
         const Source : TRect; Color : TColor );
      procedure Chord( x1, y1, x2, y2, x3, y3, x4, y4 : integer );
      procedure FrameRect( rect : TRect );
      procedure Rectangle( x, y, x2, y2 : integer );
      procedure RoundRect( x1, y1, x2, y2, x3, y3 : integer );
      procedure TextOut( x, y : integer; const text : string );
      procedure TextRect( Rect : TRect; X, Y : Longint; const Text : string );
      procedure FloodFill( X,Y : Longint; Color : TColor; FillStyle : TFillStyle );
      procedure StretchDraw( const rect : TRect; Graphic : TGraphic );
      function TextHeight( const text : string ) : Longint;
      function TextWidth( const text : string ) : Longint;
      procedure FillRect( const rect : TRect );
      procedure MoveTo( x, y : longint );
      procedure LineTo( x, y : longint );
    private
      function ConvX(x : integer) : integer;
      function ConvY(y : integer) : integer;
      function ConvWidth(x : integer) : integer;
      function ConvHeight(y : integer) : integer;
    end;

  TDrawPPEvent = procedure( Canvas : TPreviewCanvas; PageNumber : LongInt ) of object;

  TPrintPreview = class(TForm)
    Panel1:             TPanel;
    bPrint:             TBitBtn;
    bQuit: TBitBtn;
    cbZoom: TComboBox;
    ScrollBox1: TScrollBox;
    Image1: TImage;
    Scroll: TScrollBar;
    Label1: TLabel;
    lPageCount: TLabel;
    Label3: TLabel;

    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure ScrollScroll(Sender: TObject; ScrollCode: TScrollCode;
      var ScrollPos: Integer);
    procedure cbZoomChange(Sender: TObject);
  private
    procedure SetBitmapSize( pixelsperinch : longint );
  public
    FPaintEvent                 : TDrawPPEvent;
    preview                     : Boolean;
    drawmargins                 : Boolean;

    PreCanvas                   : TPreviewCanvas;
  end;

  PrintModeType = (notprinting, printing);

  TPreview = class(TComponent)
  private
       fSavePaintEvent : TDrawPPEvent;
       fPrintPreview   : TPrintPreview;
       bitmap          : TBitmap;
       preview         : Boolean;
       FPageCount      : Longint;
       FDrawMargins    : Boolean; (* keep a copy as fPrintPreview not instantiated *)

         (* only used when not preview printing *)
       PageNumber      : Longint;
       PCanvas         : TPreviewCanvas;
       minpage,
       maxpage         : Longint;
       UserCancelledPrinting     : Boolean;
         (* mode - begin, end or nothing, just to warn them *)
  private
       printmode       : PrintModeType;
  public
       constructor Create(AOwner : TComponent); override;
       destructor Destroy; override;
       (* printer routines *)
       function BeginDoc : Boolean; (* returns TRUE if not preview or preview and OK to printdlg *)
       procedure EndDoc;
       function Print : Boolean; 
  private
       procedure UserWantedCancel(Sender : TObject);
       procedure SetPreview( IsPreview : Boolean );
       function GetPreview : Boolean;
       procedure SetPaintEvent( pe : TDrawPPEvent );
       function GetPaintEvent : TDrawPPEvent;
       procedure SetLeft( val : longint );
       function GetLeft : Longint;
       procedure SetWidth( val : longint );
       function GetWidth : Longint;
       procedure SetTop( val : longint );
       function GetTop : Longint;
       procedure SetHeight( val : longint );
       function GetHeight : Longint;
       procedure SetPageCount( pagecount : longint );
       function GetDrawMargins : Boolean;
       procedure SetDrawMargins( margins : boolean );
  published
       property DrawMargins : Boolean read GetDrawMargins write SetDrawMargins;
       property OnPaint : TDrawPPEvent read GetPaintEvent write SetPaintEvent;
       property PreviewMode : Boolean read GetPreview write SetPreview;
       property Left : Longint read GetLeft write SetLeft;
       property Width : Longint read GetWidth write SetWidth;
       property Top : Longint read GetTop write SetTop;
       property Height : Longint read GetHeight write Setheight;
       property PageCount : Longint read FPageCount write SetPageCount;
  end;

procedure Register;

implementation

const
     PreviewSizeFull = 144;
     PreviewSizeThreeQuarters = 108;
     PreviewSizeHalf = 72;
     PreviewSizeQuarter = 36;

procedure Register;
begin
     RegisterComponents( 'Samples', [TPreview] );
end;

{$R *.DFM}

(*
*********************************************************************
***************** TPreviewCanvas - The printer canvas ***************
*********************************************************************
** This object deals with all of the drawing and scaling of the *****
** to the printer or printer preview panel **************************
*********************************************************************
*)
function TPreviewCanvas.TextHeight( const text : string ) : Longint;
var
   val : longint;
begin
     pCanvas.Font.Assign( ScreenFont );

     pCanvas.Font.PixelsPerInch := pixelsperinchprinter;

     pCanvas.Font.Size := ScreenFont.Size;

     val := pCanvas.TextHeight( text ); (* gives us height in pixels *)

     val := ( val * 1440 ) div pCanvas.Font.PixelsPerInch;

     result := val;
end;

function TPreviewCanvas.TextWidth( const text : string ) : Longint;
var
   val : longint;
begin
     pCanvas.Font.Assign( ScreenFont );

     pCanvas.Font.PixelsPerInch := pixelsperinchprinter;

     pCanvas.Font.Size := ScreenFont.Size;

     val := pCanvas.TextWidth( text ); (* gives us height in pixels *)

     val := ( val * 1440 ) div pCanvas.Font.PixelsPerInch;

     if PixelsPerInchDevice > 0 then
          pCanvas.Font.PixelsPerInch := PixelsPerInchDevice;

     result := val;
end;

procedure TPreviewCanvas.SetFont( font : tFont );
begin
     screenFont.Assign( font );
end;

procedure TPreviewCanvas.DrawMargins;
var
   col : TColor;
begin
   col := Pen.Color;
   Pen.Color := clGray;
   Pen.Style := psDash;
   pCanvas.Rectangle( ConvX(0), ConvY(0), maxx - ConvX(0), maxy - ConvY(0) );
   Pen.Color := col;
   Pen.Style := psSolid;
end;

procedure TPreviewCanvas.ClearCanvas;
var
   col  : TColor;
   rect : TRect;
begin
     if preview then
       begin
       col := Brush.Color;
       Brush.Color := clWhite;
       rect.left   := 0;
       rect.top    := 0;
       rect.bottom := maxY;
       rect.right  := maxX;
       PCanvas.FillRect( rect );
       Brush.Color := col;
       end
     else
       printer.NewPage;
end;

procedure TPreviewCanvas.SetCanvas( Canvas : TCanvas );
begin
     PCanvas := Canvas;
     Brush := PCanvas.Brush;
     Pen   := PCanvas.Pen;
     Font  := ScreenFont;
end;

constructor TPreviewCanvas.Create;
begin
     inherited Create;

     ScreenFont := tFont.Create;
end;

destructor TPreviewCanvas.Destroy;
begin
     ScreenFont.Free;

     inherited Destroy;
end;

function TPreviewCanvas.GetFont : TFont;
begin
     result := screenFont;
end;



(*
*********************************************************************
***************** TPrintPreview - the display form ******************
*********************************************************************
*)



function TPreviewCanvas.ConvX(x : integer) : integer;
var
   a : double;
begin
     result := Round(twipX * (x+offsetx));
end;

function TPreviewCanvas.ConvWidth(x : integer) : integer;
var
   a : double;
begin
     result := Round(twipX * x);
end;

function TPreviewCanvas.ConvY(y : integer) : integer;
begin
     result := Round(twipY * (y+offsety));
end;

function TPreviewCanvas.ConvHeight(y : integer) : integer;
begin
     result := Round(twipY * y);
end;

procedure TPreviewCanvas.Arc( x1, y1, x2, y2, x3, y3, x4, y4 : integer );
begin
     pCanvas.Arc( Convx(X1), Convy(Y1),
                  Convx(X2), Convy(Y2),
                  Convx(X3), Convy(Y3),
                  Convx(X4), Convy(Y4) );
end;

procedure TPreviewCanvas.BrushCopy( const dest : TRect; Bitmap : TBitmap;
         const Source : TRect; Color : TColor );
var
   destrect : TRect;
   srcrect  : TRect;
begin
     destrect.left := ConvX(Dest.left);
     destrect.top  := ConvY(Dest.Top);
     destrect.right := ConvX(Dest.right);
     destrect.bottom := ConvY(Dest.Bottom);

     srcrect.left := ConvX(Source.left);
     srcrect.top  := ConvY(Source.Top);
     srcrect.right := ConvX(Source.right);
     srcrect.bottom := ConvY(Source.Bottom);

     pCanvas.BrushCopy( destrect, bitmap, srcrect, color );
end;

procedure TPreviewCanvas.Chord( x1, y1, x2, y2, x3, y3, x4, y4 : integer );
begin
     pCanvas.Chord( Convx(X1), Convy(Y1),
                    Convx(X2), Convy(Y2),
                    Convx(X3), Convy(Y3),
                    Convx(X4), Convy(Y4) );
end;

procedure TPreviewCanvas.FrameRect( rect : TRect );
begin
     rect.top := ConvY(rect.top);
     rect.left := ConvX(rect.left);
     rect.right := ConvX(rect.right);
     rect.bottom := ConvY(rect.bottom);
     PCanvas.FrameRect(rect);
end;

procedure TPreviewCanvas.Rectangle( x, y, x2, y2 : integer );
begin
     PCanvas.Rectangle( ConvX(x), ConvY(y), ConvX(x2), ConvY(y2) );
end;

procedure TPreviewCanvas.RoundRect( x1, y1, x2, y2, x3, y3 : integer );
begin
     PCanvas.RoundRect( ConvX(x1), ConvY(y1), ConvX(x2), ConvY(y2),
                        ConvX(x3), ConvY(y3) );
end;

procedure TPreviewCanvas.TextOut( x, y : integer; const text : string );
var
   oldpixels : longint;
begin
     if not preview then
        oldpixels := printer.canvas.font.pixelsperinch;

     pCanvas.Font.Assign( ScreenFont );

     if not preview then
        printer.canvas.font.pixelsperinch := oldpixels;

     if PixelsPerInchDevice <> 0 then
        pCanvas.Font.PixelsPerInch := PixelsPerInchDevice;

     pCanvas.Font.Size := ScreenFont.Size;

     pCanvas.Textout( ConvX(x), ConvY(y), text );
end;

procedure TPreviewCanvas.TextRect( Rect : TRect; X, Y : Longint; const Text : string );
var
   oldpixels : longint;
begin
     if not preview then
        oldpixels := printer.canvas.font.pixelsperinch;

     pCanvas.Font.Assign( ScreenFont );

     if not preview then
        printer.canvas.font.pixelsperinch := oldpixels;

     if PixelsPerInchDevice <> 0 then
        pCanvas.Font.PixelsPerInch := PixelsPerInchDevice;

     pCanvas.Font.Size := ScreenFont.Size;

     rect.left := ConvX(rect.left);
     rect.right := ConvX(rect.right);
     rect.top   := ConvY(rect.top);
     rect.bottom := ConvY(rect.bottom);

     pCanvas.TextRect( rect, convx(x), convy(y), text );
end;

procedure TPreviewCanvas.FloodFill( X,Y : Longint; Color : TColor; FillStyle : TFillStyle );
begin
     pCanvas.FloodFill( convx(x), convy(y), color, fillstyle );
end;

procedure TPreviewCanvas.StretchDraw( const rect : TRect; Graphic : TGraphic );
var
   nrect : TRect;
begin
     nrect.left := ConvX(rect.left);
     nrect.right := ConvX(rect.right);
     nrect.top   := ConvY(rect.top);
     nrect.bottom := ConvY(rect.bottom);

     pCanvas.StretchDraw( nrect, graphic );
end;

procedure TPreviewCanvas.FillRect( const rect : TRect );
var
   nrect : TRect;
begin
     nrect.left := ConvX(rect.left);
     nrect.right := ConvX(rect.right);
     nrect.top   := ConvY(rect.top);
     nrect.bottom := ConvY(rect.bottom);

     pCanvas.FillRect( nrect );
end;

procedure TPreviewCanvas.MoveTo( x, y : longint );
begin
     pCanvas.MoveTo( ConvX(x), ConvY(y) );
end;

procedure TPreviewCanvas.LineTo( x, y : longint );
begin
     pCanvas.LineTo( ConvX(x), ConvY(y) );
end;


(*
*********************************************************************
***************** TPreview - the wrapper component ******************
*********************************************************************
*)