Delphi Programming / Object Pascal
サイトのトップページへ リンクのページへ ロゴマーク
[掲載 2001年02月04日] [更新 2016年04月30日] Query 印刷コンポーネント
   
Query 印刷コンポーネント
テストプログラム  OnBeforePrintCell
動作確認等 Windows 7 U64(SP1) + Delphi XE(UP1) Pro







セルの描画を変更


OnBeforePrintCell イベントを使用して,セルの描画内容などを変更する例です.
下図の様に,特定の列のセルの背景色を変更し,住所の項目列に 2 つの項目内容を 2 行にして描画しています.また,タイトル行のセル背景色も変更してみました.


リスト1
Query1 の SQL プロパティ
select CustNo,Company,Zip,Addr1,Addr2,Phone from customer


図1
設計時画面
図2
印刷項目

  • 図3 
  • 実行結果

リスト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.