Print Preview

Материал из DRKB


Как сделать предпросмотр


Printpreview.jpg


printpreview.pas[править | править код]

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;
  sl: TStringList;
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
  sl := TStringList.Create;
  try
    sl.LoadFromFile(ExtractFilePath(Application.ExeName) + 'printpreview.pas');
    PreviewText := sl.Text;
  finally
    sl.Free
  end;
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
    { dimensions of preview at current zoom factor in pixels }
    NeedPixelsWidth, NeedPixelsHeight: Integer;
    {origin of preview in pixels}
    OrgPixels: TPoint;
  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.


printpreview.dfm[править | править код]

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


Source: Взято с Delphi Knowledge Base: http://www.baltsoft.com/
ID: 03260
ID: 03267