Автор: Xavier Pacheco

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