入門のマニュアルで説明している書式オーバレイの例題を,Visual Basicで作成したときのコーディング例を次に示します。入門例題の仕様については,マニュアル「XMAP3 入門」を参照してください。ここでは,コーディングだけを紹介します。
なお,例題で使用している定義ファイルは,JYUOVL.ifmです。
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