9.3.12 Visual Basicを使用した書式印刷例

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

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

(a) コーディング例

VERSION 5.00
Begin VB.Form Form1
  Caption         =   "Form1"
  ClientHeight    =   2640
  ClientLeft      =   4020
  ClientTop       =   2340
  ClientWidth     =   4665
  LinkTopic       =   "Form1"
  PaletteMode     =   1  'Z オーダー
  ScaleHeight     =   2640
  ScaleWidth      =   4665
  Begin VB.CommandButton Command2
     Caption         =   "終了"
     Height          =   375
     Left            =   3360
     TabIndex        =   1
     Top             =   2040
     Width           =   1095
  End
  Begin VB.CommandButton Command1
     Caption         =   "印刷"
     Height          =   375
     Left            =   2040
     TabIndex        =   0
     Top             =   2040
     Width           =   1095
  End
  Begin VB.Label Label2
     Caption         =   "書式を印刷します"
     BeginProperty Font
        Name            =   "MS Pゴシック"
        Size            =   18
        Charset         =   128
        Weight          =   400
        Underline       =   0   'False
        Italic          =   0   'False
        Strikethrough   =   0   'False
     EndProperty
     Height          =   495
     Left            =   960
     TabIndex        =   3
     Top             =   1080
     Width           =   3135
  End
  Begin VB.Label Label1
     Caption         =   "VB例題"
     BeginProperty Font
        Name            =   "MS Pゴシック"
        Size            =   14.25
        Charset         =   128
        Weight          =   700
        Underline       =   0   'False
        Italic          =   0   'False
        Strikethrough   =   0   'False
     EndProperty
     Height          =   375
     Left            =   3360
     TabIndex        =   2
     Top             =   240
     Width           =   1095
  End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
 'DBから読み込んだデータと仮定する変数
 Dim dbId As String            '得意先コード
 Dim dbName As String          '得意先名
 Dim dbMdseId(3) As String     '商品コード
 Dim dbMdse(3) As String       '商品名
 Dim dbPrice(3) As Integer     '単価
 Dim dbUnit(3) As Integer      '数量


'本サンプル実行にあたり,表示・印刷セットアップの「プリンタ」タブで
'以下の設定を行って下さい
'    仮想端末名 : PRT001
'    サービス名 : #PRT
'    印刷モード : GDIページ:ページプリンタ
'                  または PDLスルー:LIPS準拠ページプリンタ


 'JYUOVL6Gのフォーマット(ここから)
 'ヘッダー部の構成
   Const cnsHeaderNewLine1 = 4    'ヘッダー部の最上段から
                                  'コード情報行までの改行数
   'ヘッダーのコード情報行
   Private Type Header_Id
     byteSpc1(16) As Byte         'コード行のスペースカラム数
     byteId(7) As Byte            'コード情報のカラム数
   End Type
   'ヘッダーの得意先名行
   Private Type Header_Name
     byteSpc1(16) As Byte         '得意先名行のスペースカラム数
     byteName(36) As Byte         '得意先名情報のカラム数
   End Type
   Const cnsHeaderNewLine2 = 1    'ヘッダー部の終了行までの改行数
 '明細部の構成
   Const cnsDetailNewLine1 = 1    '明細部の最上段から明細行までの改行数
   '明細行
   Private Type Detail
     byteSpc1(1) As Byte          '空白の文字数
     byteSpcMdseId(0) As Byte     '空白の文字数
     byteMdseId(10) As Byte       '商品コードの文字数
     byteSpcMdse(0) As Byte       '空白の文字数
     byteMdse(25) As Byte         '商品名の文字数
     bytePrice(8) As Byte         '単価の文字数
     byteSpcPrice(0) As Byte      '空白の文字数
     byteUnit(4) As Byte          '数量の文字数
     byteSpcUnit(0) As Byte       '空白の文字数
     byteSubTotal(15) As Byte     '金額の文字数
     byteSpcSubTotal(0) As Byte   '空白の文字数
   End Type
 'トレイラ部の構成
   Const cnsTrailerNewLine1 = 1   '明細部の最上段から合計行までの改行数
   '合計行
   Private Type Trailer_Total
     byteSpc1(52) As Byte         '空白の文字数
     byteTotal(16) As Byte        '金額の文字数
   End Type
 'JYUOVL6Gのフォーマット(ここまで)



'エラーメッセージを表示する
Sub ErrMsg(lRetcode As Long, lErrcode As Long)
 Dim lRet As Long

 message = "印刷処理でエラーが発生しました。" & Chr(13)
 message = message & "リターンコード = " & lRetcode & Chr(13)
 message = message & "詳細コード    = " & lErrcode & Chr(13)
 lRet = MsgBox(message, MB_ICONSTOP, "エラー")
