Delphi Programming / Object Pascal
[掲載 2001年02月04日] [更新 2016年04月30日] Query 印刷コンポーネント |
Query 印刷コンポーネント
テストプログラム OnBeforePrintCell |
動作確認等 |
Windows 7 U64(SP1) + Delphi XE(UP1) Pro |
OnBeforePrintCell イベントを使用して,セルの描画内容などを変更する例です.
下図の様に,特定の列のセルの背景色を変更し,住所の項目列に 2 つの項目内容を 2 行にして描画しています.また,タイトル行のセル背景色も変更してみました. |
select CustNo,Company,Zip,Addr1,Addr2,Phone from customer
|
図1
設計時画面 |
|
図2
印刷項目 |
unit OnBeforePrintCellUnit;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, plPrev, plQueryPrev, DB, DBTables;
type
TForm1 = class(TForm)
Query1: TQuery;
plQueryPrev1: TplQueryPrev;
Button1: TButton;
procedure Button1Click(Sender: TObject);
procedure plQueryPrev1BeforePrintCell(Sender: TObject; Rect: TRect;
ACol, ARow, PageRow: Integer; var Text: String; fDataRow: Boolean);
private
{ Private 宣言 }
public
{ Public 宣言 }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
//=============================================================================
// クエリの結果を印刷プレビュー
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
plQueryPrev1.Title := 'セルに2つの項目値を印刷';
plQueryPrev1.Preview;
end;
//=============================================================================
// plQueryPrev1のOnBeforePrintCellイベント処理
// 各セルの描画前に発生するイベント
//=============================================================================
procedure TForm1.plQueryPrev1BeforePrintCell(Sender: TObject;
Rect: TRect; ACol, ARow, PageRow: Integer; var Text: String;
fDataRow: Boolean);
var
LPV : TplQueryPrev;
LFieldName : string;
LText1 : string;
LText2 : string;
LLeft : Integer;
LRight : Integer;
LTop : Integer;
LBottom : Integer;
begin
LPV := Sender as TplQueryPrev;
//セル領域の左右上下の座標値を取得
LLeft := Rect.Left;
LRight := Rect.Right;
LTop := Rect.Top;
LBottom := Rect.Bottom;
//タイトル行のセル背景色を変更
if ARow = 0 then begin
//色の指定
LPV.Canvas.Brush.Color := $00E6E6E6;
LPV.FillRect(LLeft, LRight, LTop, LBottom);
exit;
end;
if not (fDataRow) then exit;
//ACol番目の項目名を取得
LFieldName := LPV.Columns[ACol].FieldName;
//項目名がCompanyならセルの背景色を変更
if LFieldName = 'Company' then begin
LPV.Canvas.Brush.Color := $00E1FFEE;
LPV.FillRect (LLeft, LRight, LTop, LBottom);
end else
if LFieldName = 'Addr1' then begin
//項目名がAddr1なら本来描画すべき文字は空にして項目Zipと2行で印刷
Text := '';
//印刷する文字列を取得
LText1 := '〒 ' + LPV.DataSet.FieldByName('Zip').AsString;
LText2 := LPV.DataSet.FieldByName('Addr1').AsString;
LPV.TextRectLC (LLeft + 20, LRight, LTop + 10, (LBottom + LTop) div 2, LText1);
LPV.TextRectLC (LLeft + 20, LRight, (LBottom + LTop) div 2, LBottom - 10, LText2);
end;
end;
end.
|