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







番号シールの作成


DataSet プロパティを指定しない場合,LabelCount プロパティを指定すると,その数だけのラベルが作成できます.これを利用した番号シールの作成例です.このテストプログラムでは,プレビューフォームをメインフォームとしています.


図1
継承プレビューフォーム
  • これがメインフォーム
図2
印刷項目
  • DataSetf はなし.画像と文字列だけ
図3
実行画面
図4
番号シールラベル

リスト1
テストプログラムのコード
unit NumSheetUnit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, DB, DBTables, plPrev, plTackPrev, StdCtrls, ComCtrls, ExtCtrls,
  Buttons, plPrevfrm, Spin, Menus, ToolWin;

type
  TNumSheetForm = class(TplPrevForm)
    Panel1: TPanel;
    Panel5: TPanel;
    Panel6: TPanel;
    Panel7: TPanel;
    Panel2: TPanel;
    Panel3: TPanel;
    Panel4: TPanel;
    FontDialog1: TFontDialog;
    SpeedButton3: TSpeedButton;
    SpinEdit1: TSpinEdit;
    SpinEdit2: TSpinEdit;
    SpinEdit3: TSpinEdit;
    SpinEdit4: TSpinEdit;
    plTackPrev1: TplTackPrev;
    procedure SpeedButton3Click(Sender: TObject);
    procedure SpinEdit1Change(Sender: TObject);
    procedure plTackPrev1FormShow(Sender: TObject);
    procedure plTackPrev1BeforeDataDraw(Sender: TObject; Rect: TRect;
      ACol: Integer; var Text: String);
    procedure plTackPrev1AfterLabelDraw(Sender: TObject; Rect: TRect; ARow,
      ACol, LabelNo: Integer);
    procedure FormCreate(Sender: TObject);
  private
    { Private 宣言 }
    FStartNo : Integer;
    FFinalNo : Integer;
  public
    { Public 宣言 }
  end;

var
  NumSheetForm: TNumSheetForm;

implementation

{$R *.DFM}

//=============================================================================
//  フォームのOnCreateイベント処理
//=============================================================================
procedure TNumSheetForm.FormCreate(Sender: TObject);
begin
  //実行時に強制的なプリンタの設定が必要であればinheritedの前で行う
  plTackPrev1.plSetPrinter.PaperNumber := DMPAPER_A4;

  //継承フォームの場合,OnCreateではinheritedが必ず必要
  //このInheritedは継承元プレビューフォームのOnCreate
  inherited;
end;

//=============================================================================
//  TplTackPrevのOnFormShowイベント
//  フォーム表示開始で印刷開始ラベルの行列とラベル枚数等を設定
//  このフォームを表示するのでPreviwメソッドは不要
//=============================================================================
procedure TNumSheetForm.plTackPrev1FormShow(Sender: TObject);
begin
  //印刷開始ラベル行の最小値と最大値と初期値の設定
  SpinEdit1.MinValue := 1;
  SpinEdit1.MaxValue := plTackPrev1.LabelRowCnt;
  SpinEdit1.Value    := 1;

  //印刷開始ラベル列の最小値と最大値と初期値の設定
  SpinEdit2.MinValue := 1;
  SpinEdit2.MaxValue := plTackPrev1.LabelColCnt;
  SpinEdit2.Value    := 2;

  //印刷する番号札の番号の設定
  SpinEdit3.MaxLength := 3;
  SpinEdit3.MinValue  := 0;
  SpinEdit3.MaxValue  := 100;
  SpinEdit4.MaxLength := 3;
  SpinEdit4.MinValue  := 1;
  SpinEdit4.MaxValue  := 100;

  SpinEdit3.Value := 1;
  SpinEdit4.Value := 50;

  //印刷開始ラベルの行と列を指定
  plTackPrev1.StartRow := SpinEdit1.Value;
  plTackPrev1.StartCol := SpinEdit2.Value;
  //番号の初期値
  FStartNo := SpinEdit3.Value;
  FFinalNo   := SpinEdit4.Value;

  //ラベルの枚数を設定して,タックシール印刷コンポの実行
  plTackPrev1.LabelCount := Abs(FFinalNo - FStartNo) + 1;
end;

//=============================================================================
//  TplTackPrevのOnBeforePageDrawイベント
//  各頁表示前のイベント
//  ラベルのサイズとラベルの総数をステータスバーに表示
//=============================================================================
procedure TNumSheetForm.plTackPrev1BeforeDataDraw(Sender: TObject;
  Rect: TRect; ACol: Integer; var Text: String);
var
  LHorzSizeStr : String;
  LVertSizeStr : String;
  LText        : String;
begin
  LHorzSizeStr := '  横 ' + Format('%5.1f', [plTackPrev1.LabelWidth  / 10]) + ' mm';
  LVertSizeStr := '  縦 ' + Format('%5.1f', [plTackPrev1.LabelHeight / 10]) + ' mm';
  LText        := '   ラベル枚数 ' + IntToStr(plTackPrev1.LabelCount) + ' 枚';

  plTackPrev1.StatusBarText := '  ラベルサイズ' + LHorzSizeStr + LVertSizeStr + LText;
end;

//=============================================================================
//  TplTackPrevのOnAfterLabelDrawイベント
//  各ラベル描画後のイベント
//  (画像を貼付けているのでOnBeforeイベントだと文字が切れてしまう)
//  番号札の番号を描画する
//=============================================================================
procedure TNumSheetForm.plTackPrev1AfterLabelDraw(Sender: TObject;
  Rect: TRect; ARow, ACol, LabelNo: Integer);
var
  LabelNumber : Integer;
begin
  //フォント
  plTackPrev1.Canvas.Font.Assign(FontDialog1.Font);

  //TplTackPrevのフォントサイズに変換
  plTackPrev1.FontSize(FontDialog1.Font.Size);
  //開始番号の方が大きい場合は逆順
  if (FFinalNo < FStartNo) then begin
    LabelNumber := FStartNo - LabelNo+1;
  end else begin
    LabelNumber := FStartNo + LabelNo - 1;
  end;
  plTackPrev1.TextRectCC(Rect.Left,
                         Rect.Right,
                         Rect.Top,
                         Rect.Bottom,
                         IntToStr(LabelNumber));
end;

//=============================================================================
//  SpinEditで設定した内容で再描画
//=============================================================================
procedure TNumSheetForm.SpinEdit1Change(Sender: TObject);
begin
  TSpinEdit(Sender).Enabled := False;

  plTackPrev1.StartRow := SpinEdit1.Value;
  plTackPrev1.StartCol := SpinEdit2.Value;
  FStartNo             := SpinEdit3.Value;
  FFinalNo             := SpinEdit4.Value;

  //作成するラベルの枚数をLabelCountにセット
  plTackPrev1.LabelCount := Abs(FFinalNo - FStartNo) + 1;

  //以上の設定で再描画
  plTackPrev1.Display(plTackPrev1.PageNumber);
  TSpinEdit(Sender).Enabled := True;
  Application.ProcessMessages;
end;

//=============================================================================
//  [フォント設定]ボタンでフォントを変更したら再描画
//=============================================================================
procedure TNumSheetForm.SpeedButton3Click(Sender: TObject);
begin
  if FontDialog1.Execute then begin
    plTackPrev1.Display(plTackPrev1.PageNumber);
  end;
end;

end.