VERSION 5.00
Object = "{D5347593-DA48-11D4-9130-0050041A856D}#1.0#0"; "BcpCtrl.ocx"
Begin VB.Form frmBarPri 
   Caption         =   "バーコードプリント"
   ClientHeight    =   1170
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   4350
   ControlBox      =   0   'False
   LinkTopic       =   "Form1"
   ScaleHeight     =   1170
   ScaleWidth      =   4350
   StartUpPosition =   2  '画面の中央
   Begin BCPISSLib.BcpCtrl BcpCtrl 
      Left            =   660
      Top             =   600
      _Version        =   65536
      _ExtentX        =   847
      _ExtentY        =   847
      _StockProps     =   0
   End
   Begin VB.CommandButton cmdStop 
      Caption         =   "中止"
      Height          =   375
      Left            =   1620
      TabIndex        =   1
      Top             =   660
      Width           =   1155
   End
   Begin VB.Label lblStatus 
      Alignment       =   2  '中央揃え
      Caption         =   "漢字漢字漢字漢字漢字漢字漢字漢字漢字漢字漢字漢字漢字漢字漢字漢字漢字漢字漢字漢字漢字漢字"
      Height          =   375
      Left            =   180
      TabIndex        =   0
      Top             =   120
      Width           =   4035
   End
End
Attribute VB_Name = "frmBarPri"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'Const UsePort = "DRV"           'DRV or COM
Const UserPrinterNo = 0         '０＝B374
Const FldCnt = 13               '1レコードのフィールド数(最大)

Dim UsePort As String           'ポート DRV or COM
Dim strDataFilePath As Variant  'データファイルパス
Dim strLfmFileName As Variant   'フォームレイアウトファイル(*.FLM)
Dim strDatFileName As Variant   'データファイル(*.DAT)
Dim valPrinterNo As Variant     '0:374,1:474,2:874,3:433gs,4:433ts,5:458,6:484,7:848
Dim intFldCnt As Integer        'データフィールドのカウント
Dim strDATA As String           'TANACARD.DAT  PRICCARD.DAT  PRICSEAL.DAT

Dim strPortSetting As String    '通信ポートのパラメータ
Dim strPrtStatus As String      'プリンタステータス文字列
Dim lngResult As Long           'ステータス情報
Dim bStatus As Integer          'ステータス受信フラグ
Dim bStop As Boolean            '中断フラグ
Dim intTotalCnt As Integer      '発行枚数
Dim intIssueCnt As Integer      '送信済みレコード数


Private Sub Form_Load()
'パラメータ：フォームレイアウトファイル、データファイル（フルパス）,データフィールドのカウント
    
    Dim CmdLine As String
    Dim LFMFile As Variant
    Dim DATFile As Variant
    
    Dim FirstPara As Integer
    Dim SecondPara As Integer
    Dim ThirdPara As Integer
    
    CmdLine = Command
'   ↓デバッグ用
'    CmdLine = "/I:\tamayura\aspac\BarCDPRT\TANACARD.LFM /I:\tamayura\aspac\Data\PriceCard\TANACARD.DAT /COM"
    FirstPara = InStr(1, CmdLine, "/")
    SecondPara = InStr(FirstPara + 1, CmdLine, "/")
    ThirdPara = InStr(SecondPara + 1, CmdLine, "/")
    If InStr(CmdLine, "TANACARD") > 0 Then strDATA = "TANACARD.DAT"
    If InStr(CmdLine, "PRICCARD") > 0 Then strDATA = "PRICCARD.DAT"
    If InStr(CmdLine, "PRICSEAL") > 0 Then strDATA = "PRICSEAL.DAT"
    
    LFMFile = Trim(Mid(CmdLine, FirstPara + 1, SecondPara - 2))
    DATFile = Trim(Mid(CmdLine, SecondPara + 1, ThirdPara - SecondPara - 2))
    UsePort = Mid(CmdLine, ThirdPara + 1, Len(Trim(CmdLine)) - ThirdPara + 1)
    
    If strDATA = "TANACARD.DAT" Then          '####################################
        intFldCnt = 13 '棚カード                データフォーマットを変更した場合は
    Else               '                       ←データ項目数を変更して下さい
        intFldCnt = 13 'プライスカード／シール  '####################################
    End If

    '通信パラメータの設定
    If UsePort = "DRV" Then
        strPortSetting = "DRV:TEC B-374"    'プリンタドライバ
    ElseIf UsePort = "COM" Then
        strPortSetting = "COM1:9600,E,8,1"  'COMポート
    End If
    
    '初期化
    bStatus = False
    bStop = False
    
    strLfmFileName = LFMFile
    strDatFileName = DATFile
    valPrinterNo = UserPrinterNo

End Sub

