Печать конверта

Советы » Принтеры и Печать » Печать конверта

{
Copyright © 1999 by Delphi 5 Developer's Guide - Xavier Pacheco and Steve Teixeira
}

unit

MainFrm; interface

uses

SysUtils, Windows, Messages, Classes, Graphics, Controls, Forms, Dialogs, printers, StdCtrls, ExtCtrls, Menus, ComCtrls; type

TEnvelope = record

Kind: string

; // Stores the envelope type's name Width: double; // Holds the width of the envelope Height: double; // Holds the height of the envelope end

; const

// This constant array stores envelope types EnvArray: array

[1..2] of

TEnvelope = ((Kind: 'Size 10'; Width: 9.5; Height: 4.125), // 9-1/2 x 4-1/8 (Kind: 'Size 6-3/4'; Width: 6.5; Height: 3.625)); // 6-1/2 x 3-3/4 type

// This enumerated type represents printing positions. TFeedType = (epLHorz, epLVert, epRHorz, epRVert); TPrintPrevPanel = class

(TPanel) public

property

Canvas; // Publicize the Canvas property end

; TMainForm = class

(TForm) gbEnvelopeSize: TGroupBox; rbSize10: TRadioButton; rbSize6: TRadioButton; mmMain: TMainMenu; mmiPrintIt: TMenuItem; lblAdressee: TLabel; edtName: TEdit; edtStreet: TEdit; edtCityState: TEdit; rgFeedType: TRadioGroup; PrintDialog: TPrintDialog; procedure

FormCreate(Sender: TObject); procedure

rgFeedTypeClick(Sender: TObject); procedure

mmiPrintItClick(Sender: TObject); private

PrintPrev: TPrintPrevPanel; // Print preview panel EnvSize: TPoint; // Stores the envelope's size EnvPos: TRect; // Stores the envelope's position ToAddrPos: TRect; // Stores the address's position FeedType: TFeedType; // Stores the feed type from TEnvPosition function

GetEnvelopeSize: TPoint; function

GetEnvelopePos: TRect; function

GetToAddrSize: TPoint; function

GetToAddrPos: TRect; procedure

DrawIt; procedure

RotatePrintFont; procedure

SetCopies(Copies: Integer); end

; var

MainForm: TMainForm; implementation

{$R *.DFM} function

TMainForm.GetEnvelopeSize: TPoint; // Gets the envelope's size represented by a TPoint var

EnvW, EnvH: integer; PixPerInX, PixPerInY: integer; begin

// Pixels per inch along the horizontal axis PixPerInX := GetDeviceCaps(Printer.Handle, LOGPIXELSX); // Pixels per inch along the vertical axis PixPerInY := GetDeviceCaps(Printer.Handle, LOGPIXELSY); // Envelope size differs depending on the user's selection if

RBSize10.Checked then

begin

EnvW := trunc(EnvArray[1].Width * PixPerInX); EnvH := trunc(EnvArray[1].Height * PixPerInY); end

else

begin

EnvW := trunc(EnvArray[2].Width * PixPerInX); EnvH := trunc(EnvArray[2].Height * PixPerInY); end

; // return Result as a TPoint record Result := Point(EnvW, EnvH) end

; function

TMainForm.GetEnvelopePos: TRect; { Returns the envelope's position relative to its feed type. This function requires that the variable EnvSize be initialized } begin

// Determine feed type based on user's selection. FeedType := TFeedType(rgFeedType.ItemIndex); { Return a TRect structure indicating the envelope's position as it is ejected from the printer. } case

FeedType of

epLHorz: Result := Rect(0, 0, EnvSize.X, EnvSize.Y); epLVert: Result := Rect(0, 0, EnvSize.Y, EnvSize.X); epRHorz: Result := Rect(Printer.PageWidth - EnvSize.X, 0, Printer.PageWidth, EnvSize.Y); epRVert: Result := Rect(Printer.PageWidth - EnvSize.Y, 0, Printer.PageWidth, EnvSize.X); end

; // Case end

; function

MaxLn(V1, V2: Integer): Integer; // Returns the larger of the two. If equal, returns the first begin

Result := V1; // Default result to V1 } if

V1 < V2 then

Result := V2 end

; function

TMainForm.GetToAddrSize: TPoint; var

TempPoint: TPoint; begin

// Calculate the size of the longest line using the MaxLn() function TempPoint.x := Printer.Canvas.TextWidth(edtName.Text); TempPoint.x := MaxLn(TempPoint.x, Printer.Canvas.TextWidth(edtStreet.Text)); TempPoint.x := MaxLn(TempPoint.x, Printer.Canvas.TextWidth(edtCityState.Text)) + 10; // Calculate the height of all the address lines TempPoint.y := Printer.Canvas.TextHeight(edtName.Text) + Printer.Canvas.TextHeight(edtStreet.Text) + Printer.Canvas.TextHeight(edtCityState.Text) + 10; Result := TempPoint; end

; function

TMainForm.GetToAddrPos: TRect; // This function requires that EnvSize, and EnvPos be initialized var

TempSize: TPoint; LT, RB: TPoint; begin

// Determine the size of the Address bounding rectangle TempSize := GetToAddrSize; { Calculate two points, one representing the Left Top (LT) position and one representing the Right Bottom (RB) position of the address's bounding rectangle. This depends on the FeedType } case

FeedType of

epLHorz: begin

LT := Point((EnvSize.x div

2) - (TempSize.x div

2), ((EnvSize.y div

2) - (TempSize.y div

2))); RB := Point(LT.x + TempSize.x, LT.y + TempSize.Y); end

; epLVert: begin

LT := Point((EnvSize.y div

2) - (TempSize.y div

2), ((EnvSize.x div

2) - (TempSize.x div

2))); RB := Point(LT.x + TempSize.y, LT.y + TempSize.x); end

; epRHorz: begin

LT := Point((EnvSize.x div

2) - (TempSize.x div

2) + EnvPos.Left, ((EnvSize.y div

2) - (TempSize.y div

2))); RB := Point(LT.x + TempSize.x, LT.y + TempSize.Y); end

; epRVert: begin

LT := Point((EnvSize.y div

2) - (TempSize.y div

2) + EnvPos.Left, ((EnvSize.x div

2) - (TempSize.x div

2))); RB := Point(LT.x + TempSize.y, LT.y + TempSize.x); end

; end

; // End Case Result := Rect(LT.x, LT.y, RB.x, RB.y); end

; procedure

TMainForm.DrawIt; // This procedure assumes that EnvPos and EnvSize have been initialized begin

PrintPrev.Invalidate; // Erase contents of Panel PrintPrev.Update; // Set the mapping mode for the panel to MM_ISOTROPIC SetMapMode(PrintPrev.Canvas.Handle, MM_ISOTROPIC); // Set the TPanel's extent to match that of the printer boundaries. SetWindowExtEx(PrintPrev.Canvas.Handle, Printer.PageWidth, Printer.PageHeight, nil

); // Set the viewport extent to that of the PrintPrev TPanel size. SetViewPortExtEx(PrintPrev.Canvas.Handle, PrintPrev.Width, PrintPrev.Height, nil

); // Set the origin to the position at 0, 0 SetViewportOrgEx(PrintPrev.Canvas.Handle, 0, 0, nil

); PrintPrev.Brush.Style := bsSolid; with

