入門のマニュアルで説明している書式オーバレイの例題を，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            =   "ＭＳ Ｐゴシック"
         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         =   "ＶＢ例題"
      BeginProperty Font 
         Name            =   "ＭＳ Ｐゴシック"
         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
  'ＤＢから読み込んだデータと仮定する変数
  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準拠ページプリンタ
 
 
  'ＪＹＵＯＶＬ６Ｇのフォーマット（ここから）
  'ヘッダー部の構成
    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
  'ＪＹＵＯＶＬ６Ｇのフォーマット（ここまで）
 
 
 
'エラーメッセージを表示する
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
 
 
'１ページ印刷（ＪＹＵＯＶＬ６Ｇ印刷のメインルーチン）
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
  '以下のデータをＤＢから入力したと想定する
  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)       'コード情報出力と１行改行
  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 + cnsHeaderNewLine2)   'ヘッダー部の終了行までの改行
  If PrintHeader = -1 Then
    Exit Function
  End If
  
End Function
 
 
 
'明細印刷
Private Function PrintDetail(lTermid As Long) As Long
  '以下のデータをＤＢから入力したと想定する
  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) = "ＢＳチューナー"
  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)          '名前情報出力と１行改行
    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)                '合計出力と１行改行
  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                              '１行（省略時仮定値）
  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