Private Sub Form_Activate()

    On Error Resume Next
    
    Dim bRet As Boolean
    
    '初期化
    BcpCtrl.PortSetting = strPortSetting            'PortSettingプロパティ
    BcpCtrl.UsePrinter = UserPrinterNo              'UsePrinterプロパティ
    
    '発行処理
    bRet = Issue
    
    '後処理
    Close #1                        'ファイルのクローズ
    BcpCtrl.ClosePort lngResult     'ポートのクローズ
    
    Hide
'    DoEvents
    
    If bRet = True Then
        MsgBox "印刷が完了しました。", vbOKOnly + vbInformation, "メッセージ"
    End If
    
    Unload Me

End Sub

'発行処理
Private Function Issue() As Boolean
        
    On Error Resume Next
    
    Dim strLfmFilePath As String    'ラベルフォーマットファイル名（フルパス）
    Dim strDatFilePath As String    'データファイル名（フルパス）
    Dim Rd(FldCnt) As String        '1レコードのデータ格納用配列
    Dim intIssueMode As Integer     'OpenPortの発行モード
    
    '初期化
    intIssueCnt = 0
    intTotalCnt = 0
    lblStatus = "発行準備中．．．"
    DoEvents
    
    'ラベルフォーマット情報の取得
    strLfmFilePath = strLfmFileName
    If BcpCtrl.LoadLfmFile(strLfmFilePath, lngResult) = False Then
        'ラベルフォーマット情報の取得に失敗
        If StatusCheck() = False Then
            '継続不可
            Issue = False
            Exit Function
        End If
    End If
    
    'データファイルのオープン
    strDatFilePath = strDatFileName
    Open strDatFilePath For Input As #1
    If Err.Number <> 0 Then
        'データファイルのオープンに失敗
        MsgBox "データファイルのオープンに失敗しました。発行を中止します。", vbOKOnly + vbExclamation, "メッセージ"
        Issue = False
        Exit Function
    End If
    
    'ポートのオープン（発行完了復帰）
    If UsePort = "DRV" Then
        intIssueMode = 1        '送信完了復帰モード
    ElseIf UsePort = "COM" Then
        intIssueMode = 2        '発行完了復帰モード
    End If
        
    If BcpCtrl.OpenPort(intIssueMode, lngResult) = False Then
        'ポートのオープンに失敗
        If StatusCheck() = False Then
            '継続不可
            Issue = False
            Exit Function
        End If
    End If
    
    lblStatus = "1レコード目を発行中．．．"
    DoEvents
    
    Dim i As Integer        'フィールドカウント用
    Dim bFlag As Boolean    'ステータス受信フラグのバックアップ用
    
    Do Until EOF(1)
        
        '1レコードの読み込み
        For i = 1 To intFldCnt
            Input #1, Rd(i)
        Next
        If Err.Number <> 0 Then
            'データファイルの読み込みに失敗
            MsgBox "ERR:" & Str(Err.Number) & " データファイルの読み込みに失敗しました。発行を中止します。", vbOKOnly + vbExclamation, "メッセージ"
            Issue = False
            Exit Function
        End If
        
        '印字データの設定
        '#############################################################
        'ラベルのレイアウトを変更した場合は以下の部分を修正して下さい
        Select Case strDATA
            Case "TANACARD.DAT" '棚番カード
                BcpCtrl.SetObjectData 2, Rd(2), lngResult   '倉庫ｺｰﾄﾞ
                BcpCtrl.SetObjectData 4, Rd(3), lngResult   '倉庫
                BcpCtrl.SetObjectData 6, Rd(4), lngResult   'フロア
                BcpCtrl.SetObjectData 9, Rd(5), lngResult   '列
                BcpCtrl.SetObjectData 10, Rd(6), lngResult  '列名
                BcpCtrl.SetObjectData 12, Rd(7), lngResult  '棚番
                BcpCtrl.SetObjectData 14, Rd(8), lngResult  'ｎ番1
                BcpCtrl.SetObjectData 16, Rd(9), lngResult  'ｎ番2
                BcpCtrl.SetObjectData 17, Rd(10), lngResult 'ｎ段
                BcpCtrl.SetObjectData 20, Rd(13), lngResult 'ロケーションＮｏ(ﾊｲﾌﾝ)
                BcpCtrl.SetObjectData 21, Rd(11), lngResult 'ロケーションＮｏ(ﾊﾞｰｺｰﾄﾞ)
                BcpCtrl.SetObjectData 22, Rd(12), lngResult 'ロケーションＮｏ(数値表示)
                BcpCtrl.SetObjectData 23, Rd(7), lngResult  '棚番(下)
                BcpCtrl.SetObjectData 25, Rd(8), lngResult  'ｎ番1(下)
                BcpCtrl.SetObjectData 27, Rd(9), lngResult  'ｎ番2(下)
                BcpCtrl.SetObjectData 28, Rd(10), lngResult 'ｎ段(下)
            Case "PRICCARD.DAT" 'プライスカード
                BcpCtrl.SetObjectData 1, Rd(4), lngResult   'メーカ名
                BcpCtrl.SetObjectData 2, Rd(7), lngResult   '色名
                BcpCtrl.SetObjectData 3, Rd(8), lngResult   'サイズ名
                BcpCtrl.SetObjectData 5, Rd(5), lngResult   '品名
                BcpCtrl.SetObjectData 8, Rd(12), lngResult  '発注ﾛｯﾄ
                BcpCtrl.SetObjectData 9, Rd(9), lngResult   '品番
                BcpCtrl.SetObjectData 10, Rd(10), lngResult 'ＪＡＮｺｰﾄﾞ(ﾊﾞｰｺｰﾄﾞ)
                BcpCtrl.SetObjectData 11, Rd(13), lngResult 'ＪＡＮｺｰﾄﾞ(数値表示)
                BcpCtrl.SetObjectData 12, Rd(11), lngResult '商品単価
            Case "PRICSEAL.DAT" 'プライスシール
                BcpCtrl.SetObjectData 2, Rd(8), lngResult   'サイズ名
                BcpCtrl.SetObjectData 4, Rd(7), lngResult   '色名
                BcpCtrl.SetObjectData 5, Rd(9), lngResult   '品番
                BcpCtrl.SetObjectData 6, Rd(6), lngResult   '商品名(POS用名称)
                BcpCtrl.SetObjectData 7, Rd(11), lngResult  '商品単価
                BcpCtrl.SetObjectData 8, Rd(10), lngResult  'JANｺｰﾄﾞ(ﾊﾞｰｺｰﾄﾞ)
                BcpCtrl.SetObjectData 9, Rd(13), lngResult  'JANｺｰﾄﾞ(数値表示)
                BcpCtrl.SetObjectData 10, Rd(4), lngResult  'メーカ名　　　2002.07.25 追加
        End Select
        '#############################################################
        
        '送信
        If BcpCtrl.Issue(1, 0, strPrtStatus, lngResult) = False Then
            If StatusCheck() = False Then
                '復帰不可
                Issue = False
                Exit Function
            End If
        End If
        
        '発行枚数のカウントアップ
        intTotalCnt = intTotalCnt + 1
        
        intIssueCnt = intIssueCnt + 1
        lblStatus = intIssueCnt & "レコード目を発行中．．．"
        
        DoEvents
        
        '中断フラグチェック
        If bStop = True Then
            Issue = False
            Exit Function
        End If
        
        'ステータスチェック  COMﾎﾟｰﾄ
        If UsePort = "COM" Then
            bFlag = bStatus
            bStatus = False
            If bFlag = True Then
                If StatusCheck() = False Then
                    '復帰不可
                    Issue = False
                    Exit Function
                End If
            End If
        End If
        
    Loop
    
