PRINTP1

Top  Previous  Next

unit Printp1;

interface

uses

SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,

Forms, Dialogs, Printers, ExtCtrls, StdCtrls, Buttons, printcan,

DB, DBTables;

 

type

  TPreviewCanvas = class(TObject)

    twipX, twipY                : double;

    screenScaleX, screenScaleY  : double;

    maxX, maxY                  : longint;

    screenFont                  : TFont;

    pixelsperinchdevice         : longint;

    pixelsperinchprinter        : longint;

    offsetx, offsety            : longint;

  private

    PCanvas                     : TCanvas;

  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;

    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 );

    procedure Szoveg(mit : string ;tab : integer);

    procedure NextLine;

 

  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;

  bQuit: TBitBtn;

  cbZoom: TComboBox;

  ScrollBox1: TScrollBox;

  Image1: TImage;

  Scroll: TScrollBar;

  Label1: TLabel;

  lPageCount: TLabel;

  Label3: TLabel;

  BitBtn1: TBitBtn;

  Bevel1: TBevel;

  Bevel2: TBevel;

  Panel2: TPanel;

  Query1: TQuery;

 

  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);

 

TDBPreview = class(TComponent)

private

     fSavePaintEvent : TDrawPPEvent;

     fPrintPreview   : TPrintPreview;

     bitmap          : TBitmap;

     preview         : Boolean;

     FPageCount      : Longint;

     FDrawMargins    : Boolean;

 

     PageNumber      : Longint;

     PCanvas         : TPreviewCanvas;

     minpage,

     maxpage         : Longint;

     UserCancelledPrinting     : Boolean;

     FTabulator       : Tstrings ;

     Qtext            : Tstrings ;

 

private

     printmode       : PrintModeType;

public

     constructor Create(AOwner : TComponent); override;

     destructor Destroy; override;

     function BeginDoc : Boolean;

     procedure EndDoc;

     function Print : Boolean;

private

     procedure SetTabulator(value : tstrings) ;

     procedure SetQtext(value : tstrings) ;

     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

     procedure InitTabulator ;

     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;

     property Tabulatorok: TStrings read FTabulator write SetTabulator;

     property Lekerdezes : Tstrings read qtext write setqtext;

 

end;

 

procedure Register;

 

implementation

 

const

   PreviewSizeFull = 144;

   PreviewSizeThreeQuarters = 108;

   PreviewSizeHalf = 72;

   PreviewSizeQuarter = 36;

 

procedure Register;

begin

   RegisterComponents( 'AL', [TDBPreview] );

end;

{--------------------------------------------}

procedure TPreviewCanvas.szoveg(mit : string; tab : integer);

Var   p   : integer;

 

begin

p:=textwidth('X') ;

 textout(tabulator[tab]*textwidth('X'),sor ,mit);

end;

 

procedure TPreviewCanvas.NextLine;

begin

sor:=sor+ textheight('X');

 

end;

 

procedure TDBPreview.SetTabulator(value : Tstrings);

begin

FTabulator.Assign(Value);

InitTabulator;

end;

 

procedure TdbPreview.SetQtext(value : Tstrings);

begin

QText.Assign(Value);

fprintpreview.Query1.sql:=qtext;

fprintpreview.Query1.active:=true;

 

end;

 

procedure TdbPreview.InitTabulator ;

Var   i   : integer;

begin

  for i:=0 to Ftabulator.count-1 do begin

     tabulator[i]:=strtoint(Ftabulator.strings[i]);

  end;

end;

 

 

{--------------------------------------------}

 

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 );

   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 );

   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;

 

 

 

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;

 

constructor TdbPreview.Create(AOwner : TComponent);

begin

   inherited Create(AOwner);

   Ftabulator := TStringList.Create;

   Qtext := TStringList.Create;

   fPrintPreview := nil;

   PCanvas       := nil;

end;

 

destructor TdbPreview.Destroy;

begin

   if fPrintPreview <> nil then

      fPrintPreview.Release;

 

   if PCanvas <> nil then

      PCanvas.Free;

 

   inherited Destroy;

end;

 

 

 

function TdbPreview.BeginDoc : Boolean;

