BarCode 算法 VB类库 1

发布时间：2020-12-16 23:19:36 所属栏目：大数据来源：网络整理

导读：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 UFPrefix

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,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,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,1))
If ((I + 1) <= StrLen) Then
NextChar = Asc(Mid(Src,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 = FalseEnd Sub

（编辑：李大同）

【声明】本站内容均来自网络，其相关言论仅代表作者个人观点，不代表本站立场。若无意侵犯到您的权利，请及时与联系站长删除相关内容!