|
Delphi Programming / Object Pascal
[掲載 2005年01月01日] [更新 2020年04月21日] Delphi サンプルプログラム集 |
拙作のコンポーネント類を使用したサンプル
T170_TRichEdit を印刷プレビュー ( 複数頁対応 ) |
動作確認等 |
Windows 7 U64(SP1) + Delphi XE Pro
以下の拙作のコンポーネント類が必要
TplSetPrinter, TplPrev |
|
T170_RichEdit2.zip [5,628 KB] 2020年04月21日版 (EXE 同梱) |
- 2005年11月13日 (他の履歴は省略)
- RichEdit 印刷終了後に plPrev の Canvas のプロパティの設定が不正となる現象を修正
|
01_TRichEdit の内容を印刷プレビュー ( 複数頁対応 ) |
メインフォームに配置した TRichEdit の内容を印刷する例です.印刷が複数頁となる場合の例です.頁をまたがる場合は先読み方式が便利です.
1 文字でも頁内に印刷できない場合は複数頁になります. |
|
図1
設計時画面
- [プレビュー] ボタン配置
- 実行すると添付の RTF ファイルを読み込んで表示
|
|
図2
実行 |
|
図3
プレビュー画面
- 最初に説明文字列
- 続いて RichEdit の中身
|
リスト1
複数頁の RTF ファイルを印刷プレビュー |
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Buttons, ExtCtrls, plPrev, RichEdit, ComCtrls;
type
TForm1 = class(TForm)
btnPreview: TSpeedButton;
RichEdit1: TRichEdit;
plPrev1: TplPrev;
procedure btnPreviewClick(Sender: TObject);
procedure FormShow(Sender: TObject);
private
procedure RichEditPrint(X1, X2, Y1, Y2: Integer ; Rich: TRichEdit);
public
{ Public 宣言 }
end;
function MiliToTwips(V: Integer): Integer;
function TwipsToMili(V: Integer): Integer;
var
Form1: TForm1;
implementation
type
TPrev = class(TCustomplPrev);
{$R *.DFM}
//=============================================================================
// TRichEdit (書式付きテキスト) の読込み
// ワードの文書を RTF 形式で保存しておけば読込み可能
//=============================================================================
procedure TForm1.FormShow(Sender: TObject);
var
LFilePath : string;
begin
LFilePath := ExpandFileName('..\\RichText.RTF');
if FileExists(LFilePath) then begin
// このあたりは適時変更...
RichEdit1.WordWrap := True;
RichEdit1.ScrollBars := ssVertical;
RichEdit1.Lines.LoadFromFile(LFilePath);
Self.Width := 740;
Self.Height := 500;
end;
end;
//=============================================================================
// [プレビュー] ボタンで印刷プレビュー開始
// 先読み方式なので,描画コードの後でプレビュー
//=============================================================================
procedure TForm1.btnPreviewClick(Sender: TObject);
var
LPaperWidth : Integer;
LPaperHeight : Integer;
begin
// 現在のプリンタの設定を TplSetPrinter コンポの値として取得
plPrev1.plSetPrinter.GetPrinterInfo;
// TplSetPrinter の情報を元にして用紙サイズ等のプロパティをセット
TPrev(plPrev1).SetPaperInfo;
// 用紙サイズ (0.1 mm 単位) を取得しておく
LPaperWidth := plPrev1.PaperWidth;
LPaperHeight := plPrev1.PaperHeight;
plPrev1.Title := 'TRichEdit 印刷テスト';
// 印刷領域を指定して印刷
RichEditPrint(300, LPaperWidth - 300, 350, LPaperHeight - 300, RichEdit1);
plPrev1.ShowModal;
end;
//=============================================================================
// TRichEdit の内容を描画
// X1 : 描画領域の左端 X 座標値 (0.1 mm 単位)
// X2 : 描画領域の右端 X 座標値 (0.1 mm 単位)
// Y1 : 描画領域の上端 Y 座標値 (0.1 mm 単位)
// Y2 : 描画領域の下端 Y 座標値 (0.1 mm 単位)
// RichEdit : TRichEdit
//
// 複数の頁にわたって印刷可能なように,先読み方式のコード
// TplPrev では頁毎に描画単位が 0.1 mm になるようにマップモードを設定している
// マップモードなどの設定は頁毎に実行する必要がある
// 追加描画コードはマップモードが 0.1 mm 単位になっている状態で実行す必要がある
//=============================================================================
procedure TForm1.RichEditPrint(X1, X2, Y1, Y2: Integer; Rich: TRichEdit);
var
LRange : TFormatRange;
LMaxLen : Integer;
LNextIndex : Integer;
LOldMap : Integer;
//---------------------------------------------------------------------------
// Windows XP,Vista の Unicode 版のテキストボックス (TRichEdit) のバグ対策
// EM_FORMATRANGE メッセージを送っても,最後の頁の出力後,次の印刷文字のイン
// デックスが,前のインデックス -1 となってしまう
// もしバグが修正された場合も考慮して,
// MSDN のサンプルコードと同じ LMaxLen でも比較して文書終了を判定している
//---------------------------------------------------------------------------
function GetNextCharIndex: Integer;
var
LIndex : Integer;
LNextIdx : Integer;
begin
LIndex := SendMessage(Rich.Handle, EM_FORMATRANGE, 1, Longint(@LRange));
LRange.chrg.cpMin := LIndex;
LNextIdx := SendMessage(Rich.Handle, EM_FORMATRANGE, 0, Longint(@LRange));
if (LNextIdx < LIndex) or (LIndex > LMaxLen) or (LIndex = 0) then begin
Result := -1;
end else begin
Result := LIndex;
end;
end;
//---------------------------------------------------------------------------
begin
LNextIndex := 0;
// 印刷対象文字数(非 Unicode 版ではバイト数)
LMaxLen := Rich.GetTextLen;
// テキストの最初から印刷
LRange.chrg.cpMin := LNextIndex;
plPrev1.BeginDoc;
try
plPrev1.FontHeight(60);
plPrev1.TextOut(200, 200, 'リッチエディトの印刷例');
// バッファのフラッシュ
SendMessage(Rich.Handle, EM_FORMATRANGE, 0, 0);
//毎回Rangeにセット
while True do begin
// ヘッダ部
// LRangeを 0 (null)で埋める
FillChar(LRange, SizeOf(TFormatRange), 0);
// 出力先デバイスのハンドル
LRange.hdc := plPrev1.Canvas.Handle;
// 書式設定するデバイスのハンドル
LRange.hdcTarget := LRange.hdc;
// 描画領域の指定 (Twips 単位)
// 最初の頁だけ印刷位置などを変更する場合は分岐処理する
LRange.rc.Left := MiliToTwips(X1);
LRange.rc.Right := MiliToTwips(X2);
LRange.rc.Top := MiliToTwips(Y1);
LRange.rc.Bottom := MiliToTwips(Y2);
//用紙1頁のサイズ
//本当は用紙サイズをTwipsで指定すべき?
LRange.rcPage := LRange.rc;
// 最後まで(-1で 自動計算)
LRange.chrg.cpMax := -1;
// マップモード MM_TEXT にして前のマップモードを保存
LOldMap := SetMapMode(LRange.hdc, MM_TEXT);
try
// この頁の開始は前の最後の文字から
LRange.chrg.cpMin := LNextIndex;
// 実際の印刷と次の印刷開始文字位置を取得
LNextIndex := GetNextCharIndex;
finally
// バッファのフラッシュ
SendMessage(Rich.Handle, EM_FORMATRANGE, 0, 0);
// マップモードを元に戻す
// TplPrevでは 0.1 mmm 単位に戻すということ
SetMapMode(LRange.hdc, LOldMap);
TPrev(plPrev1).ScaleInitialize(plPrev1.Canvas, False);
end;
// フッタ部
if LNextIndex < 0 then break;
plPrev1.NewPage;
end;
// 全ての印刷が終了したら追加印刷
// 印刷終了後の位置は Twips (LRange.rc.Bottom) なので mm に換算する
// 改行も TRichEdit の文字に含まれるので注意
plPrev1.Canvas.Font.Size := 20;
plPrev1.Canvas.TextOut(200, TwipsToMili(LRange.rc.Bottom), '次の行');
finally
plPrev1.EndDoc;
end;
end;
//-----------------------------------------------------------------------------
// 0.1 mm 単位の座標値を Twips 値に変換する関数
//
// 参考
// 1 [inch] = 72 [pt]
// 1 [inch] = 1440 [Twips]
// 1 [pt] = 20 [Twips]
// 1 [inch] = 25.4 [mm]
// 例 x mm を pt (ポイント) に換算する式
// pt := x * 72 / 25.4
//
// この計算式は TplPrev コンポ専用.一般的な換算はプリンタの解像度の考慮が必要
//-----------------------------------------------------------------------------
function MiliToTwips(V: Integer): Integer;
begin
Result := Trunc(V * 1440.0 / 254.0);
end;
//-------------------------------------------------------------------------------
// Twips 単位の値を 0.1 mm 単位の座標値に変換する関数
// この計算式はTplPrevコンポ専用.一般的な換算はプリンタの解像度の考慮が必要
//-------------------------------------------------------------------------------
function TwipsToMili(V: Integer): Integer;
begin
Result := Trunc(V * 254.0 / 1440)
end;
end.
02_TRichEdit を非表示にして実行
- テキストファイルの印刷 |
印刷プレビュー制御コンポーネントには,テキストファイルの印刷メソッドがありますが,禁則処理や行間を指定しなくてもよいのであれば,TRichEdit に読みこんで印刷する方法もあります.
十分に確認していませんが,TRichEdit も WordWrap が True であれば,ある程度は処理しているようです.
表示は必要ないので,以下のコードでは,TRichEdit を非表示にして実行します.また,単位の換算用の関数を関数内関数にしています.さらに,印刷プレビューをしないで,直接プリンタに出力できるようにチェックボックスで設定するようにしています.
印刷の余白の設定やフォントの設定,あるいはワードやエクセルのようにヘッダ部,フッタ部設定のユーザインタフェイスを追加すれば,印刷プレビュー機能付きのテキスト印刷ユーティリティもできるでしょう.ただし,サイズの大きなテキストファイルには向いていません. |
[備考]
本サンプルでは TRichEdit を非表示にしていますが,テキストファイルを TRichEdit で表示するのであれば,TRichEdit.PlainText プロパティの値を True にしておいた方が無難です.
|
|
図4
設計時画面
|
|
図5
実行
|
|
図6
添付の RTF ファイルを選択 |
|
図7
プレビュー画面
|
リスト2
RTF ファイルを,TRichEdit を非表示で読み込んで印刷プレビュー |
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Buttons, ExtCtrls, plPrev, RichEdit, ComCtrls;
type
TForm1 = class(TForm)
Button1: TSpeedButton;
RichEdit1: TRichEdit;
plPrev1: TplPrev;
OpenDialog1: TOpenDialog;
CheckBox1: TCheckBox;
procedure Button1Click(Sender: TObject);
private
procedure RichEditPrint(X1, X2, Y1, Y2: Integer ; Rich: TRichEdit);
public
{ Public 宣言 }
end;
function MiliToTwips(V: Integer): Integer;
function TwipsToMili(V: Integer): Integer;
var
Form1: TForm1;
implementation
type
TPrev = class(TCustomplPrev);
{$R *.DFM}
//=============================================================================
// [プレビュー] ボタンで印刷プレビュー開始
// 先読み方式なので,描画コードの後でプレビュー
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
LFilePath : string;
LPaperWidth : Integer;
LPaperHeight : Integer;
begin
// 現在のプリンタの設定を TplSetPrinter コンポの値として取得
plPrev1.plSetPrinter.GetPrinterInfo;
// TplSetPrinter の情報を元にして用紙サイズ等のプロパティをセット
TPrev(plPrev1).SetPaperInfo;
// 用紙サイズ (0.1 mm 単位) を取得しておく
LPaperWidth := plPrev1.PaperWidth;
LPaperHeight := plPrev1.PaperHeight;
OpenDialog1.InitialDir := ExpandFileName('..\');
if not OpenDialog1.Execute then exit;
LFilePath := OpenDialog1.FileName;
if FileExists(LFilePath) then begin
Update;
Screen.Cursor := crHourGlass;
RichEdit1.Lines.LoadFromFile(LFilePath);
plPrev1.Title := '印刷テスト';
// 印刷領域を指定して印刷
RichEditPrint(300, LPaperWidth - 300, 350, LPaperHeight - 300, RichEdit1);
if CheckBox1.Checked then begin
plPrev1.Print;
end else begin
plPrev1.ShowModal;
end;
Screen.Cursor := crDefault;
end;
end;
//=============================================================================
// TRichEdit の内容を描画
// X1 : 描画領域の左端 X 座標値 (0.1 mm 単位)
// X2 : 描画領域の右端 X 座標値 (0.1 mm 単位)
// Y1 : 描画領域の上端 Y 座標値 (0.1 mm 単位)
// Y2 : 描画領域の下端 Y 座標値 (0.1 mm 単位)
// RichEdit : TRichEdit
//
// 複数の頁にわたって印刷可能なように,先読み方式のコード
// TplPrev では頁毎に描画単位が 0.1 mm になるようにマップモードを設定している
// マップモードなどの設定は頁毎に実行する必要がある
// 追加描画コードはマップモードが 0.1 mm 単位になっている状態で実行す必要がある
//=============================================================================
procedure TForm1.RichEditPrint(X1, X2, Y1, Y2: Integer; Rich: TRichEdit);
var
LRange : TFormatRange;
LMaxLen : Integer;
LNextIndex : Integer;
LOldMap : Integer;
//---------------------------------------------------------------------------
// Windows XP,Vista の Unicode 版のテキストボックス (TRichEdit) のバグ対策
// EM_FORMATRANGE メッセージを送っても,最後の頁の出力後,次の印刷文字のイン
// デックスが,前のインデックス -1 となってしまう
// もしバグが修正された場合も考慮して,
// MSDN のサンプルコードと同じ LMaxLen でも比較して文書終了を判定している
//---------------------------------------------------------------------------
function GetNextCharIndex: Integer;
var
LIndex : Integer;
LNextIdx : Integer;
begin
LIndex := SendMessage(Rich.Handle, EM_FORMATRANGE, 1, Longint(@LRange));
LRange.chrg.cpMin := LIndex;
LNextIdx := SendMessage(Rich.Handle, EM_FORMATRANGE, 0, Longint(@LRange));
if (LNextIdx < LIndex) or (LIndex > LMaxLen) or (LIndex = 0) then begin
Result := -1;
end else begin
Result := LIndex;
end;
end;
//---------------------------------------------------------------------------
begin
LNextIndex := 0;
// 印刷対象文字数 (非 Unicode 版ではバイト数)
LMaxLen := Rich.GetTextLen;
// テキストの最初から印刷
LRange.chrg.cpMin := LNextIndex;
plPrev1.BeginDoc;
try
plPrev1.FontHeight(60);
plPrev1.TextOut(200, 200, 'リッチエディトの印刷例');
// バッファのフラッシュ
SendMessage(Rich.Handle, EM_FORMATRANGE, 0, 0);
// 毎回 LRange にセット
while True do begin
// ヘッダ部
// Rangeを 0 (null) で埋める
FillChar(LRange, SizeOf(TFormatRange), 0);
// 出力先デバイスのハンドル
LRange.hdc := plPrev1.Canvas.Handle;
// 書式設定するデバイスのハンドル
LRange.hdcTarget := LRange.hdc;
// 描画領域の指定 (Twips 単位)
// 最初の頁だけ印刷位置などを変更する場合は分岐処理する
LRange.rc.Left := MiliToTwips(X1);
LRange.rc.Right := MiliToTwips(X2);
LRange.rc.Top := MiliToTwips(Y1);
LRange.rc.Bottom := MiliToTwips(Y2);
// 用紙 1 頁のサイズ
// 本当は用紙サイズを Twips で指定すべき?
LRange.rcPage := LRange.rc;
// 最後まで (-1で自動計算)
LRange.chrg.cpMax := -1;
//マップモードMM_TEXTにして前のマップモードを保存
LOldMap := SetMapMode(LRange.hdc, MM_TEXT);
try
// この頁の開始は前の最後の文字から
LRange.chrg.cpMin := LNextIndex;
// 実際の印刷と次の印刷開始文字位置を取得
LNextIndex := GetNextCharIndex;
finally
// バッファのフラッシュ
SendMessage(Rich.Handle, EM_FORMATRANGE, 0, 0);
// マップモードを元に戻す
// TplPrev では 0.1 mm 単位に戻すということ
SetMapMode(LRange.hdc, LOldMap);
TPrev(plPrev1).ScaleInitialize(plPrev1.Canvas, False);
end;
// フッタ部
if LNextIndex < 0 then break;
plPrev1.NewPage;
end;
// 全ての印刷が終了したら追加印刷
// 印刷終了後の位置は Twips (LRange.rc.Bottom) なので mm に換算する
// 改行も TRichEdit の文字に含まれるので注意
plPrev1.Canvas.Font.Size := 20;
plPrev1.Canvas.TextOut(200, TwipsToMili(LRange.rc.Bottom), '次の行');
finally
plPrev1.EndDoc;
end;
end;
//-----------------------------------------------------------------------------
// 0.1 mm 単位の座標値を Twips 値に変換する関数
//
// 参考
// 1 [inch] = 72 [pt]
// 1 [inch] = 1440 [Twips]
// 1 [pt] = 20 [Twips]
// 1 [inch] = 25.4 [mm]
// 例 x mm を pt (ポイント) に換算する式
// pt := x * 72 / 25.4
//
// この計算式は TplPrev コンポ専用.一般的な換算はプリンタの解像度の考慮が必要
//-----------------------------------------------------------------------------
function MiliToTwips(V: Integer): Integer;
begin
Result := Trunc(V * 1440.0 / 254.0);
end;
//-------------------------------------------------------------------------------
// Twips 単位の値を 0.1 mm 単位の座標値に変換する関数
// この計算式はTplPrevコンポ専用.一般的な換算はプリンタの解像度の考慮が必要
//-------------------------------------------------------------------------------
function TwipsToMili(V: Integer): Integer;
begin
Result := Trunc(V * 254.0 / 1440)
end;
end.
TRichEdit を非表示で印刷する方法は,テキストファイルの印刷に便利です.用紙内の印刷範囲も指定でき,行間も任意に設定できます.以下のリストはその行間を,行数で設定する方法です. |
[備考]
添付のサンプルでは TRichEdit を非表示にしていますが,テキストファイルを TRichEdit で表示するのであれば,TRichEdit.PlainText プロパティの値を True にしておいた方が無難です.
|
procedure TForm1.Button1Click(Sender: TObject);
var
LFilePath : string;
LPaperWidth : Integer;
LPaperHeight : Integer;
LParaFormat2 : TParaFormat2;
LLineSpace : Byte;
begin
// 現在のプリンタの設定を TplSetPrinter コンポの値として取得
plPrev1.plSetPrinter.GetPrinterInfo;
// TplSetPrinter の情報を元にして用紙サイズ等のプロパティをセット
TPrev(plPrev1).SetPaperInfo;
// 用紙サイズ (0.1 mm 単位) を取得しておく
LPaperWidth := plPrev1.PaperWidth;
LPaperHeight := plPrev1.PaperHeight;
// テキストファイルの場合の行間を行単位で設定
// bLineSpacingRule を以下の値にする.この時 dyLineSpacing の値は無視される
// 0 1 行
// 1 1 行半
// 2 2 行
// RTF ファイルの場合は RTF で設定済みなのでこの設定は無効
LLineSpace := 2;
RichEdit1.SelectAll;
FillChar(LParaFormat2, SizeOf(LParaFormat2), #0);
LParaFormat2.cbSize := SizeOf(LParaFormat2);
LParaFormat2.dwMask := PFM_LINESPACING;
LParaFormat2.bLineSpacingRule := LLineSpace;
SendMessage(RichEdit1.Handle, EM_SETPARAFORMAT, 0, Longint(@LParaFormat2));
RichEdit1.SelStart := 0;
OpenDialog1.InitialDir := ExpandFileName('..\');
if not OpenDialog1.Execute then exit;
LFilePath := OpenDialog1.FileName;
if FileExists(LFilePath) then begin
Update;
Screen.Cursor := crHourGlass;
RichEdit1.Lines.LoadFromFile(LFilePath);
plPrev1.Title := '印刷テスト';
// 印刷領域を指定して印刷
RichEditPrint(300, LPaperWidth - 300, 350, LPaperHeight - 300, RichEdit1);
if CheckBox1.Checked then begin
plPrev1.Print;
end else begin
plPrev1.ShowModal;
end;
Screen.Cursor := crDefault;
end;
end;
04_テキストの行間を 0.1 mm 単位で指定して描画 |
次のサンプルは,行間を 0.1 mm 単位で設定する方法です.
mm 単位での設定はないので,0.1 mm 単位の値を Twip の値に換算して設定しています. |
[備考]
添付のサンプルでは TRichEdit を非表示にしていますが,テキストファイルを TRichEdit で表示するのであれば,TRichEdit.PlainText プロパティの値を True にしておいた方が無難です.
|
リスト4
テキスト印刷の行間を 0.1 mm 単位で設定 |
procedure TForm1.Button1Click(Sender: TObject);
var
LPaperWidth : Integer;
LPaperHeight : Integer;
LParaFormat2 : TParaFormat2;
LbLineSpaceRule : Byte;
LFilePath : String;
begin
// 現在のプリンタの設定を TplSetPrinter コンポの値として取得
plPrev1.plSetPrinter.GetPrinterInfo;
// TplSetPrinter の情報を元にして用紙サイズ等のプロパティをセット
TPrev(plPrev1).SetPaperInfo;
// 用紙サイズ (0.1 mm 単位) を取得しておく
LPaperWidth := plPrev1.PaperWidth;
LPaperHeight := plPrev1.PaperHeight;
// テキストファイルの場合の行間を 0.1mm 単位で設定
// RTF ファイルの場合は RTF で設定済みなのでこの設定は無効
// 4 の時はTwips 値指定の行間となる
LbLineSpaceRule := 4;
RichEdit1.SelectAll;
FillChar(LParaFormat2, SizeOf(LParaFormat2), #0);
LParaFormat2.cbSize := SizeOf(LParaFormat2);
LParaFormat2.dwMask := PFM_LINESPACING;
// 行間の設定.0.1 mm 単位の値を wips 値に変換して指定
LParaFormat2.dyLineSpacing := MiliToTwips(70);
LParaFormat2.bLineSpacingRule := LbLineSpaceRule;
SendMessage(RichEdit1.Handle, EM_SETPARAFORMAT, 0, Longint(@LParaFormat2));
RichEdit1.SelStart := 0;
OpenDialog1.InitialDir := ExpandFileName('..\');
if not OpenDialog1.Execute then exit;
LFilePath := OpenDialog1.FileName;
if FileExists(LFilePath) then begin
Update;
Screen.Cursor := crHourGlass;
RichEdit1.Lines.LoadFromFile(LFilePath);
plPrev1.Title := '印刷テスト';
// 印刷領域を指定して印刷
RichEditPrint(300, LPaperWidth - 300, 350, LPaperHeight - 300, RichEdit1);
if CheckBox1.Checked then begin
plPrev1.Print;
end else begin
plPrev1.ShowModal;
end;
Screen.Cursor := crDefault;
end;
end;
05_TRichEdit.Print メソッドと PageRect を使用する印刷 |
ここまでのサンプルでは,印刷プレビューをしないで印刷を実行できるようになっています.
印刷プレビューが必要なければ TRichEdit の Print メソッドを使用して直接印刷できます.印刷の余白も PageRect プロパティで設定できます.その例です. |
プレインテキスト (プレーンテキスト) を印刷する場合は,TRichEdit にテキストを読み込んで表示することになりますが,以下のように設定した方がいいでしょう.
前項のサンプルのように,テキストファイルの印刷だけが目的であれば,PlainText の値はデフォルトの False のままでも印刷自体は問題ありません.TRichEdit を TMemo の代わりに使用してテキストを表示する場合は,PlainText プロパティの値が False のままで保存すると,リッチテキスト形式の保存になってしまいます.
|
TRichEdit.ScrollBars := ssVertical;
TRichEdit.WordWrap := True;
TRichEdit.PlainText := True;
|
図8
添付のリッチテキストの実行結果
|
リスト5
TRichEdit.Print メソッドと PageRect プロパティを使用する印刷 |
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Buttons, ExtCtrls, RichEdit, ComCtrls, plSetPrinter;
type
TForm1 = class(TForm)
Button1: TSpeedButton;
RichEdit1: TRichEdit;
PrinterSetupDialog1: TPrinterSetupDialog;
plSetPrinter1: TplSetPrinter;
procedure Button1Click(Sender: TObject);
procedure FormShow(Sender: TObject);
private
{ Private 宣言 }
public
{ Public 宣言 }
end;
function mmToPixelsX(ASetPrt: TplSetPrinter; AValue: Integer): Integer;
function mmToPixelsY(ASetPrt: TplSetPrinter; AValue: Integer): Integer;
var
Form1: TForm1;
implementation
{$R *.DFM}
//=============================================================================
// TRichEdit (書式付きテキスト) の読込み
// ワードの文書を RTF 形式で保存しておけば読込み可能
//
// プレインテキスト (書式なしテキスト) も読み込んで印刷可能
// TRichEdit を TMemo の代わりに使用してプレインテキストを表示する場合は
// 以下の設定で使用した方がいいかも知れない
// PlainText はデフォルトの False のままでもよいが,保存する場合に問題となる
//
// TRichEdit.ScrollBars := ssVertical;
// TRichEdit.WordWrap := True;
// TRichEdit.PlainText := True;
//=============================================================================
procedure TForm1.FormShow(Sender: TObject);
var
LFilePath : string;
begin
LFilePath := ExpandFileName('..\RichText.RTF');
if FileExists(LFilePath) then begin
RichEdit1.Lines.LoadFromFile(LFilePath);
Self.Width := 750;
Self.Height := 500;
end;
end;
//=============================================================================
// TRichEdit.Print メソッドで余白を設定して印刷
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
LRect : TRect;
begin
if not PrinterSetupDialog1.Execute then Exit;
// 現在のプリンタの設定を取得
plSetPrinter1.GetPrinterInfo;
// 印刷の余白を設定.余白はピクセル単位)
LRect.Left := mmToPixelsX(plSetPrinter1, 25);
LRect.Top := mmToPixelsY(plSetPrinter1, 30);
LRect.Right := plSetPrinter1.PaperWidth - mmToPixelsX(plSetPrinter1, 25);
LRect.Bottom := plSetPrinter1.PaperHeight - mmToPixelsY(plSetPrinter1, 30);
RichEdit1.PageRect := LRect;
RichEdit1.Print('テスト');
end;
//-----------------------------------------------------------------------------
// mm 単位を TPrinter.Canvas のピクセル数に変換
// 横方向用
//-----------------------------------------------------------------------------
function mmToPixelsX(ASetPrt: TplSetPrinter; AValue: Integer): Integer;
begin
Result := Trunc(AValue * ASetPrt.XResolution / 25.4);
end;
//-----------------------------------------------------------------------------
// mm 単位を TPrinter.Canvas のピクセル数に変換
// 縦方向用
//-----------------------------------------------------------------------------
function mmToPixelsY(ASetPrt: TplSetPrinter; AValue: Integer): Integer;
begin
Result := Trunc(AValue * ASetPrt.YResolution / 25.4);
end;
end.
|