var

 pixelsperinchx  : longint;

 pixelsperinchy  : longint;

 pixperinch      : longint;

 physsize        : TPOINT;

 PrintDialog1    : TPrintDialog;

begin

  result := True;

 

  if not preview then

    begin

    PrintDialog1 := TPrintDialog.Create(Application);

    PrintDialog1.Options := [poPageNums, poWarning, poHelp];

    PrintDialog1.MinPage := 1;

    PrintDialog1.MaxPage := FPageCount;

    PrintDialog1.FromPage := 1;

    PrintDialog1.ToPage := FPageCount;

    if PrintDialog1.Execute then

      begin

      if PrintDialog1.PrintRange in [prAllPages] then

         begin

         minpage := 1;

         maxpage := FPageCount;

         end

      else

         begin

         if PrintDialog1.FromPage < 1 then

           minpage := 1

         else

           minpage := PrintDialog1.FromPage;

         if PrintDialog1.ToPage > FPageCount then

            maxpage := FPageCount

         else

            maxpage := PrintDialog1.ToPage;

         end;

      end

    else

      result := False;

 

    PrintDialog1.Free;

    end;

 

  Escape( printer.handle, GETPHYSPAGESIZE, 0, nil, @physsize );

 

  pixelsperinchx := GetDeviceCaps( printer.handle, LOGPIXELSX );

  pixelsperinchy := GetDeviceCaps( printer.handle, LOGPIXELSY );

 

  if preview then

      begin

     if fPrintPreview = nil then

        begin

        if Self.Owner.ClassType = tForm then

           fPrintPreview := TPrintPreview.Create(Self.Owner)

        else

           fPrintPreview := TPrintPreview.Create(Self);

 

        fPrintPreview.Left := 0;

        fPrintPreview.Top := 0;

        fPrintPreview.Preview := True;

        end;

 

      fPrintPreview.PreCanvas.PageNumber := 1;

      fPrintPreview.PreCanvas.PixelsPerInchPrinter := pixelsperinchx;

      fPrintPreview.Preview := preview;

      fPrintPreview.PreCanvas.Preview := preview;

      fPrintPreview.FPaintEvent := FSavePaintEvent;

      fPrintPreview.Scroll.Max := FPageCount;

      fPrintPreview.Scroll.Position := 1;

      fPrintPreview.lPageCount.Caption := inttostr(FPageCount);

      fPrintPreview.Width := Screen.Width - 3;

      fPrintPreview.Height := Screen.Height - 3;

      fPrintPreview.cbZoom.ItemIndex := 2;

      fPrintPreview.DrawMargins := FDrawMargins;

 

      fPrintPreview.query1.sql:= Qtext;

      fPrintPreview.query1.active:= True;

 

      bitmap := TBitmap.Create;

      bitmap.MonoChrome := True;

 

      pixperinch := fPrintPreview.pixelsperinch;

      fPrintPreview.Image1.Picture.Bitmap := bitmap;

      fPrintPreview.PreCanvas.SetCanvas( fPrintPreview.Image1.canvas );

      fPrintPreview.SetBitmapSize( PreviewSizeHalf );

      fPrintPreview.PreCanvas.SetFont( fPrintPreview.Canvas.Font );

      end

   else if result then

      begin

      PCanvas := TPreviewCanvas.Create;

 

      PCanvas.SetCanvas( Printer.Canvas );

      PCanvas.PixelsPerInchPrinter := pixelsperinchx;

      PCanvas.OffsetX := 0;

      PCanvas.OffSetY := 0;

 

      PCanvas.twipX := pixelsperinchx / 1440;

      PCanvas.twipY := pixelsperinchy / 1440;

      PCanvas.twipMaxX := (Longint(printer.pagewidth) * 1440) div pixelsperinchx;

      pCanvas.twipMaxY := (Longint(printer.pageheight) * 1440) div pixelsperinchy;

 

      PCanvas.pixelsperinchdevice := pixelsperinchx;

 

      PageNumber := 1;

 

      Printer.BeginDoc;

      end;

     printmode := printing;

end;

 

procedure TdbPreview.UserWantedCancel(Sender : TObject);

begin

   UserCancelledPrinting := True;

