Delphiran - Delphi Tips
Question :
How can I make a print preview ?

Answer :
Here is an example.

unit printpreview;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, ComCtrls;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    PreviewPaintbox: TPaintBox;
    Label1: TLabel;
    Label2: TLabel;
    LeftMarginEdit: TEdit;
    TopMarginEdit: TEdit;
    Label3: TLabel;
    Label4: TLabel;
    RightMarginEdit: TEdit;
    Label5: TLabel;
    BottomMarginEdit: TEdit;
    ApplyMarginsButton: TButton;
    OrientationRGroup: TRadioGroup;
    Label6: TLabel;
    ZoomEdit: TEdit;
    ZoomUpDown: TUpDown;
    procedure LeftMarginEditKeyPress(Sender: TObject; var Key: Char);
    procedure FormCreate(Sender: TObject);
    procedure PreviewPaintboxPaint(Sender: TObject);
    procedure ApplyMarginsButtonClick(Sender: TObject);
  private
    { Private declarations }
    PreviewText: String;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses printers;
{$R *.DFM}

procedure TForm1.LeftMarginEditKeyPress(Sender: TObject; var Key: Char);
begin
  If not (Key in ['0'..'9',#9,DecimalSeparator]) Then
    Key := #0;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  S: String;
  procedure loadpreviewtext;
  var
    sl: TStringlist;
  begin
    sl:= Tstringlist.Create;
    try
      sl.Loadfromfile( Extractfilepath( application.exename )+'printpreview.pas');
      PreviewText := sl.Text;
    finally
      sl.free
    end;
  end;
begin
  // Initialize the margin edits with a margin of 0.75 inch
  S:= FormatFloat('0.00',0.75);
  LeftMarginEdit.Text := S;
  TopMarginEdit.Text := S;
  RightMarginEdit.Text := S;
  BottomMarginEdit.Text := S;

  // Initialize the orientation radio group
  If Printer.Orientation = poPortrait Then
    OrientationRGroup.ItemIndex := 0
  Else
    OrientationRGroup.ItemIndex := 1;

  // load test text for display
  LoadPreviewtext;
end;

procedure TForm1.PreviewPaintboxPaint(Sender: TObject);
var
  pagewidth, pageheight: Double;     // printer page dimension in inch
  printerResX, printerResY: Integer; // printer resolution in dots/inch
  minmarginX, minmarginY: Double;    // nonprintable margin in inch
  outputarea: TRect;                 // print area in 1/1000 inches
  scale: Double; // conversion factor, pixels per 1/1000 inch

  procedure InitPrintSettings;
    function GetMargin( S: String; inX: Boolean ):Double;
    begin
      Result := StrToFloat(S);
      if InX then begin
        if Result ‹ minmarginX then
          Result := minmarginX;
      end
      else begin
        if Result ‹ minmarginY then
          Result := minmarginY;
      end;
    end;
  begin
    printerResX := GetDeviceCaps( printer.handle, LOGPIXELSX );
    printerResY := GetDeviceCaps( printer.handle, LOGPIXELSY );
    pagewidth   := GetDeviceCaps( printer.handle, PHYSICALWIDTH ) / printerResX;
    pageheight  := GetDeviceCaps( printer.handle, PHYSICALHEIGHT) / printerResY;
    minmarginX  := GetDeviceCaps( printer.handle, PHYSICALOFFSETX)/ printerResX;
    minmarginY  := GetDeviceCaps( printer.handle, PHYSICALOFFSETY)/ printerResY;

    outputarea.Left := Round( GetMargin( LeftMarginEdit.Text, true ) * 1000);
    outputarea.Top  := Round( GetMargin( TopMarginEdit.Text, false ) * 1000);
    outputarea.Right := Round(( pagewidth -
                                GetMargin( RightMarginEdit.Text, true )) *
1000);
    outputarea.Bottom := Round(( pageheight -
                                 GetMargin( BottomMarginEdit.Text, false ))
                               * 1000);
  end; { InitPrintSettings }

  procedure ScaleCanvas( Canvas: TCanvas; widthavail, heightavail: Integer );
  var
    needpixelswidth, needpixelsheight: Integer;
      // dimensions of preview at current zoom factor in pixels
    orgpixels: TPoint;  // origin of preview in pixels
  begin
    // set up a coordinate system for the canvas that uses 1/1000 inch as
unit,
    // honors the zoom factor and maintains the MM_TEXT orientation of the
    // coordinate axis (origin in top left corner, positive Y axis points
    // down.
    scale := Screen.PixelsPerInch / 1000;
    // Apply zoom factor
    scale := scale * StrToInt(Zoomedit.text) / 100;
    // figure out size of preview
    needpixelswidth := Round(pagewidth * 1000 * scale);
    needpixelsheight := Round(pageheight * 1000 * scale);

    if needpixelswidth ›= widthavail then
      orgpixels.X := 0
    else
      orgpixels.X := (widthavail - needpixelswidth) div 2;
    if needpixelsheight ›= heightavail then
      orgpixels.Y := 0
    else
      orgpixels.Y := (heightavail - needpixelsheight) div 2;

    // change mapping mode to MM_ISOTROPIC
    SetMapMode( canvas.handle, MM_ISOTROPIC );
    // move viewport origin to orgpixels
    SetViewportOrgEx( canvas.handle, orgpixels.x, orgpixels.y, Nil );
    // scale the window
    SetViewportExtEx( canvas.handle, Round( 1000 * scale ),
                      Round( 1000 * scale ), Nil );
    SetWindowExtEx( canvas.handle, 1000, 1000, Nil );
  end; { ScaleCanvas }
begin
  if OrientationRGroup.ItemIndex = 0 then
    Printer.Orientation := poPortrait
  else
    Printer.Orientation := poLandscape;
  InitPrintsettings;
  With Sender As TPaintBox Do Begin
    ScaleCanvas( Canvas, ClientWidth, ClientHeight );
    // specify font height in 1/1000 inch
    Canvas.Font.Height := Round(font.height / font.pixelsperinch * 1000);
    // paint page white
    Canvas.Brush.Color := clWindow;
    Canvas.Brush.Style := bsSolid;
    Canvas.FillRect( Rect(0,0,Round(pagewidth*1000),Round(pageheight*1000)));
    // draw the text
    DrawText( canvas.handle, PChar(PreviewText), Length( PreviewText ),
              outputarea, DT_WORDBREAK or DT_LEFT );
    // Draw thin gray lines to mark borders
    Canvas.Pen.Color := clGray;
    Canvas.Pen.Style := psSolid;
    Canvas.Pen.Width := 10;
    with Canvas do begin
      MoveTo( outputarea.left - 100, outputarea.top );
      LineTo( outputarea.right + 100, outputarea.top );
      MoveTo( outputarea.left - 100, outputarea.bottom );
      LineTo( outputarea.right + 100, outputarea.bottom );
      MoveTo( outputarea.left, outputarea.top - 100 );
      LineTo( outputarea.left, outputarea.bottom + 100 );
      MoveTo( outputarea.right, outputarea.top - 100 );
      LineTo( outputarea.right, outputarea.bottom + 100 );
    end;
  End;
end;

procedure TForm1.ApplyMarginsButtonClick(Sender: TObject);
begin
  PreviewPaintbox.Invalidate;
end;

end.

{
object Form1: TForm1
  Left = 192
  Top = 128
  Width = 696
  Height = 480
  Caption = 'Form1'
  Color = clBtnFace
  Font.Charset = ANSI_CHARSET
  Font.Color = clWindowText
  Font.Height = -15
  Font.Name = 'Arial'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  PixelsPerInch = 120
  TextHeight = 17
  object Panel1: TPanel
    Left = 503
    Top = 0
    Width = 185
    Height = 453
    Align = alRight
    TabOrder = 0
    object Label1: TLabel
      Left = 8
      Top = 8
      Width = 92
      Height = 17
      Caption = 'Margins (inch)'
    end
    object Label2: TLabel
      Left = 8
      Top = 45
      Width = 24
      Height = 17
      Caption = 'Left'
    end
    object Label3: TLabel
      Left = 8
      Top = 77
      Width = 25
      Height = 17
      Caption = 'Top'
    end
    object Label4: TLabel
      Left = 8
      Top = 109
      Width = 34
      Height = 17
      Caption = 'Right'
    end
    object Label5: TLabel
      Left = 8
      Top = 141
      Width = 47
      Height = 17
      Caption = 'Bottom'
    end
    object Label6: TLabel
      Left = 8
      Top = 261
      Width = 64
      Height = 17
      Caption = 'Zoom (%)'
    end
    object LeftMarginEdit: TEdit
      Left = 60
      Top = 40
      Width = 100
      Height = 25
      TabOrder = 0
      OnKeyPress = LeftMarginEditKeyPress
    end
    object TopMarginEdit: TEdit
      Left = 60
      Top = 72
      Width = 100
      Height = 25
      TabOrder = 1
      OnKeyPress = LeftMarginEditKeyPress
    end
    object RightMarginEdit: TEdit
      Left = 60
      Top = 104
      Width = 100
      Height = 25
      TabOrder = 2
      OnKeyPress = LeftMarginEditKeyPress
    end
    object BottomMarginEdit: TEdit
      Left = 60
      Top = 136
      Width = 100
      Height = 25
      TabOrder = 3
      OnKeyPress = LeftMarginEditKeyPress
    end
    object ApplyMarginsButton: TButton
      Left = 24
      Top = 304
      Width = 137
      Height = 25
      Caption = 'Apply'
      TabOrder = 4
      OnClick = ApplyMarginsButtonClick
    end
    object OrientationRGroup: TRadioGroup
      Left = 8
      Top = 176
      Width = 161
      Height = 65
      Caption = 'Orientation'
      Items.Strings = (
        'Portrait'
        'Landscape')
      TabOrder = 5
    end
    object ZoomEdit: TEdit
      Left = 80
      Top = 256
      Width = 40
      Height = 25
      TabOrder = 6
      Text = '50'
    end
    object ZoomUpDown: TUpDown
      Left = 120
      Top = 256
      Width = 17
      Height = 25
      Associate = ZoomEdit
      Min = 0
      Increment = 10
      Position = 50
      TabOrder = 7
      Wrap = False
    end
  end
  object Panel2: TPanel
    Left = 0
    Top = 0
    Width = 503
    Height = 453
    Align = alClient
    Font.Charset = ANSI_CHARSET
    Font.Color = clWindowText
    Font.Height = -17
    Font.Name = 'Times New Roman'
    Font.Style = []
    ParentFont = False
    TabOrder = 1
    object PreviewPaintbox: TPaintBox
      Left = 1
      Top = 1
      Width = 501
      Height = 451
      Align = alClient
      OnPaint = PreviewPaintboxPaint
    end
  end
end
}
 
 

 
 
© All rights reserved 1999 BuyPin Software