EnvPos do

// Draw a rectangle to represent the envelope PrintPrev.Canvas.Rectangle(Left, Top, Right, Bottom); with

ToAddrPos, PrintPrev.Canvas do

case

FeedType of

epLHorz, epRHorz: begin

Rectangle(Left, Top, Right, Top + 2); Rectangle(Left, Top + (Bottom - Top) div

2, Right, Top + (Bottom - Top) div

2 + 2); Rectangle(Left, Bottom, Right, Bottom + 2); end

; epLVert, epRVert: begin

Rectangle(Left, Top, Left + 2, Bottom); Rectangle(Left + (Right - Left) div

2, Top, Left + (Right - Left) div

2 + 2, Bottom); Rectangle(Right, Top, Right + 2, Bottom); end

; end

; // case end

; procedure

TMainForm.FormCreate(Sender: TObject); var

Ratio: double; begin

// Calculate a ratio of PageWidth to PageHeight Ratio := Printer.PageHeight / Printer.PageWidth; // Create a new TPanel instance with

TPanel.Create(self) do

begin

SetBounds(15, 15, 203, trunc(203 * Ratio)); Color := clBlack; BevelInner := bvNone; BevelOuter := bvNone; Parent := self; end

; // Create a Print preview panel PrintPrev := TPrintPrevPanel.Create(self); with

