Print Preview
Материал из DRKB
Как сделать предпросмотр
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