|
 Forum
Grundkurs
»Introduktion
»Snabbguide
»Komponenter
»Händelser
»Strängar
»Räkna med Delphi »Egna
typer
»Selektion
»Iteration
»Menyer
»Funktioner
»Arraystrukturer
Tips & Tricks
»Nya tips
»Blandat
»Databaser
»Filer
»Forms
»Grafik
»Internet
»Komponenter
»Matematik
»Multimedia
»Objekt/ActiveX
»Skrivare
»Strängar
»System
»Mest lästa tips
Artiklar
»Delphi och ADO
»Bygga en DLL
»Skapa en enkel rapport
»Hantera registret
»Enheter, units
»Klassen TCanvas
»Använd LookUp Controls
 Nya
tips
 Lägg
till tips
 Delphilänkar
 Gästbok
|
|
|
|
|
|
Skapa en förhandsgranskning
|
Kategori: Skrivare
Inlagt: 2003-11-13
Läst: 1857
Inlagt av: Staffan Berg
|
|
Beskrivning |
|
Detta exempel använder sig av en TPanel för att skapa en förhandsgranskning (innan utskrift).
|
|
Kod |
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.
|
|
|