Print Preview

Как сделать предпросмотр
== 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
Category:Принтер