BarCode 算法 VB类库 1

 Option Explicit

' VB / VBA Functions for Code128(A, B,C), UCC/EAN 128
' Copyright 2004 by MW6 Technologies Inc. All rights reserved.
'
' This code may not be modified or distributed unless you purchase
' the license from MW6.
Public UFPrefixFunctions As Boolean

Private I As Integer
Private StrLen As Integer
Private Sum As Integer
Private CurrSet As Integer
Private CurrChar As Integer
Private NextChar As Integer
Private Message As String
Private Weight  As Integer

Public Function Code128Auto(ByVal Src As String) As String
    StrLen = Len(Src)
    Sum = 104
   
    ' 2 indicates Set B
    CurrSet = 2
   
    ' start character with value 202 for Set B
    Message = "" & Chr(202)
   
    CurrChar = Asc(Mid(Src, 1, 1))
    If (CurrChar <= 31 And CurrChar >= 0) Then
        ' switch to Set A
        ' 1 indicates Set A
        CurrSet = 1
       
        ' start character with value 201 for Set A
        Message = "" & Chr(201)
        Sum = 103
    End If
   
    Weight = 1
    Call GeneralEncode(Src)
   
    Code128Auto = Message
End Function

Public Function UCCEAN128(ByVal Src As String) As String
    StrLen = Len(Src)
    Sum = 105
   
    ' 3 indicates Set C
    CurrSet = 3
   
    ' start character (203) + FNC1 (200)
    Message = Chr(203) & Chr(200)
    Sum = Sum + 102
    Weight = 2
    Call GeneralEncode(Src)
   
    UCCEAN128 = Message
End Function
       
Public Sub GeneralEncode(ByVal Src As String)
    Dim tmp As Integer
    Dim CurrDone As Boolean
   
    I = 1
    While (I <= StrLen)
        CurrChar = Asc(Mid(Src, I, 1))
        CurrDone = False
        If ((I + 1) <= StrLen) Then
            NextChar = Asc(Mid(Src, I + 1, 1))
           
            If (CurrChar >= Asc("0") And CurrChar <= Asc("9") And _
                NextChar >= Asc("0") And NextChar <= Asc("9")) Then
                tmp = (CurrChar - Asc("0")) * 10 + (NextChar - Asc("0"))
               
                ' 2 digits
                If (CurrSet <> 3) Then
                    ' the previous set is not Set C
                    Message = Message & Chr(99 + 98)
                    Sum = Sum + Weight * 99
                    Weight = Weight + 1
                    CurrSet = 3
                End If
               
                If (tmp = 0) Then
                    Message = Message & Chr(192)
                ElseIf (tmp > 0 And tmp < 95) Then
                    Message = Message & Chr(tmp + 32)
                Else
                    Message = Message & Chr(tmp + 98)
                End If
                   
                Sum = Sum + Weight * tmp
                I = I + 2
               
                CurrDone = True
            End If
        End If
       
        If (Not CurrDone) Then
            If (CurrChar >= 0 And CurrChar <= 31) Then
                ' choose Set A
                If (CurrSet <> 1) Then
                    ' the previous set is not Set A
                    Message = Message & Chr(101 + 98)
                    Sum = Sum + Weight * 101
                    Weight = Weight + 1
                    CurrSet = 1
                End If
               
                If (CurrChar = 31) Then
                    Message = Message & Chr(193)
                    Sum = Sum + Weight * 95
                Else
                    Message = Message & Chr(CurrChar + 96)
                    Sum = Sum + Weight * (CurrChar + 64)
                End If
            Else
                ' choose Set B
                If (CurrSet <> 2) Then
                    ' the previous set is not Set B
                    Message = Message & Chr(100 + 98)
                    Sum = Sum + Weight * 100
                    Weight = Weight + 1
                    CurrSet = 2
                End If
               
                If (CurrChar = 32) Then
                    Message = Message & Chr(192)
                ElseIf (CurrChar = 127) Then
                    Message = Message & Chr(193)
                    Sum = Sum + Weight * 95
                ElseIf (CurrChar < 127 And CurrChar > 32) Then
                    Message = Message & Chr(CurrChar)
                    Sum = Sum + Weight * (CurrChar - 32)
                End If
            End If
           
            I = I + 1
        End If
       
        Weight = Weight + 1
    Wend
   
    ' add CheckDigit
    Sum = Sum Mod 103
    If (Sum = 0) Then
        Message = Message & Chr(192)
    ElseIf (Sum <= 94) Then
        Message = Message & Chr(Sum + 32)
    Else
        Message = Message & Chr(Sum + 98)
    End If
   
    ' add stop character (204)
    Message = Message & Chr(204)
End Sub

