9.3.13 Delphiを使用した書式印刷例

入門のマニュアルで説明している書式オーバレイの例題を,Delphiで作成したときのコーディング例を次に示します。入門例題の仕様については,マニュアル「XMAP3 入門」を参照してください。ここでは,コーディングだけを紹介します。

なお,例題で使用している定義ファイル名は,JYUOVL.ifmです。

(a) コーディング例

unit JYUTUFD;

interface

uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
 Dialogs, StdCtrls, X3mwgd32, X3mwst32;

type
 TForm1 = class(TForm)
   Button1: TButton;
   Button2: TButton;
   Label1: TLabel;
   Label2: TLabel;
   procedure Button1Click(Sender: TObject);
   procedure Button2Click(Sender: TObject);
 private
   { Private 宣言 }
   procedure ErrMsg(nRetcode: integer; nErrcode: integer);
   function PrintPage(nTermid: integer): integer;
   function PrintNoDataNewLine(nTermid: integer;
                               nLine: integer): integer;
   function PrintNewLine(nTermid: integer;
                         nLine: integer;
                         nTiming: integer): integer;
   function PrintHeader(nTermid: integer): integer;
   function PrintDetail(nTermid: integer): integer;
   function PrintTrailer(nTermid: integer): integer;
 public
   { Public 宣言 }
 end;

var
//DBから読み込んだデータと仮定する変数
 dbId:     String;                 //得意先コード
 dbName:   String;                 //得意先名
 dbMdseId: array[0..3] of String;  //商品コード
 dbMdse:   array[0..3] of String;  //商品名
 dbPrice:  array[0..3] of Integer; //単価
 dbUnit:   array[0..3] of Integer; //数量



 //JYUOVL6Gのフォーマット(ここから)
 //ヘッダー部の構成
const
   cnsHeaderNewLine1 = 4;         //ヘッダー部の最上段から
                                  //コード情報行までの改行数
   //ヘッダーのコード情報行
type
   Header_Id = packed record
     cSpc1: array[0..16] of char; //コード行のスペースカラム数
     cId:   array[0..7] of char;  //コード情報のカラム数
   End;
   //ヘッダーの得意先名行
   Header_Name = packed record
     cSpc1: array[0..16] of char; //得意先名行のスペースカラム数
     cName: array[0..36] of char; //得意先名情報のカラム数
   End;
const
   cnsHeaderNewLine2 = 1;      //ヘッダー部の終了行までの改行数
 //明細部の構成
   cnsDetailNewLine1 = 1;      //明細部の最上段から明細行までの改行数
   //明細行
type
   Detail = packed record
     cSpc1: array[0..1] of char;      //空白の文字数
     cSpcMdseId: array[0..0] of char;    //空白の文字数
     cMdseId: array[0..10] of char;   //商品コードの文字数
     cSpcMdse: array[0..0] of char;      //空白の文字数
     cMdse: array[0..25] of char;     //商品名の文字数
     cPrice: array[0..8] of char;     //単価の文字数
     cSpcPrice: array[0..0] of char;     //空白の文字数
     cUnit: array[0..4] of char;      //数量の文字数
     cSpcUnit: array[0..0] of char;      //空白の文字数
     cSubTotal: array[0..15] of char; //金額の文字数
     cSpcSubTotal: array[0..0] of char;  //空白の文字数
   End;
 //トレイラ部の構成
const
   cnsTrailerNewLine1 = 1;     //明細部の最上段から合計行までの改行数
   //合計行
type
   Trailer_Total = packed record
     cSpc1: array[0..52] of char;     //空白の文字数
     cTotal: array[0..16] of char;    //金額の文字数
   End;
 //JYUOVL6Gのフォーマット(ここまで)



var
 Form1: TForm1;

implementation

{$R *.DFM}
//エラーメッセージを表示する
procedure TForm1.ErrMsg(nRetcode: integer; nErrcode: integer);
var
 wRet: word;
 strMessage: string;
begin
 strMessage := '印刷処理でエラーが発生しました。' + Char(13);
 strMessage := strMessage + 'リターンコード =
                                       ' + IntToStr(nRetcode) + Char(13);
 strMessage := strMessage + '詳細コード    =
                                       ' + IntToStr(nErrcode) + Char(13);
 wRet := MessageDlg(strMessage, mtError, [mbYes], 0);
End;


//印刷ボタンが押された時の処理
procedure TForm1.Button1Click(Sender: TObject);
var
 nTermid: integer;                   //端末識別子
 nRetcode: integer;                  //リターンコード
 nErrcode: integer;                  //詳細コード
const
 PRT = '#PRT';                      //サービス名称