end;

 

function TdbPreview.Print : Boolean;

var

 pageNumber   : longint;

 prt          : TfPrintingQuery;

begin

 result := False;

 

 if printmode = notprinting then

   Application.MessageBox( 'Nen kell a BeginDoc ', 'Error', MB_OK )

 else

   begin

   if preview then

      begin

      if fPrintPreview.ShowModal = mrOk then

         result := True;

      end

   else

      begin

      UserCancelledPrinting := False;

 

      if Assigned(FSavePaintEvent) then

        begin

        prt := TfPrintingQuery.Create(Application);

        prt.FOnCancel := UserWantedCancel;

        prt.SetMax( maxpage );

        prt.Show;

        Application.ProcessMessages;

        PageNumber := minpage;

        while ( PageNumber <= maxpage ) and ( not UserCancelledPrinting ) do

          begin

          prt.SetProgress( PageNumber );

 

          if PageNumber <> 1 then

             PCanvas.ClearCanvas;

 

          PCanvas.PageNumber := PageNumber;

 

          FSavePaintEvent(PCanvas,PageNumber);

 

          inc( PageNumber );

          end;

        end;

        prt.Hide;

        prt.Release;

      end;

   end;

end;

 

procedure TdbPreview.EndDoc;

begin

   if printmode = printing then

     begin

     if not preview then

        begin

        printer.canvas.font.pixelsperinch := pcanvas.pixelsperinchprinter;

        if UserCancelledPrinting then

          printer.Abort

        else

          printer.EndDoc;

        PCanvas.Free;

        pCanvas := nil;

        end

     else if fPrintPreview <> nil then

        begin

        printer.canvas.font.pixelsperinch := fprintpreview.precanvas.pixelsperinchprinter;

        fPrintPreview.Release;

        fPrintPreview := nil;

        end;

 

     printmode := notprinting;

     end;

end;

 

 

procedure TdbPreview.SetPreview( IsPreview : Boolean );

begin

   preview := IsPreview;

 

   if fPrintPreview <> nil then

     begin

     fPrintPreview.Preview := preview;

     fPrintPreview.PreCanvas.Preview := preview;

     end;

end;

 

function TdbPreview.GetPreview : Boolean;

begin

   result := preview;

end;

 

procedure TdbPreview.SetPaintEvent( pe : TDrawPPEvent );

begin

   fSavePaintEvent := pe;

 

   if fPrintPreview <> nil then

        fPrintPreview.FPaintEvent := pe;

end;

 

function TdbPreview.GetPaintEvent : TDrawPPEvent;

begin

   result := fSavePaintEvent;

end;

 

procedure TdbPreview.SetLeft( val : longint );

begin

   if fPrintPreview <> nil then

     fPrintPreview.left := val;

end;

 

function TdbPreview.GetLeft : Longint;

begin

   if fPrintPreview <> nil then

    result := fPrintPreview.left

   else

    result := 0;

end;

 

procedure TdbPreview.SetWidth( val : longint );

begin

   if fPrintPreview <> nil then

      fPrintPreview.width := val;

end;

 

function TdbPreview.GetWidth : Longint;

begin

   if fPrintPreview <> nil then

     result := fPrintPreview.width

   else

    result := 0;

end;

 

procedure TdbPreview.SetTop( val : longint );

begin

   if fPrintPreview <> nil then

     fPrintPreview.top := val;

end;

 

function TdbPreview.GetTop : Longint;

begin

   if fPrintPreview <> nil then

     result := fPrintPreview.top

   else

    result := 0;

end;

 

procedure TdbPreview.SetHeight( val : longint );

begin

   if fPrintPreview <> nil then

     fPrintPreview.height := val;

end;

 

function TdbPreview.GetHeight : Longint;

begin

   if fPrintPreview <> nil then

      result := fPrintPreview.height

   else

    result := 0;

end;

 

procedure TdbPreview.SetPageCount( pagecount : longint );

begin

   FPageCount := PageCount;

 

   if fPrintPreview <> nil then

      begin

      fPrintPreview.Scroll.Max := FPageCount;

      fPrintPreview.lPageCount.Caption := inttostr(FPageCount);

      end;

