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

{
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
.

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

• Escape код PASSTHROUGH
• Вместо печати графики использовать резидентный шрифт принтера
• Вывести все способы подачи бумаги для печати