Public Function Code128A(ByVal Src As String) As String
    StrLen = Len(Src)
    Sum = 103
   
    ' start character (201) for Set A
    Message = "" & Chr(201)
   
    Weight = 1
    For I = 1 To StrLen
        CurrChar = Asc(Mid(Src, I, 1))
        If (CurrChar = 32) Then
            Message = Message & Chr(192)
        ElseIf (CurrChar = 31) Then
            Message = Message & Chr(193)
            Sum = Sum + Weight * 95
        ElseIf (CurrChar <= 95 And CurrChar > 32) Then
            Message = Message & Chr(CurrChar)
            Sum = Sum + Weight * (CurrChar - 32)
        ElseIf (CurrChar >= 0 And CurrChar <= 31) Then
            Message = Message & Chr(CurrChar + 96)
            Sum = Sum + Weight * (CurrChar + 64)
        Else
            Message = Code128Auto(Src)
            Code128A = Message
            Exit Function
        End If
        Weight = Weight + 1
    Next I
   
    ' add CheckDigit
    Sum = Sum Mod 103
    If (Sum = 0) Then
        Message = Message & Chr(192)
    ElseIf (Sum <= 94) Then
        Message = Message & Chr(Sum + 32)
    Else
        Message = Message & Chr(Sum + 98)
    End If
   
    ' add stop character (204)
    Message = Message & Chr(204)
   
    Code128A = Message
End Function

Public Function Code128B(ByVal Src As String) As String
    StrLen = Len(Src)
    Sum = 104
   
    ' start character (202) for Set B
    Message = "" & Chr(202)
   
    Weight = 1
    For I = 1 To StrLen
        CurrChar = Asc(Mid(Src, I, 1))
        If (CurrChar = 32) Then
            Message = Message & Chr(192)
        ElseIf (CurrChar = 127) Then
            Message = Message & Chr(193)
            Sum = Sum + Weight * 95
        ElseIf (CurrChar < 127 And CurrChar > 32) Then
            Message = Message & Chr(CurrChar)
            Sum = Sum + Weight * (CurrChar - 32)
        Else
            Message = Code128Auto(Src)
            Code128B = Message
            Exit Function
        End If
       
        Weight = Weight + 1
    Next I
   
    ' add CheckDigit
    Sum = Sum Mod 103
    If (Sum = 0) Then
        Message = Message & Chr(192)
    ElseIf (Sum <= 94) Then
        Message = Message & Chr(Sum + 32)
    Else
        Message = Message & Chr(Sum + 98)
    End If
   
    ' add stop character (204)
    Message = Message & Chr(204)
   
    Code128B = Message
End Function

Public Function Code128C(ByVal Src As String) As String
    Dim tmp As Integer
   
    StrLen = Len(Src)
    Sum = 105
   
    ' start character (203) for Set C
    Message = "" & Chr(203)
   
    Weight = 1
    I = 1
    While (I <= StrLen)
        CurrChar = Asc(Mid(Src, I, 1))
        If ((I + 1) <= StrLen) Then
            NextChar = Asc(Mid(Src, I + 1, 1))
           
            If (CurrChar >= Asc("0") And CurrChar <= Asc("9") And _
                NextChar >= Asc("0") And NextChar <= Asc("9")) Then
                '2 digits
                tmp = (CurrChar - Asc("0")) * 10 + (NextChar - Asc("0"))
               
                If (tmp = 0) Then
                    Message = Message & Chr(192)
                ElseIf (tmp > 0 And tmp < 95) Then
                    Message = Message & Chr(tmp + 32)
                Else
                    Message = Message & Chr(tmp + 98)
                End If
                   
                Sum = Sum + Weight * tmp
                I = I + 2
            Else
                Message = Code128Auto(Src)
                Code128C = Message
                Exit Function
            End If
        Else
            Message = Message & Chr(198)
            Sum = Sum + Weight * 100
            Weight = Weight + 1
           
            If (CurrChar = 32) Then
                Message = Message & Chr(192)
            ElseIf (CurrChar = 127) Then
                Message = Message & Chr(193)
                Sum = Sum + Weight * 95
            ElseIf (CurrChar < 127 And CurrChar > 32) Then
                Message = Message & Chr(CurrChar)
                Sum = Sum + Weight * (CurrChar - 32)
            Else
                Message = Code128Auto(Src)
                Code128C = Message
                Exit Function
            End If
            I = I + 1
        End If
       
        Weight = Weight + 1
    Wend
   
    ' add CheckDigit
    Sum = Sum Mod 103
    If (Sum = 0) Then
        Message = Message & Chr(192)
    ElseIf (Sum <= 94) Then
        Message = Message & Chr(Sum + 32)
    Else
        Message = Message & Chr(Sum + 98)
    End If
   
    ' add stop character (204)
    Message = Message & Chr(204)
   
    Code128C = Message
End Function

Private Sub Class_Initialize()
    UFPrefixFunctions = False
End Sub