Delphi Programming / Object Pascal
サイトのトップページへ リンクのページへ ロゴマーク
[掲載 2020年04月20日] [更新 2020年04月20日]　Delphi サンプルプログラム集
   
拙作のコンポーネント類を使用したサンプル
T172_TMemo のテキストまたはテキストファイルの印刷
動作確認等 Windows 7 U64(SP1) + Delphi XE5(UP2) Pro VCL-32
拙作のプリンタ設定コンポーネント TplSetPrinter が必要
T172_PrintPlainText.zip　[3,569 KB]　2013年11月05日版 (EXE 同梱)






TMemo のテキストまたはテキストファイルの印刷


テキストの印刷のサンプルです．本ページで扱うのはプレインテキスト (プレーンテキスト) と言われる書式情報を持たない単なるテキストのことです．
テキストは，TRichEdit の機能を利用すると，行間等を指定して，ページ毎にヘッダやフッタ等も追加印刷することができ，ある程度の禁則処理もしてくれますが，ともかく単にテキストだけを印刷したい場合，AssignPrn 手続きを使用する印刷が考えられます．本ページはこの AssignPrn 手続きを使用した印刷のテストプログラムです．


[備考]
本ページのサンプルでは，拙作のプリンタ設定コンポーネントを使用していますが，用紙サイズ等の値は GetDeviceCaps 関数を使用して取得できます．

サンプルプログラム集に，拙作の印刷プレビュー制御コンポーネント TplPrev を使用しているサンプルがあります．それらのサンプルも，印刷プレビューが必要なければ TplPrev を使用する必要はありません．TplPrev.Canvas (TCanvas 型) への描画を TPrinter.Canvas への描画に変更するだけです．ただし，TplPrev.Canvas では，描画の単位が 0.1 mm ですが，TPrinter.Canvas の描画単位はピクセルです．





01_AssignPrn を使用した TMemo のテキスト印刷


TMemo にテキストを読み込んで表示します．その TMemo のテキストを印刷する例です．
AssignPrn 手続きで TextFile 型の変数をプリンタに割り当て，Writeln 手続きで印刷します．下図は，添付のテキストを TMemo に表示したところです．


図1
EXE 起動時の画面
  • テキストファイルのテキストを TMemo に読み込んで表示

Writeln 手続きで TMemo.Lines.Text をプリンタに出力した結果です．
一部の文字が文字化けしています．


図2
TMemo のテキストを一度に印刷した場合
  • 文字化けしている文字がある
  • 用紙サイズは A6
  • これは印刷スプールの画像

リスト1
AssignPrn を使用して TMemo のテキストを印刷
TMemo のテキストを一度にプリンタに出力する場合		 
//=============================================================================
//  フォーム生成時の処理
//  テキストファイルを読み込む                                          //
//=============================================================================                                           //
procedure TForm1.FormCreate(Sender: TObject);
var
  LFilePath : string;
begin
  Memo1.WordWrap   := True;
  Memo1.ScrollBars := ssVertical;

  LFilePath := ExpandFileName('..\Test.txt');
  Memo1.Lines.LoadFromFile(LFilePath);
end;

//=============================================================================
//  TMemo のテキストを印刷
//  AssignPrn を使用する方法は，複数頁にまたがる文書の印刷可能
//
//  uses に Printers が必要
//=============================================================================                                           //
procedure TForm1.Button1Click(Sender: TObject);
var
  LPrnFile : TextFile;
begin
  if not PrinterSetupDialog1.Execute then Exit;

  Printer.Title := 'テスト文書';
  Printer.Canvas.Font.Size := 18;

  AssignPrn(LPrnFile);
  try
    Rewrite(LPrnFile);
    try
      Writeln(LPrnFile, Memo1.Lines.Text);
    finally
      CloseFile(LPrnFile);
    end;
  except
    on EInOutError do
      MessageBox(Handle, '印刷エラー', '印刷', MB_ICONWARNING);
  end;
end;


今度は TMemo のテキストを 1 行づつプリンタに出力してみます．
文字化けは減少しましたが，改行位置が元のテキストとは違っています．元のテキストの改行位置とは別に TMemo の右端の位置でも改行しています．