End Sub



'ボタンが押された時印刷する。ここは,メインルーチンとなる。
Private Sub Command1_Click()
 Dim lTermid As Long                     '端末識別子
 Dim lRetcode As Long                    'リターンコード
 Dim lErrcode As Long                    '詳細コード
 Const PRT = "#PRT"                      'サービス名称
 
 lRetcode = XmapFrmCreateOpen(PRT)    'プリンタのオープン。
                                         '書式オーバーレイ印刷するプリンタ
                                       'のサービス名称でオープンします
 If lRetcode = 0 Then
   'エラー発生時にはXmapFrmCloseを発行しなくても,自動的にクローズされる
   lErrcode = XmapFrmGetError()          '詳細エラーコードの取得
   Call ErrMsg(lRetcode, lErrcode)
   Exit Sub
 End If
 
 lTermid = lRetcode                       '端末識別子の設定
 
 lRetcode = PrintPage(lTermid)             '1ページ印刷
 If lRetcode = -1 Then
   'エラー発生時にはXmapFrmCloseを発行しなくても,自動的にクローズされる
   lErrcode = XmapFrmGetError()            '詳細エラーコードの取得
   Call ErrMsg(lRetcode, lErrcode)
   Exit Sub
 End If
 
 lRetcode = XmapFrmClose(lTermid)           'プリンタのクローズ処理
 If lRetcode = -1 Then
   'エラー発生時にはXmapFrmCloseを発行しなくても,自動的にクローズされる
   lErrcode = XmapFrmGetError()             '詳細エラーコードの取得
   Call ErrMsg(lRetcode, lErrcode)
   Exit Sub
 End If

End Sub


'1ページ印刷(JYUOVL6G印刷のメインルーチン)
Private Function PrintPage(lTermid As Long) As Long
 Const JYUOVL6G = "JYUOVL6G"                           '書式名の指定
 
 PrintPage = XmapFrmSetPage(lTermid,
                            vbNullString, JYUOVL6G)    'ページ情報の設定
 If PrintPage = -1 Then
   Exit Function
 End If

 PrintPage = PrintHeader(lTermid)                      'ヘッダー印刷
 If PrintPage = -1 Then
   Exit Function
 End If

 PrintPage = PrintDetail(lTermid)                      '明細印刷
 If PrintPage = -1 Then
   Exit Function
 End If

 PrintPage = PrintTrailer(lTermid)                     'トレイラ印刷
 If PrintPage = -1 Then
   Exit Function
 End If
End Function



'ヘッダー印刷
Private Function PrintHeader(lTermid As Long) As Long
 '以下のデータをDBから入力したと想定する
 dbId = "012345"
 dbName = "○×電器"
     
 '位置合わせの為の改行
 PrintHeader = PrintNoDataNewLine(lTermid,         '位置合わせの為の改行
                                  cnsHeaderNewLine1)      
 If PrintHeader = -1 Then
   Exit Function
 End If
 
 'コード情報行
 Dim idWork As Header_Id
 Call XmapStrMoveLeft(idWork, Len(idWork), " ", 1, Asc(" "))
 Call XmapStrMoveLeft(idWork.byteId(0),
                      UBound(idWork.byteId) + 1, _
                      dbId, LenB(StrConv(dbId, vbFromUnicode)),
                      Asc(" "))
 PrintHeader = XmapFrmSetData(lTermid,                   'コード情報設定
                              idWork, Len(idWork))
 If PrintHeader = -1 Then
   Exit Function
 End If
 PrintHeader = PrintNewLine(lTermid)       'コード情報出力と1行改行
 If PrintHeader = -1 Then
   Exit Function
 End If

 '得意先名行
 Dim nameWork As Header_Name
 Call XmapStrMoveLeft(nameWork, Len(nameWork), " ", 1, Asc(" "))
 Call XmapStrMoveLeft(nameWork.byteName(0),
                      UBound(nameWork.byteName) + 1, _
                      dbName, LenB(StrConv(dbName, vbFromUnicode)),
                      Asc(" "))
 PrintHeader = XmapFrmSetData(lTermid,                      '名前情報設定
                              nameWork, Len(nameWork))
 If PrintHeader = -1 Then
   Exit Function
 End If
 PrintHeader = PrintNewLine(lTermid,         '名前情報出力と1行改行と
                     1 + cnsHeaderNewLine2)   'ヘッダー部の終了行までの改行
 If PrintHeader = -1 Then
   Exit Function
 End If
 
End Function



