Attribute VB_Name = "Code128Utils"
' 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.

Private Const cSpace As Integer = 33, cDEL As Integer = 195, cFNC1 As Integer = 202, _
              cStartA As Integer = 103, cStartB As Integer = 104, cStartC As Integer = 105, _
              cStop As Integer = 106
Private AsciiToUTFArray(145 To 156) As Integer
Private I As Integer, StrLen As Integer, Weight As Integer, Sum As Integer, CurrSet As Integer, CurrChar As Integer, NextChar As Integer
Private Message As String

Public Function AsciiToCode128(ByVal src As String) As String
    AsciiToUTFArray(145) = &H2018
    AsciiToUTFArray(146) = &H2019
    AsciiToUTFArray(147) = &H201C
    AsciiToUTFArray(148) = &H201D
    AsciiToUTFArray(149) = &H2022
    AsciiToUTFArray(150) = &H2013
    AsciiToUTFArray(151) = &H2014
    AsciiToUTFArray(152) = &H2DC
    AsciiToUTFArray(153) = &H2122
    AsciiToUTFArray(154) = &H161
    AsciiToUTFArray(155) = &H203A
    AsciiToUTFArray(156) = &H153
    Message = ""
    StrLen = Len(src)
    Sum = 0
    For I = 1 To StrLen
        CurrChar = AscW(Mid(src, I, 1))
'        If CurrChar = &H20AC Or CurrChar = 128 Then
        If CurrChar = 32 Then
            CurrChar = 0
        ElseIf CurrChar >= 33 And CurrChar <= 126 Then
            CurrChar = CurrChar - 32
        ElseIf CurrChar > 126 Then
            CurrChar = CurrChar - 50
        End If
        Message = Message + ChrW(CurrChar)
        Sum = Sum + (CurrChar * I)
    Next I
    AsciiToCode128 = Message
End Function

Public Function Code128ToAscii(ByVal src As String) As String
    Message = ""
    StrLen = Len(src)
    For I = 1 To StrLen
        CurrChar = AscW(Mid(src, I, 1))
        If CurrChar = 0 Then
            CurrChar = &H20AC
'            CurrChar = 128
        ElseIf CurrChar >= 1 And CurrChar <= 94 Then
            CurrChar = CurrChar + 32
        ElseIf CurrChar > 94 Then
            CurrChar = AsciiToUTFArray(CurrChar + 50)
        End If
        Message = Message + ChrW(CurrChar)
    Next I
    Code128ToAscii = Message
End Function

Public Function Code128A(ByVal src As String) As String
    Message = AsciiToCode128(src)
    Sum = (Sum + cStartA) Mod 103
    Message = ChrW(cStartA) + Message + ChrW(Sum) + ChrW(cStop)
    Code128A = Code128ToAscii(Message)
End Function

Public Function Code128B(ByVal src As String) As String
    Message = AsciiToCode128(src)
    Sum = (Sum + cStartB) Mod 103
    Message = ChrW(cStartB) + Message + ChrW(Sum) + ChrW(cStop)
    Code128B = Code128ToAscii(Message)
End Function

Public Function Code128C(ByVal src As String) As String
    Message = AsciiToCode128(src)
    Sum = (Sum + cStartC) Mod 103
    Message = ChrW(cStartC) + Message + ChrW(Sum) + ChrW(cStop)
    Code128C = Code128ToAscii(Message)
End Function