begin
 nRetcode := XmapFrmCreateOpen(PRT); //プリンタのオープン
 if nRetcode = 0 then
 begin
   //エラー発生時にはXmapFrmCloseを発行しなくても,自動的にクローズされる
   nErrcode := XmapFrmGetError();    //詳細エラーコードの取得
   ErrMsg(nRetcode, nErrcode);
   Exit;
 end;

 nTermid := nRetcode;                //端末識別子の設定

 nRetcode := PrintPage(nTermid);     //1ページ印刷
 if nRetcode = -1 then
 begin
   //エラー発生時にはXmapFrmCloseを発行しなくても,自動的にクローズされる
   nErrcode := XmapFrmGetError();    //詳細エラーコードの取得
   ErrMsg(nRetcode, nErrcode);
   Exit;
 end;

 nRetcode := XmapFrmClose(nTermid);  //プリンタのクローズ処理
 if nRetcode = -1 then
 begin
   nErrcode := XmapFrmGetError();    //詳細エラーコードの取得
   ErrMsg(nRetcode, nErrcode);
   Exit;
 end;
end;



//1ページ印刷(JYUOVL6G印刷のメインルーチン)
function TForm1.PrintPage(nTermid: integer): integer;
var
 nRetcode: integer;                  //リターンコード
const
 JYUOVL6G = 'JYUOVL6G';              //書式名の指定

begin
 nRetcode := XmapFrmSetPage(nTermid,              //ページ情報の設定
                            Pchar(0), JYUOVL6G);
 if nRetcode = -1 then
 begin
   PrintPage := nRetcode;
   Exit;
 end;


 nRetcode := PrintHeader(nTermid);   //ヘッダー印刷
 if nRetcode = -1 then
 begin
   PrintPage := nRetcode;
   Exit;
 end;

 nRetcode := PrintDetail(nTermid);   //明細印刷
 if nRetcode = -1 then
 begin
   PrintPage := nRetcode;
   Exit;
 end;

 nRetcode := PrintTrailer(nTermid);  //トレイラ印刷
 if nRetcode = -1 then
 begin
   PrintPage := nRetcode;
   Exit;
 end;
end;


//ヘッダー印刷
function TForm1.PrintHeader(nTermid: integer): integer;
var
 nRetcode: integer;                 //リターンコード
 idWork: Header_Id;
 nameWork: Header_Name;
 strWork: string;                   //文字セット用のワーク
 nLng: integer;                     //文字セット用のワーク
begin
 //以下のデータをDBから入力したと想定する
 dbId := '012345';
 dbName := '○×電器';

 //位置合わせの為の改行
 nRetcode := PrintNoDataNewLine(nTermid,      //位置合わせのための改行
                              cnsHeaderNewLine1);
 if nRetcode = -1 then
 begin
   PrintHeader := nRetcode;
   Exit;
 end;

 //コード情報行
 XmapStrMoveLeft(idWork.cSpc1, sizeof(idWork.cSpc1), ' ', 1, ' ');
 XmapStrMoveLeft(idWork.cId, sizeof(idWork.cId), @dbId[1],
                 Length(dbId), ' ');
 nRetcode := XmapFrmSetData(nTermid, LPSTR(@idWork),
                            sizeof(idWork));         //コード情報設定
 if nRetcode = -1 then
 begin
   PrintHeader := nRetcode;
   Exit;
 end;
 nRetcode := PrintNewLine(nTermid, 1, 1);   //コード情報出力と1行改行
 if nRetcode = -1 then
 begin
   PrintHeader := nRetcode;
   Exit;
 end;


 //得意先名行
 XmapStrMoveLeft(nameWork.cSpc1,
                 sizeof(nameWork.cSpc1), ' ', 1, ' ');
 XmapStrMoveLeft(nameWork.cName, sizeof(nameWork.cName),
                 @dbName[1], Length(dbName), ' ');
 nRetcode := XmapFrmSetData(nTermid, LPSTR(@nameWork),
                            sizeof(nameWork));        //名前情報設定
 if nRetcode = -1 then
 begin
   PrintHeader := nRetcode;
   Exit;
 end;
 nRetcode := PrintNewLine(nTermid,                 //名前情報出力と1行
                          1 + cnsHeaderNewLine2,   //改行とヘッダー部の
                          1);                      //終了行までの改行
 if nRetcode = -1 then
 begin
   PrintHeader := nRetcode;
   Exit;
 end;

end;



//明細印刷
function TForm1.PrintDetail(nTermid: integer): integer;
var
 nRetcode: integer;                 //リターンコード
 detailWork: Detail;
 nLoop: integer;                    //ループ変数
 strWork: string;                   //文字セット用のワーク
 nLng: integer;                     //文字セット用のワーク
