喫茶XRAY [Mr.XRAY掲示板]

> > まずは，AssignPrn を使用した方法です．
>
> 印刷の余白設定のテストをして気づきました．
> 一部の文字が文字化けしていました．

以下のコードのように，行単位で印刷すれば文字化けしないようです．
知りませんでした．

//=============================================================================
//  TMemo にテキストファイルからテキストを読み込む
//  プリンタ設定ダイアログでプリンタの設定
//=============================================================================                                           //
procedure TForm1.Button1Click(Sender: TObject);
begin
  Memo1.ScrollBars := ssVertical;
  Memo1.Lines.LoadFromFile('ABC.txt');
  Printer.Canvas.Font.Size := 20;

  PrinterSetupDialog1.Execute;
end;

//=============================================================================
//  TMemo のテキストを余白を設定して印刷
//  複数頁にまたがる文書の印刷可能
//
//  uses に Printers が必要
//  拙作の TplSetPritner コンポーネントが必要
//=============================================================================                                           //
procedure TForm1.Button2Click(Sender: TObject);
var
  LPrnFile   : TextFile;
  LLeftOff   : Integer;
  LTopOff    : Integer;
  LRightOff  : Integer;
  LBottomOff : Integer;
  LLineText  : string;
  LIndex     : Integer;
begin
  Printer.Title := 'テスト文書';

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

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

      // 行単位で印刷
      // 全てのテキストを対象にすると 1 部の文字が文字化けすることがある
      for LIndex := 0 to Memo1.Lines.Count - 1 do begin
        LLineText := Memo1.Lines[LIndex];
        writeln(LPrnFile, LLineText);
      end;
    finally
      CloseFile(LPrnFile);
    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);
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;