Public Function Code128Auto(ByVal src As String) As String
    StrLen = Len(src)
    Sum = 104
    ' 2 indicates Set B
    CurrSet = 2
    Message = "" & ChrW(cStartB)
    CurrChar = Asc(Mid(src, 1, 1))
    If (CurrChar <= 31 And CurrChar >= 0) Then ' switch to Set A
        CurrSet = 1
        Message = "" & ChrW(cStartA)
        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 + FNC1
    Message = ChrW(cStartC) & ChrW(cFNC1)
    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 & ChrW(99 + 98)
                    Sum = Sum + Weight * 99
                    Weight = Weight + 1
                    CurrSet = 3
                End If
                If (tmp = 0) Then
                    Message = Message & ChrW(cSpace)
                ElseIf (tmp > 0 And tmp < 95) Then
                    Message = Message & ChrW(tmp + 32)
                Else
                    Message = Message & ChrW(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 & ChrW(101 + 98)
                    Sum = Sum + Weight * 101
                    Weight = Weight + 1
                    CurrSet = 1
                End If
                If (CurrChar = 31) Then
                    Message = Message & ChrW(cDEL)
                    Sum = Sum + Weight * 95
                Else
                    Message = Message & ChrW(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 & ChrW(100 + 98)
                    Sum = Sum + Weight * 100
                    Weight = Weight + 1
                    CurrSet = 2
                End If
                If (CurrChar = 32) Then
                    Message = Message & ChrW(cSpace)
                ElseIf (CurrChar = 127) Then
                    Message = Message & ChrW(cDEL)
                    Sum = Sum + Weight * 95
                ElseIf (CurrChar < 127 And CurrChar > 32) Then
                    Message = Message & ChrW(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 & ChrW(cSpace)
    ElseIf (Sum <= 94) Then
        Message = Message & ChrW(Sum + 32)
    Else
        Message = Message & ChrW(Sum + 98)
    End If
    Message = Message & ChrW(cStop)
End Sub

Public Function xCode128A(ByVal src As String) As String
    StrLen = Len(src)
    Sum = 103
    Message = "" & ChrW(cStartA)
    Weight = 1
    For I = 1 To StrLen
        CurrChar = Asc(Mid(src, I, 1))
        If (CurrChar = &H20) Then
            Message = Message & ChrW(cSpace)
        ElseIf (CurrChar = &H1F) Then
            Message = Message & ChrW(cDEL)
            Sum = Sum + Weight * &H5F
        ElseIf (CurrChar > &H20 And CurrChar <= &H5F) Then
            Message = Message & ChrW(CurrChar)
            Sum = Sum + Weight * (CurrChar - &H20)
        ElseIf (CurrChar >= 0 And CurrChar <= &H1F) Then
            Message = Message & ChrW(CurrChar + &H60)
            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 & ChrW(cSpace)
    ElseIf (Sum <= 94) Then
        Message = Message & ChrW(Sum + &H20)
    Else
        Message = Message & ChrW(Sum + 98)
    End If
    Code128A = Message & ChrW(cStop)
End Function

Public Function xCode128B(ByVal src As String) As String
    StrLen = Len(src)
    Sum = 104
    Message = "" & ChrW(cStartB)
    Weight = 1
    For I = 1 To StrLen
        CurrChar = Asc(Mid(src, I, 1))
        If (CurrChar = 32) Then
            Message = Message & ChrW(cSpace)
        ElseIf (CurrChar = 127) Then
            Message = Message & ChrW(cDEL)
            Sum = Sum + Weight * 95
        ElseIf (CurrChar < 127 And CurrChar > 32) Then
            Message = Message & ChrW(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 & ChrW(cSpace)
    ElseIf (Sum <= 94) Then
        Message = Message & ChrW(Sum + 32)
    Else
        Message = Message & ChrW(Sum + 98)
    End If
    Message = Message & ChrW(cStop)
    xCode128B = Message
End Function

Public Function xCode128C(ByVal src As String) As String
    Dim tmp As Integer
    
    StrLen = Len(src)
    Sum = 105
    Message = "" & ChrW(cStartC)
    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 & ChrW(cSpace)
                ElseIf (tmp > 0 And tmp < 95) Then
                    Message = Message & ChrW(tmp + 32)
                Else
                    Message = Message & ChrW(tmp + 98)
                End If
                Sum = Sum + Weight * tmp
                I = I + 2
            Else
                Message = Code128Auto(src)
                Code128C = Message
                Exit Function
            End If
        Else
            Message = Message & ChrW(198)
            Sum = Sum + Weight * 100
            Weight = Weight + 1
            
            If (CurrChar = 32) Then
                Message = Message & ChrW(cSpace)
            ElseIf (CurrChar = 127) Then
                Message = Message & ChrW(cDEL)
                Sum = Sum + Weight * 95
            ElseIf (CurrChar < 127 And CurrChar > 32) Then
                Message = Message & ChrW(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 & ChrW(cSpace)
    ElseIf (Sum <= 94) Then
        Message = Message & ChrW(Sum + 32)
    Else
        Message = Message & ChrW(Sum + 98)
    End If
    Message = Message & ChrW(cStop)
    Code128C = Message
End Function