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







表形式の印刷


表形式でデータを印刷する例です.Delphi に付属の DBDEMOS を使用しています.「用紙のタイプ」は stSeal のままで,1 頁のラベルを 38 行 1 列にし,横長のラベルとしています.また,印刷開始行を 5 にして,最初の頁の上に空白を作っています.罫線は OnBeforePageDraw イベント内に書いています.なるべく汎用性のあるコードになるように努力してみました.


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


図1
設計時画面
図2
ラベルの色と枠線の設定
  • LabelColor を clNone (または clWhite)
  • LabelFrameLine の Style を psClear
図2
印刷項目の設定
図3
実行画面

図4
1 行が 1 枚のラベル

リスト2
テストプログラムのコード
unit TableUnit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, plPrev, plTackPrev, DB, DBTables, ExtCtrls, StdCtrls, Buttons;

type
  TForm1 = class(TForm)
    BitBtn1: TBitBtn;
    Query1: TQuery;
    Query1CustNo: TFloatField;
    Query1Company: TStringField;
    Query1Zip: TStringField;
    Query1Addr1: TStringField;
    Query1Phone: TStringField;
    Panel1: TPanel;
    plTackPrev1: TplTackPrev;
    procedure BitBtn1Click(Sender: TObject);
    procedure plTackPrint1BeforePageDraw(Sneder: TObject; DataNo,
      Page: Integer);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

//=============================================================================
//  クエリの結果を実行
//
//  Query1のSQL文は以下の通り
//  select  CustNo,Company,Zip,Addr1,Phone from customer
//=============================================================================
procedure TForm1.BitBtn1Click(Sender: TObject);
begin
  plTackPrev1.Title := '表形式の印刷テスト';

  //最初は1頁目を表示.指定しなければ最後に表示した頁となる
  plTackPrev1.PageNumber := 1;
  //シールタイプ
  plTackPrev1.SealType := stSeal;
  plTackPrev1.Preview;
end;

//=============================================================================
//  TplTackPrevのOnBeforeDrawイベント
//  各頁を描画する前に表の罫線を引く  
//  各データの印刷関係の設定は,TplTackPrevの項目エディタで行っている
//  開始ラベルを1以上にすると,1頁目の上に余白ができ,説明文字列などの挿入が可能
//
//
//  各項目の描画矩形領域の右端のX座標から縦罫線の位置を決定している
//  したがって,縦罫線位置は各項目の右端位置を調整すればよい
//=============================================================================
procedure TForm1.plTackPrint1BeforePageDraw(Sneder: TObject; DataNo,
  Page: Integer);
type
  TPosXArray = array of Integer;
var
  LPosXArray : TPosXArray;
  LLeft      : Integer;
  LRight     : Integer;
  LPosY      : Integer;
  LTop       : Integer;
  LBottom    : Integer;
  LRowHeight : Integer;
  LRowCount  : Integer;
  i          : Integer;
begin
  //ラベルの枠線は表示しない
  plTackPrev1.LabelFrameLine.Style := psClear;

  SetLength (LPosXArray, 3);                        //配列要素数は縦罫線の数
  LPosXArray[0] := plTackPrev1.Columns[0].X2 + 20;  //項目矩形右端+2mmに
  LPosXArray[1] := plTackPrev1.Columns[1].X2 + 20;  //こうすると矩形の右端
  LPosXArray[2] := plTackPrev1.Columns[2].X2 + 20;  //を調整すれば自動的

  plTackPrev1.LineColor(clBlack);     //線の色は黒
  plTackPrev1.LineStyle(psSolid);     //実線
  plTackPrev1.LineWidth(4);           //線の太さ

  LRowHeight := plTackPrev1.LabelHeight;         //行の高さ
  LLeft      := plTackPrev1.LeftMargin;          //左マージン
  LRight     := LLeft + plTackPrev1.LabelWidth;  //右マージンまでの距離

  if plTackPrev1.PageNumber = 1 then begin
    //画開始Y座標値
    LTop := plTackPrev1.TopMargin
          + (plTackPrev1.StartRow - 1) * LRowHeight - LRowHeight;
    //頁の行数
    LRowCount := plTackPrev1.LabelRowCnt - plTackPrev1.StartRow + 1;
    //最下行のY座標値
    LBottom := LTop + (LRowCount + 1) * LRowHeight;
  end else begin
    LTop      := plTackPrev1.TopMargin - LRowHeight;
    LRowCount := plTackPrev1.LabelRowCnt;
    LBottom   := LTop + (LRowCount + 1) * LRowHeight;
  end;

  //枠線
  plTackPrev1.RectLine(LLeft, LRight, LTop, LBottom);
  //タイトル行の下線
  plTackPrev1.Line(LLeft, LRight, LTop + LRowHeight, LTop + LRowHeight);
  //内側の罫線の太さ
  plTackPrev1.LineWidth(1);

  //横罫線
  LPosY := LTop + LRowHeight;
  for i := 1 to LRowCount - 1 do begin
    LPosY := LPosY + LRowHeight;
    plTackPrev1.Line(LLeft, LRight, LPosY, LPosY);
  end;

  //縦罫線
  plTackPrev1.Line (LLeft + LPosXArray[0], LLeft + LPosXArray[0], LTop, LBottom);
  plTackPrev1.Line (LLeft + LPosXArray[1], LLeft + LPosXArray[1], LTop, LBottom);
  plTackPrev1.Line (LLeft + LPosXArray[2], LLeft + LPosXArray[2], LTop, LBottom);

  //タイトル行のテキストを描画
  plTackPrev1.FontSize   (11);
  plTackPrev1.TextRectCC (LLeft, LLeft + LPosXArray[0],
                          LTop, LTop + LRowHeight,
                          'CustNo');
  plTackPrev1.TextRectCC (LLeft + LPosXArray[0], LLeft + LPosXArray[1],
                          LTop, LTop + LRowHeight,
                          'Company');
  plTackPrev1.TextRectCC (LLeft + LPosXArray[1], LLeft + LPosXArray[2],
                          LTop, LTop + LRowHeight,
                          'Zip');
  plTackPrev1.TextRectCC (LLeft + LPosXArray[2], LRight,
                          LTop, LTop + LRowHeight,
                          'Address');
end;

end.




1行はひとつのラベル


上の実行結果の図では,見掛け上は表となっていますが,1 行はひとつのラベルとなっています.したがって,行の任意の位置に文字列やイメージを挿入できるわけです.
例えば,セル内に 2 行の文字列とかも可能なわけです.