'COMで送信完了復帰にした場合の処理
    If UsePort = "COM" And intIssueMode = 1 Then
    '発行完了待ち
    Do While intIssueCnt < intTotalCnt
        DoEvents

        '中断フラグチェック
        If bStop = True Then
            Issue = False
            Exit Function
        End If

        'ステータスチェック
        bFlag = bStatus
        bStatus = False
        If bFlag = True Then
            If StatusCheck() = False Then
                '復帰不可
                Issue = False
                Exit Function
            End If
        End If
    Loop
    End If
   
    Issue = True

End Function

'中止ボタン
'スプーラ－にコマンドを送信する作業を中止します。
'スプールされたコマンドについては中止されません。
Private Sub cmdStop_Click()

    If MsgBox("発行を中止します。よろしいですか？", vbYesNo + vbQuestion, "メッセージ") = vbYes Then
        bStop = True
    End If
    
End Sub

'ステータスチェック
Private Function StatusCheck() As Boolean

    Dim bContinue As Boolean    'True:継続可能、Flase:継続不可
    Dim strMsg As String        'メッセージ
    Dim strStatus As String     'プリンタ詳細ステータス

    bContinue = False
    
    Select Case lngResult
    Case &H800A044E
        'プリンタからステータスを受信
        'ドライバの場合はプリンタからのステータスは受信できません。
        'ここではプリンタからのステータスについては継続可能としていますが、
        '一部エラーについては継続不可です。
        bContinue = True
        
        strStatus = Left(strPrtStatus, 2)
        Select Case strStatus
        Case "40"
            '印刷完了
            StatusCheck = True
            Exit Function
        Case "41"
            'フィード完了
            StatusCheck = True
            Exit Function
        Case "00"
            'オンライン
            StatusCheck = True
            Exit Function
        Case "02"
            '動作中
            StatusCheck = True
            Exit Function
        Case Else
            strMsg = "プリンタに異常が発生しました。 (" & strPrtStatus & ")" & vbCrLf & "プリンタのエラーを解除してください。"
        End Select
    Case &H800A03E8
        strMsg = "ポートのオープンに失敗しました。"
    Case &H800A03E9
        strMsg = "ポートがオープンされていません。"
    Case &H800A03EA
        strMsg = "ポートが既にオープンされています。"
    Case &H800A03EB
        strMsg = "ポートへの書き込みに失敗しました。"
    Case &H800A044D
        strMsg = "通信エラーが発生しました。"
    Case &H800A04B0
        strMsg = "プリンタリストファイルの読み込みに失敗しました。"
    Case &H800A04B1
        strMsg = "プリンタ情報ファイルの読み込みに失敗しました。"
    Case &H800A0514
        strMsg = "ラベルフォーマットファイルの読み込みに失敗しました。"
    Case &H800A0515
        strMsg = "UsePrinterプロパティで指定されたプリンタのラベルフォーマットファイルではありません。"
    Case &H800A0516
        strMsg = "印刷レイアウトに誤りがあります。"
    Case &H800A0517
        strMsg = "指定されたフィールドが存在しません。"
    Case &H800A0518
        strMsg = "ラベルフォーマット情報が取得されていません。"
    Case &H800A07D0
        strMsg = "サポートされていません。"
    Case &H800A0834
        strMsg = "第一引数に不正な値が指定されています。"
    Case &H800A0835
        strMsg = "第二引数に不正な値が指定されています。"
    Case &H800A0BBC
        strMsg = "PortSettingプロパティの値が不正です。"
    Case &H800A0BC3
        strMsg = "SystemPathプロパティの値が不正です。"
    Case &H800A0BC4
        strMsg = "UsePrinterプロパティの値が不正です。"
    Case Else
        strMsg = "未定義エラーが発生しました。 (Result = " & Hex(lngResult) & ")"
    End Select
    
    'メッセージ表示
    If bContinue = True Then
        lblStatus = strMsg
    Else
        Hide
        MsgBox strMsg & "発行を中止します。", vbOKOnly + vbExclamation, "メッセージ"
    End If
    
    StatusCheck = bContinue
    