PrintPrev do

begin

SetBounds(10, 10, 200, trunc(200 * Ratio)); Color := clWhite; BevelInner := bvNone; BevelOuter := bvNone; BorderStyle := bsSingle; Parent := self; end

; end

; procedure

TMainForm.rgFeedTypeClick(Sender: TObject); begin

EnvSize := GetEnvelopeSize; EnvPos := GetEnvelopePos; ToAddrPos := GetToAddrPos; DrawIt; end

; procedure

TMainForm.SetCopies(Copies: Integer); var

ADevice, ADriver, APort: string

; ADeviceMode: THandle; DevMode: PDeviceMode; begin

SetLength(ADevice, 255); SetLength(ADriver, 255); SetLength(APort, 255); { If ADeviceMode is zero, a printer driver is not loaded. Therefore, setting PrinterIndex forces the driver to load. } if

ADeviceMode = 0 then

begin

Printer.PrinterIndex := Printer.PrinterIndex; Printer.GetPrinter(PChar(ADevice), PChar(ADriver), PChar(APort), ADeviceMode); end

; if

ADeviceMode <> 0 then

begin

DevMode := GlobalLock(ADeviceMode); try

DevMode^.dmFields := DevMode^.dmFields or

DM_Copies; DevMode^.dmCopies := Copies; finally

GlobalUnlock(ADeviceMode); end

; end

else

raise

Exception.Create('Could not set printer copies'); end

; procedure

TMainForm.mmiPrintItClick(Sender: TObject); var

TempHeight: integer; SaveFont: TFont; begin

if

PrintDialog.Execute then

begin

// Set the number of copies to print SetCopies(PrintDialog.Copies); Printer.BeginDoc; try

// Calculate a temporary line height TempHeight := Printer.Canvas.TextHeight(edtName.Text); with

ToAddrPos do

begin

{ When printing vertically, rotate the font such that it paints at a 90 degree angle. } if

(FeedType = eplVert) or

(FeedType = epRVert) then

begin

SaveFont := TFont.Create; try

// Save the original font SaveFont.Assign(Printer.Canvas.Font); RotatePrintFont; // Write out the address lines to the printer's Canvas Printer.Canvas.TextOut(Left, Bottom, edtName.Text); Printer.Canvas.TextOut(Left + TempHeight + 2, Bottom, edtStreet.Text); Printer.Canvas.TextOut(Left + TempHeight * 2 + 2, Bottom, edtCityState.Text); // Restore the original font Printer.Canvas.Font.Assign(SaveFont); finally

SaveFont.Free; end

; end

else

begin

{ If the envelope is not printed vertically, then just draw the address lines normally. } Printer.Canvas.TextOut(Left, Top, edtName.Text); Printer.Canvas.TextOut(Left, Top + TempHeight + 2, edtStreet.Text); Printer.Canvas.TextOut(Left, Top + TempHeight * 2 + 2, edtCityState.Text); end

; end

; finally

Printer.EndDoc; end

; end

; end

; procedure

TMainForm.RotatePrintFont; var

LogFont: TLogFont; begin

with

Printer.Canvas do

begin

with

LogFont do

begin

lfHeight := Font.Height; // Set to Printer.Canvas.font.height lfWidth := 0; // let font mapper choose width lfEscapement := 900; // tenths of degrees so 900 = 90 degrees lfOrientation := lfEscapement; // Always set to value of lfEscapement lfWeight := FW_NORMAL; // default lfItalic := 0; // no italics lfUnderline := 0; // no underline lfStrikeOut := 0; // no strikeout lfCharSet := ANSI_CHARSET; //default StrPCopy(lfFaceName, Font.Name); // Printer.Canvas's font's name lfQuality := PROOF_QUALITY; lfOutPrecision := OUT_TT_ONLY_PRECIS; // force TrueType fonts lfClipPrecision := CLIP_DEFAULT_PRECIS; // default lfPitchAndFamily := Variable_Pitch; // default end

; end

; Printer.Canvas.Font.Handle := CreateFontIndirect(LogFont); end

; end

.

Другое по теме:

Категории

Статьи

Советы

Copyright © 2022 - All Rights Reserved - www.delphirus.com