図3
TMemo のテキストを 1 行単位でプリンタに出力した場合
  • 文字化けは減少したが，位置が元のテキストと違っ
  • 用紙サイズは A6
  • これは印刷スプールの画像

リスト2
AssignPrn を使用して TMemo のテキストを印刷
TMemo のテキストを 1 行単位でプリンタに出力する場合		 
//=============================================================================
//  TMemo のテキストを印刷
//  AssignPrn を使用する方法は，複数頁にまたがる文書の印刷可能
//  行単位で印刷すると文字化けが減少するが，改行位置が反映れないことがある
//
//  uses に Printers が必要
//=============================================================================                                           //
procedure TForm1.Button2Click(Sender: TObject);
var
  LPrnFile : TextFile;
  LLineNo  : Integer;
begin
  if not PrinterSetupDialog1.Execute then Exit;

  Printer.Title := 'テスト文書';
  Printer.Canvas.Font.Size := 18;

  AssignPrn(LPrnFile);
  try
    Rewrite(LPrnFile);
    try
      for LLineNo := 0 to Memo1.Lines.Count - 1 do begin
        Writeln(LPrnFile, Memo1.Lines[LLineNo]);
      end;
    finally
      CloseFile(LPrnFile);
    end;
  except
    on EInOutError do
      MessageBox(Handle, '印刷エラー', '印刷', MB_ICONWARNING);
  end;
end;


TMemo.WordWrap は，右端で折り返し表示するためにソフトウェア的な改行を挿入するだけで，外観上だけですが，Writeln の仕様も関係していると思われます．
そうであれば，TMemo のテキストを別の TStringList 型の変数に代入して，それを印刷すれば回避できると期待できます．その結果です．


[備考]
添付のテキストファイルで確認した限りでは，TMemo.Lines.Text をプリンタに出力する場合に比べて，文字化けする箇所は減りましたが，文字化けなしの状態にはなつていません．



図4
TMemo のテキストを TStringList に代入して印刷した場合
  • 文字化けは減少した
  • 改行位置も元のテキストと同じ
  • 用紙サイズは A6
  • これは印刷スプールの画像

リスト3
AssignPrn を使用して TMemo のテキストを印刷
テキストを TStringList に代入して，TStringList の文字列を 1 行単位でプリンタに出力 
//=============================================================================
//  TMemo のテキストを印刷
//  AssignPrn を使用する方法は，複数頁にまたがる文書の印刷可能
//  TStringList に TMemo のテキストを代入して出力する
//
//  uses に Printers が必要
//=============================================================================                                           //
procedure TForm1.Button3Click(Sender: TObject);
var
  LStrList : TStringList;
  LPrnFile : TextFile;
  LLineNo  : Integer;
begin
  if not PrinterSetupDialog1.Execute then Exit;

  Printer.Title := 'テスト文書';
  Printer.Canvas.Font.Size := 18;

  AssignPrn(LPrnFile);
  try
    Rewrite(LPrnFile);
    LStrList := TStringList.Create;
    try
      LStrList.Text := Memo1.Lines.Text;
      for LLineNo := 0 to LStrList.Count - 1 do begin
        Writeln(LPrnFile, LStrList[LLineNo]);
      end;
    finally
      CloseFile(LPrnFile);
      FreeAndNil(LStrList);
    end;
  except
    on EInOutError do
      MessageBox(Handle, '印刷エラー', '印刷', MB_ICONWARNING);
  end;
end;



02_AssignPrn を使用したテキスト印刷で余白を設定


印刷の際に，用紙の上下左右に余白を設定する例です．
TPrinter オブジェクトにも Windows API の関数にも，TPrinter.Canvas に対してクリップ領域を設定する機能はありません．そこで，以下のサンプルでは SetWindowExtEx 関数類を使用してビューポートを設定しています．つまり，用紙全体を縮小描画します．縮小すると，見かけ上のフォントサイズも変わりますから，その分フォントサイズを調整します．
実際には，設定する余白の値によっては印刷領域が変形することになりますが，左右と上下の余白が極端に違わない限り目立つことはありません．


