unit ScallingDrawUnit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, plSetPrinter, Buttons;

type
  TForm1 = class(TForm)
    BitBtn1: TBitBtn;
    Label1: TLabel;
    plSetPrinter1: TplSetPrinter;
    PrintDialog1: TPrintDialog;
    procedure BitBtn1Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
    { Private 宣言 }
    FPaperWidth : Integer;   //ドット数で表した用紙幅
    FPaperHeight: Integer;   //ドット数で表した用紙長さ
    FPaperWmm   : Integer;   //0.1mm単位で表した用紙幅
    FPaperHmm   : Integer;   //0.1mm単位で表した用紙長さ
    FPaperLO    : Integer;   //左オフセット値
    FPaperTO    : Integer;   //上オフセット値
    procedure GetPaperScale;
    procedure Scalling(ACanvas: TCanvas);
    procedure DrawRoutine;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses
  Printers;

{$R *.DFM}

//=============================================================================
//  フォーム表示開始時の処理
//  確認用にプリンタ名をラベルに表示
//=============================================================================
procedure TForm1.FormShow(Sender: TObject);
var
  LText: string;
begin
  LText := plSetPrinter1.PrinterName;
  //設計時のプリンタ名を表示
  Label1.Caption := LText;
end;

//=============================================================================
//  プリンタに出力
//=============================================================================
procedure TForm1.BitBtn1Click(Sender: TObject);
begin
  if PrintDialog1.Execute then begin
    //印刷ダイアログで設定した内容を取得
    plSetPrinter1.GetPrinterInfo;
    //用紙サイズを0.1mm単位に換算
    GetPaperScale;
     //Printer.Canvasに出力
    DrawRoutine;
  end;
end;

//-----------------------------------------------------------------------------
//  選択した用紙サイズ(ピクセル単位)を0.1mm単位の寸法に換算する
//  (A4縦ならPaperW=2100,PaperH=2970となる)
//-----------------------------------------------------------------------------
procedure TForm1.GetPaperScale;
begin
  //plSetPrinterのプロパティから横と長さ方向のドット数を取得
  FPaperWidth  := plSetPrinter1.PaperWidth;
  FPaperHeight := plSetPrinter1.PaperHeight;

  //プリンタの解像度の値から0.1mm単位の用紙の寸法を計算
  FPaperWmm := Trunc(FPaperWidth  * 254 / plSetPrinter1.XResolution);
  FPaperHmm := Trunc(FPaperHeight * 254 /plSetPrinter1.YResolution);

  //オフセット値を取得
  FPaperLO := plSetPrinter1.LeftOffset;
  FPaperTO := plSetPrinter1.TopOffset;
end;

//-----------------------------------------------------------------------------
//  描画ルーチン
//
//  描画するのは幅100.0mm,縦120.0mmの四角形.線の太さは0.5mm.
//  描画は10分の1mm単位でできる.
//-----------------------------------------------------------------------------
procedure TForm1.DrawRoutine;
var
  LText : string;
begin
  //印刷する文字列
  LText := '印刷テスト';
  try
    //印刷命令開始
    Printer.BeginDoc;
    //スケーリング
    Scalling(Printer.Canvas);
    //線の太さは0.5mm
    Printer.Canvas.Pen.Width := 5;
    //四角形の描画開始座標は左から50.0mm,上から80.0mm
    //右は150.0mm,下は200.0mmの四角形,つまり幅100.0mm,縦120.0mm
    Printer.Canvas.Rectangle(500, 800, 1500, 2000);

    //内部レディングを含めた文字の高さを10.0mmに
    Printer.Canvas.Font.Height := 100;
    //背景は透明に
    Printer.Canvas.Brush.Style := bsClear;
    //四角形の左上に文字列を描画
    Printer.Canvas.TextOut(500, 800, LText);

    //印刷する文字列の高さ確認のための線を引く
    Printer.Canvas.Pen.Width := 1;
    Printer.Canvas.MoveTo( 500, 900);
    Printer.Canvas.LineTo(1500, 900);
  finally
    //デフォルトのモードに戻す
    SetMapMode(Printer.Canvas.Handle, MM_TEXT);
    //印刷命令終了
    Printer.EndDoc;
  end;
end;

//-----------------------------------------------------------------------------
//  スケーリング
//
//  このスケーリング以降,10分の1mm単位での描画が可能となる.
//-----------------------------------------------------------------------------
procedure TForm1.Scalling(ACanvas: TCanvas);
begin
  //スケーリングのモード
  SetMapMode       (ACanvas.Handle,MM_ANISOTROPIC);
  SetWindowExtEx   (ACanvas.Handle,FPaperWmm,  FPaperHmm,    nil);
  SetViewPortExtEx (ACanvas.Handle,FPaperWidth,FPaperHeight, nil);
  //描画原点を移動
  SetViewPortOrgEx(ACanvas.Handle, -FPaperLO, -FPaperTO, nil);
end;

end.

var
  LFontSize : Double;
begin
  LFontSize := 12.0;
  Printer.Canvas.Font.Height := -Trunc(LFontSize * 254.0 / 72.0);
end;