'明細印刷
Private Function PrintDetail(lTermid As Long) As Long
 '以下のデータを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
 
 '位置合わせの為の改行
 PrintDetail = PrintNoDataNewLine(lTermid,      '位置合わせの為の改行
                                  cnsDetailNewLine1)
 If PrintDetail = -1 Then
   Exit Function
 End If
 
 '明細行
 Dim detailWork As Detail
 For nLoop = 0 To 3                              '明細行数分繰り返す
   Call XmapStrMoveLeft(detailWork, Len(detailWork), " ",
                        1, Asc(" "))
   Call XmapStrMoveLeft(detailWork.byteMdseId(0),
                        UBound(detailWork.byteMdseId) + 1, _
                        dbMdseId(nLoop), LenB(StrConv(dbMdseId(nLoop),
                        vbFromUnicode)), Asc(" "))
   Call XmapStrMoveLeft(detailWork.byteMdse(0),
                        UBound(detailWork.byteMdse) + 1, _
                        dbMdse(nLoop), LenB(StrConv(dbMdse(nLoop),
                        vbFromUnicode)), Asc(" "))
   Call XmapStrItoA(detailWork.bytePrice(0),
                   UBound(detailWork.bytePrice) + 1, _
                   dbPrice(nLoop), XMAPSTR_RIGHT, Asc(" "))
   Call XmapStrItoA(detailWork.byteUnit(0),
                   UBound(detailWork.byteUnit) + 1, _
                   dbUnit(nLoop), XMAPSTR_RIGHT, Asc(" "))
   Call XmapStrItoA(detailWork.byteSubTotal(0),
                   UBound(detailWork.byteSubTotal) + 1, _
                   dbPrice(nLoop) * dbUnit(nLoop), XMAPSTR_RIGHT,
                   Asc(" "))
   PrintDetail = XmapFrmSetData(lTermid, detailWork,   '名前情報設定
                                Len(detailWork))
   If PrintDetail = -1 Then
     Exit Function
   End If
   PrintDetail = PrintNewLine(lTermid)          '名前情報出力と1行改行
   If PrintDetail = -1 Then
     Exit Function
   End If
 Next nLoop

End Function



'トレイラ印刷
Private Function PrintTrailer(lTermid As Long) As Long
 Dim lTotal As Long                                           '合計金額
 Dim nLoop As Integer                                         'ループ変数
 
 '位置合わせの為の改行
 PrintTrailer = PrintNoDataNewLine(lTermid,      '位置合わせの為の改行
                                   cnsTrailerNewLine1)
 If PrintTrailer = -1 Then
   Exit Function
 End If
 
 '合計の計算
 lTotal = 0
 For nLoop = 0 To UBound(dbUnit)
   lTotal = lTotal + dbPrice(nLoop) * dbUnit(nLoop)
 Next nLoop
 '合計行の印刷
 Dim totalWork As Trailer_Total
 Call XmapStrMoveLeft(totalWork, Len(totalWork), " ", 1, Asc(" "))
 Call XmapStrItoA(totalWork.byteTotal(0),
                UBound(totalWork.byteTotal) + 1, _ lTotal,
                XMAPSTR_SUM Or XMAPSTR_SYMBOL Or XMAPSTR_RIGHT,
                Asc(" "))
 PrintTrailer = XmapFrmSetData(lTermid, totalWork,    '合計情報設定
                               Len(totalWork))
 If PrintTrailer = -1 Then
   Exit Function
 End If
 PrintTrailer = PrintNewLine(lTermid)                '合計出力と1行改行
 If PrintTrailer = -1 Then
   Exit Function
 End If
 
End Function


'指定行数改行ルーチン(行データを設定してない時)
Private Function PrintNoDataNewLine(lTermid As Long, _
                                   lLine As Long) As Long
 '改行の為のダミーデータ設定
 PrintNoDataNewLine = XmapFrmSetData(lTermid,
                                     StrConv(" ", vbFromUnicode), 1)
 If PrintNoDataNewLine = -1 Then
   Exit Function
 End If
 PrintNoDataNewLine = PrintNewLine(lTermid, lLine)
End Function



'指定行数改行ルーチン(行データを設定している時)
Private Function PrintNewLine(lTermid As Long, _
                             Optional varLine, _
                             Optional varTiming) As Long
 Dim lLine As Long                        'XmapFrmSetNewLineの改行数
 If IsMissing(varLine) Then
   lLine = 1                              '1行(省略時仮定値)
 Else
   lLine = varLine
 End If

 Dim lTiming As Long                 'XmapFrmSetLineの行送りタイミング
 If IsMissing(varTiming) Then
   lTiming = 1                        '行送り前に行出力をする(省略時仮定値)
 Else
   lTiming = varTiming
 End If
 
 PrintNewLine = XmapFrmSetNewLine(lTermid, lLine)
 If PrintNewLine = -1 Then
   Exit Function
 End If
 PrintNewLine = XmapFrmSetLine(lTermid, lTiming)
End Function


Private Sub Command2_Click()
 End
End Sub