End Function

'OnStatusイベント
Private Sub BcpCtrl_OnStatus(ByVal PrinterStatus As String, ByVal Result As Long)

    bStatus = True
    lngResult = Result
    
    '受信ステータス情報の判定
    Select Case lngResult
    Case &H800A044E
        strPrtStatus = PrinterStatus
        'プリンタからステータスを受信した場合
        Select Case Left(strPrtStatus, 2)
        Case "40"
            'ラベル発行が正常に終了した場合
            intIssueCnt = intIssueCnt + 1
            lblStatus = intIssueCnt + 1 & "レコード目を発行中．．．"
        Case "41"
            'フィードが正常に終了した場合
        Case Else
            'その他の場合
        End Select
    Case &H800A044D
        'ケーブル切断、電源断などにより通信エラーが発生した場合
    Case Else
        'ポートへの書き込みに失敗した場合
    End Select
    
End Sub

'//////////////////////////////////////////////////////////////////////////////
'この先は技術情報となります。
'この情報に関する一切の責任は負いかねます。

'///１．初期化コマンドの送信について/////////////////////////////////////////////
'BcpCtrlではバッファフル時にコマンドの送信ができません。
'そこで”Microsoft Comm Contrl”（以下MsComm）を利用して、バッファフル時にプリンタ
'に初期化コマンドを送信する方法を紹介します。
'
'①事前にBcpCtrlでオープンしているポートをクローズします。
'
'②MsCommのプロパティを以下のように設定します。
'   MsComm.Handshaking = comNone    'ハンドシェイクなし
'   MsComm.RTSEnable = True         'Request To Send ラインを有効する
'   （その他のプロパティについてはMSDNライブラリをご覧ください）
'
'③MsCommのポートをオープンします。
'
'④MsCommのOutPutプロパティをプリンタのコマンド制御方式に従って以下のように設定します。
'   'ESC、LF、NULL方式の場合
'   MsComm.Output = Chr(10) & Chr(0) & Chr(27) & "WR" & Chr(10) & Chr(0)
'   '{、|、}方式の場合
'   MsComm.Output = "|}{WR|}"
'
'⑤プリンタの初期化が完了するまで待機します。
'   （プリンタの初期化にかかる時間はリファレンスマニュアルを参照してください）
'
'⑥MsCommのポートをクローズします。
'
'//////////////////////////////////////////////////////////////////////////////