end;

 

function TdbPreview.GetDrawMargins : Boolean;

begin

   result := FDrawMargins;

end;

 

procedure TdbPreview.SetDrawMargins( margins : boolean );

begin

   FDrawMargins := margins;

   if fPrintPreview <> nil then

      fPrintPreview.DrawMargins := FDrawMargins;

end;

 

 

 

 

 

procedure TPrintPreview.FormCreate(Sender: TObject);

begin

   preview   := True;

   PreCanvas := TPreviewCanvas.Create;

   PreCanvas.SetFont( Font );

end;

 

procedure TPrintPreview.FormDestroy(Sender: TObject);

begin

   PreCanvas.Free;

end;

 

procedure TPrintPreview.FormPaint(Sender: TObject);

var

 col  : tColor;

 rect : TRect;

begin

   PreCanvas.ClearCanvas;

 

   if DrawMargins then

     begin

     PreCanvas.DrawMargins;

     end;

 

   if Assigned(FPaintEvent) then

      FPaintEvent(PreCanvas, PreCanvas.PageNumber);

end;

 

procedure TPrintPreview.FormResize(Sender: TObject);

begin

   if Image1.Width < ScrollBox1.Width then

     Image1.Left := (ScrollBox1.Width - Image1.Width) div 2;

end;

 

procedure TPrintPreview.ScrollScroll(Sender: TObject;

ScrollCode: TScrollCode; var ScrollPos: Integer);

begin

   PreCanvas.PageNumber := Scroll.Position;

   Invalidate;

end;

 

procedure TPrintPreview.cbZoomChange(Sender: TObject);

begin

   case cbZoom.ItemIndex of

     0:

       SetBitmapSize( PreviewSizeFull );

     1:

       SetBitmapSize( PreviewSizeThreeQuarters );

     2:

       SetBitmapSize( PreviewSizeHalf );

     3:

       SetBitmapSize( PreviewSizeQuarter );

   end;

 

   Invalidate;

end;

 

procedure TPrintPreview.SetBitmapSize( pixelsperinch : longint );

var

 pixelsperinchx  : longint;

 pixelsperinchy  : longint;

 fullHeight,

 fullWidth       : longint;

 physsize        : TPOINT;

begin

 Escape( printer.handle, GETPHYSPAGESIZE, 0, nil, @physsize );

 

 pixelsperinchx := GetDeviceCaps( printer.handle, LOGPIXELSX );

 pixelsperinchy := GetDeviceCaps( printer.handle, LOGPIXELSY );

 

 PreCanvas.OffsetX := ((physsize.x - printer.pagewidth) div 2);

 preCanvas.OffSetX := (PreCanvas.OffsetX * 1440) div pixelsperinchx;

 PreCanvas.OffSetY := ((physsize.y - printer.pageheight) div 2);

 PreCanvas.OffSetY := (PreCanvas.OffsetY * 1440) div pixelsperinchy;

 

 

 fullHeight := Round((physsize.y  * pixelsperinch ) / pixelsperinchy );

 fullWidth  := Round((physsize.x * pixelsperinch ) / pixelsperinchx);

 

 PreCanvas.twipMaxX := (Longint(printer.pagewidth) * 1440) div pixelsperinchx;

 PreCanvas.twipMaxY := (Longint(printer.pageheight) * 1440) div pixelsperinchy;

 

 PreCanvas.screenScaleX := ( fullWidth / physsize.x );

 PreCanvas.screenScaleY := ( fullHeight / physsize.y );

 

 PreCanvas.twipX := pixelsperinch / 1440;

 PreCanvas.twipY := pixelsperinch / 1440;

 PreCanvas.maxX  := fullWidth;

 PreCanvas.maxY  := fullHeight;

 

 PreCanvas.PixelsPerInchDevice := pixelsperinch;

 

 Image1.Picture.bitmap.Height := fullHeight;

 Image1.Picture.bitmap.Width  := fullWidth;

 

 if fullWidth < ScrollBox1.Width then

   begin

   Image1.Left := (ScrollBox1.Width-fullWidth) div 2;

   end

 else

   begin

   Image1.Left := 0;

   end;

end;

 

 

end.