画面・帳票サポートシステム XMAP3 プログラミングガイド 帳票編

[目次][用語][索引][前へ][次へ]

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.