図5
用紙の上下左右に余白を付けてテキストを印刷
  • 一部に文字化けあり
  • 用紙サイズは A4
  • これは印刷スプールの画像

リスト4
AssignPrn を使用したテキスト印刷で余白を設定		 
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls,
  plSetPrinter;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Button1: TButton;
    plSetPrinter1: TplSetPrinter;
    PrinterSetupDialog1: TPrinterSetupDialog;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
    procedure SetViewPortOffset(ASetPrt: TplSetPrinter; ALeft, ATop,
      ARight, ABottom: Integer);
    function mmToPixelsX(ASetPrt: TplSetPrinter; AValue: Integer): Integer;
    function mmToPixelsY(ASetPrt: TplSetPrinter; AValue: Integer): Integer;
  end;

  var
  Form1: TForm1;

implementation

uses
  Printers;

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//  テキストファイルを読み込む                                          //
//=============================================================================                                           //
procedure TForm1.FormCreate(Sender: TObject);
var
  LFilePath : string;
begin
  Memo1.WordWrap   := True;
  Memo1.ScrollBars := ssVertical;

  LFilePath := ExpandFileName('..\Test.txt');
  Memo1.Lines.LoadFromFile(LFilePath);
end;

//=============================================================================
//  TMemo のテキストを余白を設定して印刷
//  AssignPrn を使用する方法は，複数頁にまたがる文書の印刷可能
//
//  uses に Printers が必要
//  拙作の TplSetPritner コンポーネントが必要
//=============================================================================                                           //

procedure TForm1.Button1Click(Sender: TObject);
var
  LFontSize  : Integer;
  LStrList   : TStringList;
  LPrnFile   : TextFile;
  LLeftOff   : Integer;
  LTopOff    : Integer;
  LRightOff  : Integer;
  LBottomOff : Integer;
  LIndex     : Integer;
begin
  if not PrinterSetupDialog1.Execute then Exit;

  Printer.Title := 'テスト文書';
  LFontSize := 16;
  Printer.Canvas.Font.Size := LFontSize;

  AssignPrn(LPrnFile);
  try
    LStrList := TStringList.Create;
    Rewrite(LPrnFile);
    try
      // 余白の値
      LLeftOff   := mmToPixelsX(plSetPrinter1, 20);
      LTopOff    := mmToPixelsY(plSetPrinter1, 30);
      LRightOff  := mmToPixelsX(plSetPrinter1, 20);
      LBottomOff := mmToPixelsY(plSetPrinter1, 25);

      // 余白の設定
      SetViewPortOffset(plSetPrinter1, LLeftOff, LTopOff, LRightOff, LBottomOff);

      LStrList.Text := Memo1.Lines.Text;

      // 行単位で印刷
      for LIndex := 0 to LStrList.Count - 1 do begin
        Writeln(LPrnFile, LStrList[LIndex]);
        Application.ProcessMessages;
      end;

      // ビューポート (余白) の設定とフォントのサイズを元に戻す
      SetViewPortOffset(plSetPrinter1, 0, 0, 0, 0);
      Printer.Canvas.Font.Size := LFontSize;
    finally
      CloseFile(LPrnFile);
      FreeAndNil(LStrList);
    end;
  except
    on EInOutError do
      MessageBox(Handle, '印刷エラー', '印刷', MB_ICONWARNING);
  end;
end;

//-----------------------------------------------------------------------------
//  印刷の余白の設定
//  第 1 引数は TplSetPrinter コンポーネント
//  後の引数は左端，上端，右端，下端のオフセットでピクセル単位
//
//  実際には用紙サイズのビューポートを設定してそこに描画する
//  つまり，縮小描画する
//  この方法は，設定した余白の外側には描画できない (用紙全体の縮小なので)
//
//  uses に Printers が必要
//  拙作の TplSetPritner コンポーネントが必要
//-----------------------------------------------------------------------------
procedure TForm1.SetViewPortOffset(ASetPrt: TplSetPrinter; ALeft, ATop,
  ARight, ABottom: Integer);