begin
 //以下のデータをDBから入力したと想定する
 dbMdseId[0] := 'A001';
 dbMdse[0] := 'ビデオ';
 dbPrice[0] := 1000;
 dbUnit[0] := 2;
 dbMdseId[1] := 'B001';
 dbMdse[1] := 'テレビ';
 dbPrice[1] := 5000;
 dbUnit[1] := 3;
 dbMdseId[2] := 'C001';
 dbMdse[2] := 'ラジオ';
 dbPrice[2] := 2000;
 dbUnit[2] := 7;
 dbMdseId[3] := 'D001';
 dbMdse[3] := 'BSチューナー';
 dbPrice[3] := 3000;
 dbUnit[3] := 1;


 //位置合わせの為の改行
 nRetcode := PrintNoDataNewLine(nTermid,       //位置合わせの為の改行
                               cnsDetailNewLine1);
 if nRetcode = -1 then
 begin
   PrintDetail := nRetcode;
   Exit;
 end;

 //明細行
 for nLoop := 0 to 3 do                       //明細行数分繰り返す
 begin
   XmapStrMoveLeft(LPSTR(@detailWork), sizeof(detailWork),
                   ' ', 1, ' ');
   XmapStrMoveLeft(detailWork.cMdseId, sizeof(detailWork.cMdseId),
                   @dbMdseId[nLoop][1], Length(dbMdseId[nLoop]), ' ');
   XmapStrMoveLeft(detailWork.cMdse, sizeof(detailWork.cMdse),
                   @dbMdse[nLoop][1], Length(dbMdse[nLoop]), ' ');
   XmapStrItoA(detailWork.cPrice, sizeof(detailWork.cPrice),
               dbPrice[nLoop], XMAPSTR_RIGHT, ' ');
   XmapStrItoA(detailWork.cUnit, sizeof(detailWork.cUnit),
               dbUnit[nLoop], XMAPSTR_RIGHT, ' ');
   XmapStrItoA(detailWork.cSubTotal, sizeof(detailWork.cSubTotal),
               dbPrice[nLoop] * dbUnit[nLoop], XMAPSTR_RIGHT, ' ');
   nRetcode := XmapFrmSetData(nTermid, LPSTR(@detailWork), sizeof(detailWork));   //名前情報設定
   if nRetcode = -1 then
   begin
     PrintDetail := nRetcode;
     Exit;
   end;
   nRetcode := PrintNewLine(nTermid, 1, 1);   //名前情報出力と1行改行
   if nRetcode = -1 then
   begin
     PrintDetail := nRetcode;
     Exit;
   end;
 end;

end;



//トレイラ印刷
function TForm1.PrintTrailer(nTermid: integer): integer;
var
 nRetcode: integer;                  //リターンコード
 nTotal: integer;                    //合計金額
 nLoop: integer;                     //ループ変数
 totalWork: Trailer_Total;
 strWork: string;                    //文字セット用のワーク
 nLng: integer;                      //文字セット用のワーク
begin
 //位置合わせの為の改行
 nRetcode := PrintNoDataNewLine(nTermid,         //位置合わせの為の改行
                                cnsTrailerNewLine1);
 if nRetcode = -1 then
 begin
   PrintTrailer := nRetcode;
   Exit;
 end;


 //合計の計算
 nTotal := 0;
 for nLoop := 0 to high(dbUnit) do
   nTotal := nTotal + dbPrice[nLoop] * dbUnit[nLoop];
 //合計行の印刷
 XmapStrMoveLeft(LPSTR(@totalWork), sizeof(totalWork),
                 ' ', 1, ' ');
 XmapStrItoA(totalWork.cTotal, sizeof(totalWork.cTotal), nTotal,
             XMAPSTR_SUM or XMAPSTR_SYMBOL or XMAPSTR_RIGHT, ' ');
 nRetcode := XmapFrmSetData(nTermid,              //合計情報設定
                            LPSTR(@totalWork), sizeof(totalWork));
 if nRetcode = -1 then
 begin
   PrintTrailer := nRetcode;
   Exit;
 end;
 nRetcode := PrintNewLine(nTermid, 1 ,1);  //合計出力と1行改行
 if nRetcode = -1 then
 begin
   PrintTrailer := nRetcode;
   Exit;
 end;

end;



//指定行数改行ルーチン(行データを設定してない時)
function TForm1.PrintNoDataNewLine(nTermid: integer; nLine: integer): integer;
var
 nRetcode: integer;                        //リターンコード
begin
 //改行の為のダミーデータ設定
 nRetcode := XmapFrmSetData(nTermid, ' ', 1);
 if nRetcode = -1 then
 begin
   PrintNoDataNewLine := nRetcode;
   Exit;
 end;
 PrintNoDataNewLine := PrintNewLine(nTermid, nLine, 1);
end;


//指定行数改行ルーチン(行データを設定している時)
function TForm1.PrintNewLine(nTermid: integer;
                            nLine: integer;
                            nTiming: integer): integer;
var
 nRetcode: integer;                        //リターンコード
begin
 nRetcode := XmapFrmSetNewLine(nTermid, nLine);
 if nRetcode = -1 then
 begin
   PrintNewLine := nRetcode;
   Exit;
 end;
 PrintNewLine := XmapFrmSetLine(nTermid, nTiming);
end;



procedure TForm1.Button2Click(Sender: TObject);
begin
 Close;
end;

end.