How to create a print preview

Problem/Question/Abstract:

I am trying to put together a simple print preview program that can be used by other programs. I am using the panel component as my printing cavas and I am having troubles equating the screen and page ratios. Does anyone have any ideas on how I could simplify this task or point me in the direction of a good book or give some example code?

Answer:

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;

  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;

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
}
---------------------------------------------------------------------------------