var
  LPaperW : Integer;
  LPaperH : Integer;
begin
  LPaperW := ASetPrt.PaperWidth;
  LPaperH := ASetPrt.PaperHeight;

  SetMapMode       (Printer.Canvas.Handle, MM_ANISOTROPIC);
  SetWindowExtEx   (Printer.Canvas.Handle, LPaperW, LPaperH, nil);
  SetViewPortExtEx (Printer.Canvas.Handle,
                    LPaperW - (ALeft + ARight),
                    LPaperH - (ATop + ABottom),
                    nil);
  // 描画原点を移動
  SetViewPortOrgEx(Printer.Canvas.Handle, ALeft, ATop, nil);

  // ビューポートの機能で描画を縮小するのでその分フォントのサイズを大きくする
  Printer.Canvas.Font.Height := Trunc(Printer.Canvas.Font.Height
               *  LPaperH / (LPaperH - (ATop + ABottom)));
end;
//
//-----------------------------------------------------------------------------
//  mm 単位を TPrinter.Canvas のピクセル数に変換
//  横方向用
//-----------------------------------------------------------------------------
function TForm1.mmToPixelsX(ASetPrt: TplSetPrinter; AValue: Integer): Integer;
begin
  Result := Trunc(AValue * ASetPrt.XResolution / 25.4);
end;

//-----------------------------------------------------------------------------
//  mm 単位を TPrinter.Canvas のピクセル数に変換
//  縦方向用
//-----------------------------------------------------------------------------
function TForm1.mmToPixelsY(ASetPrt: TplSetPrinter; AValue: Integer): Integer;
begin
  Result := Trunc(AValue * ASetPrt.YResolution / 25.4);
end;

end.



03_AssignPrn を使用したテキストファイルの印刷


TStringList にテキストファイルを読み込んで印刷すれば，テキストファイルの印刷となりjます．


リスト5
AssignPrn を使用してテキストファイルを印刷		 
//=============================================================================
//  テキストファイルを読み込んで印刷
//  AssignPrn を使用する方法は，複数頁にまたがる文書の印刷可能
//
//  uses に Printers が必要
//  拙作の TplSetPritner コンポーネントが必要
//=============================================================================                                           //

procedure TForm1.Button1Click(Sender: TObject);
var
  LFilePath  : string;
  LFontSize  : Integer;
  LStrList   : TStringList;
  LPrnFile   : TextFile;
  LLeftOff   : Integer;
  LTopOff    : Integer;
  LRightOff  : Integer;
  LBottomOff : Integer;
  LIndex     : Integer;
begin
  if not PrinterSetupDialog1.Execute then Exit;

  LFilePath := ExpandFileName('..\Test.txt');

  Printer.Title := 'テスト文書';
  LFontSize := 16;
  Printer.Canvas.Font.Size := LFontSize;

  AssignPrn(LPrnFile);
  try
    LStrList := TStringList.Create;
    Rewrite(LPrnFile);
    try
      LStrList.LoadFromFile(LFilePath);
      // 余白の値
      LLeftOff   := mmToPixelsX(plSetPrinter1, 20);
      LTopOff    := mmToPixelsY(plSetPrinter1, 30);
      LRightOff  := mmToPixelsX(plSetPrinter1, 20);
      LBottomOff := mmToPixelsY(plSetPrinter1, 25);

      // 余白の設定
      SetViewPortOffset(plSetPrinter1, LLeftOff, LTopOff, LRightOff, LBottomOff);

      // 行単位で印刷
      for LIndex := 0 to LStrList.Count - 1 do begin
        Writeln(LPrnFile, LStrList[LIndex]);
        Application.ProcessMessages;
      end;

      // ビューポート (余白) の設定とフォントのサイズを元に戻す
      SetViewPortOffset(plSetPrinter1, 0, 0, 0, 0);
      Printer.Canvas.Font.Size := LFontSize;
    finally
      CloseFile(LPrnFile);
      FreeAndNil(LStrList);
    end;
  except
    on EInOutError do
      MessageBox(Handle, '印刷エラー', '印刷', MB_ICONWARNING);
  end;
