module2.bas

该系统为空车计量系统.完成对空车的自动计量.附串口处理程序.

Attribute VB_Name = "Module1"
Option Explicit
'CODE Manger By BcodeXRose
Public Declare Function mciExecute Lib "winmm.dll" (ByVal lpstrCommand As String) As Long

Public Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long

'Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public LoginSucceeded As Boolean
Public jl_qym, jl_hth, jl_hwm, jl_qyr, jl_shdw, jl_ch, jl_fhr, jl_shr, jl_sby, jl_jby, jl_zg, jl_sj, jl_dhdd As String
Public jl_bz As Variant
Public jl_mz, jl_pz, jl_pz1, jl_jz, jl_htl, jl_yfsl, jl_wfsl As Long
Public jl_dj, jl_je As Long
Public jl_lsh As Double
Public pr_p, jl_ye, mou As Boolean
Public Const NOTSRCCOPY = &H330008
Public Const NOTSRCERASE = &H1100A6
Public Const SRCAND = &H8800C6
Public Const SRCCOPY = &HCC0020
Public Const SRCERASE = &H440328
Public Const SRCINVERT = &H660046
Public Const SRCPAINT = &HEE0086
'Public Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
'Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Public jl_dwm As String
Public strBarCode

Sub PrintBarCode(ByVal pobject As Object, ByVal strBarCode As String, Optional ByVal intXPos As Integer = 0, Optional ByVal intYPos As Integer = 0, Optional ByVal intPrintHeight As Integer = 10, Optional ByVal bolPrintText As Boolean = True)
       ' On Error Resume Next
    ' 参数说明:
    
    ' strBarCode　　　　- 要打印的条形码字符串
    
    ' intXPos, intYPos - 打印条形码的左上角坐标(缺省为(0,0)，坐标刻度为:毫米)
    
    ' intHeight　　　　 - 打印高度(缺省为一厘米,坐标刻度为:毫米)
    
    ' bolPrintText　　 - 是否打印人工识别字符(缺省为true)
    
        
    ' "0"-"9","A-Z","-","%","$"和"*" 的条码编码格式,总共 40 个字符
    
    Static strBarTable(39) As String
    
    ' 初始化条码编码格式表
    
    strBarTable(0) = "001100100"     ' 0
    
    strBarTable(1) = "100010100"     ' 1
    
    strBarTable(2) = "010010100"     ' 2
    
    strBarTable(3) = "110000100"     ' 3
    
    strBarTable(4) = "001010100"     ' 4
    
    strBarTable(5) = "101000100"     ' 5
    
    strBarTable(6) = "011000100"     ' 6
    
    strBarTable(7) = "000110100"     ' 7
    
    strBarTable(8) = "100100100"     ' 8
    
    strBarTable(9) = "010100100"     ' 9
    
    strBarTable(10) = "100010010"    ' A
    
    strBarTable(11) = "010010010"    ' B
    
    strBarTable(12) = "110000010"    ' C
    
    strBarTable(13) = "001010010"    ' D
    
    strBarTable(14) = "101000010"    ' E
    
    strBarTable(15) = "011000010"    ' F
    
    strBarTable(16) = "000110010"    ' G
    
    strBarTable(17) = "100100010"    ' H
    
    strBarTable(18) = "010100010"    ' I
    
    strBarTable(19) = "001100010"    ' J
    
    strBarTable(20) = "100010001"    ' K
    
    strBarTable(21) = "010010001"    ' L
    
    strBarTable(22) = "110000001"    ' M
    
    strBarTable(23) = "001010001"    ' N
    
    strBarTable(24) = "101000001"    ' O
    
    strBarTable(25) = "011000001"    ' P
    
    strBarTable(26) = "000110001"    ' Q
    
    strBarTable(27) = "100100001"    ' R
    
    strBarTable(28) = "010100001"    ' S
    
    strBarTable(29) = "001100001"    ' T
    
    strBarTable(30) = "100011000"    ' U
    
    strBarTable(31) = "010011000"    ' V
    
    strBarTable(32) = "110001000"    ' W
    
    strBarTable(33) = "001011000"    ' X
    
    strBarTable(34) = "101001000"    ' Y
    
    strBarTable(35) = "011001000"    ' Z
    
    strBarTable(36) = "000111000"    ' -
    
    strBarTable(37) = "100101000"    ' %
    
    strBarTable(38) = "010101000"    ' $
    
    strBarTable(39) = "001101000"    ' *
    
    
    
    If strBarCode = "" Then Exit Sub ' 不打印空串
    
    
    
    ' 保存打印机 ScaleMode
    
    Dim intOldScaleMode As ScaleModeConstants
    
    intOldScaleMode = test.ScaleMode
    
    ' 保存打印机 DrawWidth
    
    Dim intOldDrawWidth As Integer
    
    intOldDrawWidth = test.DrawWidth
    
    ' 保存打印机 Font
    
    Dim fntOldFont As StdFont
    
    Set fntOldFont = test.Font
    
    
    
    pobject.ScaleMode = vbTwips ' 设置打印用的坐标刻度为缇(twip=1)
    
    pobject.DrawWidth = 1     ' 线宽为 1
    
    pobject.FontName = "宋体" ' 打印在条码下方字符的字体和大小
    
    pobject.FontSize = 8
    
    
    
    Dim strBC As String         ' 要打印的条码字符串
    
    strBC = UCase(strBarCode)
    
    ' 将以毫米表示的 X 坐标转换为以缇表示
    
    Dim X As Integer
    
    X = pobject.ScaleX(intXPos, vbMillimeters, vbTwips)
    
    ' 将以毫米表示的 Y 坐标转换为以缇表示
    
    Dim Y As Integer
    
    Y = pobject.ScaleY(intYPos, vbMillimeters, vbTwips)
    
    ' 将以毫米表示的高度转换为以缇表示
    
    Dim intHeight As Integer
    
    intHeight = pobject.ScaleY(intPrintHeight, vbMillimeters, vbTwips)
    
    
    
    
    ' 是否在条形码下方打印人工识别字符
    
    If bolPrintText = True Then
        
        ' 条码打印高度要减去下面的字符显示高度
        
        intHeight = intHeight - pobject.TextHeight(strBC)
        
    End If
    
    
    
    Const intWidthCU As Integer = 30 ' 粗线和宽间隙宽度
    
    Const intWidthXI As Integer = 10 ' 细线和窄间隙宽度
    
    Dim intIndex As Integer            ' 当前处理的字符串索引
    
    Dim i As Integer, j As Integer, k As Integer    ' 循环控制变量
    
    
    
    ' 添加起始字符
    
    If Left(strBC, 1) <> "*" Then
        
        strBC = "*" & strBC
        
    End If
    
    ' 添加结束字符
    
    If Right(strBC, 1) <> "*" Then
        
        strBC = strBC & "*"
        
    End If
    
    
    
    ' 循环处理每个要显示的条码字符
    
    For i = 1 To Len(strBC)
        
        ' 确定当前字符在 strBarTable 中的索引
        
        Select Case Mid(strBC, i, 1)
                
            Case "*"
                
                intIndex = 39
                
            Case "$"
                
                intIndex = 38
                
            Case "%"
                
                intIndex = 37
                
            Case "-"
                
                intIndex = 36
                
            Case "0" To "9"
                
                intIndex = CInt(Mid(strBC, i, 1))
                
            Case "A" To "Z"
                
                intIndex = Asc(Mid(strBC, i, 1)) - Asc("A") + 10
                
            Case Else
                
                MsgBox "要打印的条形码字符串中包含无效字符！当前版本只支持字符 "
                '0'-'9','A'-'Z','-','%','$'和'*'"
                
        End Select
        
        
        
        ' 是否在条形码下方打印人工识别字符
        
        If bolPrintText = True Then
            
            pobject.CurrentX = X
            
            pobject.CurrentY = Y + intHeight
            
            pobject.Print Mid(strBC, i, 1)
            
        End If
        
        
        
        For j = 1 To 5
            
            ' 画细线
            
            If Mid(strBarTable(intIndex), j, 1) = "0" Then
                
                For k = 0 To intWidthXI - 1
                    
                    pobject.Line (X + k, Y)-Step(0, intHeight)
                    
                Next k
                
                X = X + intWidthXI
                
                ' 画宽线
                
            Else
                
                For k = 0 To intWidthCU - 1
                    
                    pobject.Line (X + k, Y)-Step(0, intHeight)
                    
                Next k
                
                X = X + intWidthCU
                
            End If
            
            
            
            ' 每个字符条码之间为窄间隙
            
            If j = 5 Then
                
                X = X + intWidthXI * 3
                
                Exit For
                
            End If
            
            ' 窄间隙
            
            If Mid(strBarTable(intIndex), j + 5, 1) = "0" Then
                
                X = X + intWidthXI * 3
                
                ' 宽间隙
                
            Else
                
                X = X + intWidthCU * 2
                
            End If
            
        Next j
        
    Next i
    
    'Printer.EndDoc
    
    ' 恢复打印机 ScaleMode
    
    pobject.ScaleMode = intOldScaleMode
    
    ' 恢复打印机 DrawWidth
    
    pobject.DrawWidth = intOldDrawWidth
    
    ' 恢复打印机 Font
    
    Set pobject.Font = fntOldFont
    
End Sub