end;



04_TCanvas.TextRect を使用したテキストの印刷


これまでのテストプログラムで筆者が確認した結果では，AssignPrn を使用したテキスト印刷は文字化けが発生しました．
TCanvas の TextRect メソッドを使用すると，TPrinter.Canvas の任意の矩形領域にテキストを描画することができます．この方法でば文字化けは発生しません．ただし，この方法は，最初の 1 ページしか印刷できません．
TextRect メソッドは，Windows API の DrawTextEx 関数を使用して描画しています．


テキストを印刷する方法として，テキストの表示にTRichEdit を使用する方法があります．
TRichEdit.PlainText の値を True にすると TRichEdit でテキストを扱うことができます．PlainText はプレイン (プレーン) テキストの意味で，書式なしのテキストのことです．この方法であれば，複数のページになるテキスト文書も，余白を設定して印刷できます．


図6
TCanvas.TextRect を使用した印刷
  • 用紙サイズは A4
  • これは印刷スプールの画像

リスト6
TCanvas.TextRect を使用してテキストを印刷		 
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls,
  plSetPrinter;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Button1: TButton;
    plSetPrinter1: TplSetPrinter;
    PrinterSetupDialog1: TPrinterSetupDialog;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
    function mmToPixelsX(ASetPrt: TplSetPrinter; AValue: Integer): Integer;
    function mmToPixelsY(ASetPrt: TplSetPrinter; AValue: Integer): Integer;
  end;

  var
  Form1: TForm1;

implementation

uses
  Printers;

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//  テキストファイルを読み込む                                          //
//=============================================================================                                           //
procedure TForm1.FormCreate(Sender: TObject);
var
  LFilePath : string;
begin
  Memo1.WordWrap   := True;
  Memo1.ScrollBars := ssVertical;

  LFilePath := ExpandFileName('..\Test.txt');
  Memo1.Lines.LoadFromFile(LFilePath);
end;

//=============================================================================
//  TMemo のテキストを余白を設定して印刷
//  Canvas.TextRect を使用する印刷 (最初の 1 ページだけ印刷可能)
//
//  uses に Printers が必要
//  拙作の TplSetPritner コンポーネントが必要
//=============================================================================                                           //

procedure TForm1.Button1Click(Sender: TObject);
var
  LFormat  : TTextFormat;
  LRect    : TRect;
  LPrnText : string;
begin
  if not PrinterSetupDialog1.Execute then Exit;

  Printer.Title := 'テスト文書';
  Printer.Canvas.Font.Size := 15;

  Printer.BeginDoc;
  try
    // 印刷領域の設定
    LRect := Printer.Canvas.ClipRect;
    LRect.Left  := mmToPixelsX(plSetPrinter1, 20);
    LRect.Top    := mmToPixelsY(plSetPrinter1, 30);
    LRect.Right  := plSetPrinter1.PaperWidth - mmToPixelsX(plSetPrinter1, 20);
    LRect.Bottom := plSetPrinter1.PaperHeight - mmToPixelsY(plSetPrinter1, 25);

    // 印刷
    LFormat  := [tfLeft, tfWordBreak];
    LPrnText := Memo1.Lines.Text;
    Printer.Canvas.TextRect(LRect, LPrnText, LFormat);
  finally
    Printer.EndDoc;
  end;
end;

//-----------------------------------------------------------------------------
//  mm 単位を TPrinter.Canvas のピクセル数に変換
//  横方向用
//-----------------------------------------------------------------------------
function TForm1.mmToPixelsX(ASetPrt: TplSetPrinter; AValue: Integer): Integer;
begin
  Result := Trunc(AValue * ASetPrt.XResolution / 25.4);
end;

//-----------------------------------------------------------------------------
//  mm 単位を TPrinter.Canvas のピクセル数に変換
//  縦方向用
//-----------------------------------------------------------------------------
function TForm1.mmToPixelsY(ASetPrt: TplSetPrinter; AValue: Integer): Integer;
begin
  Result := Trunc(AValue * ASetPrt.YResolution / 25.4);
end;

end.