180630
Published: 13th February, 2010
Last edited: 13th February, 2010
Created: 13th February, 2010
More sophisticated font for creation barcodes. Contains space - chr(32) and 63 bar characters from chr(33) to chr(95).
This font make possible to display or print different barcodes - Int2of5, Code39, Code93, Code128 and other in applications like excel, word, crystal report. Visual basic function below display barcode of Code128 type.
Function Code128(s As String) As String
Dim A As Variant
A = Array("11011001100", "11001101100", "11001100110", "10010011000", "10010001100", _
"10001001100", "10011001000", "10011000100", "10001100100", "11001001000", _
"11001000100", "11000100100", "10110011100", "10011011100", "10011001110", _
"10111001100", "10011101100", "10011100110", "11001110010", "11001011100", _
"11001001110", "11011100100", "11001110100", "11101101110", "11101001100", _
"11100101100", "11100100110", "11101100100", "11100110100", "11100110010", _
"11011011000", "11011000110", "11000110110", "10100011000", "10001011000", _
"10001000110", "10110001000", "10001101000", "10001100010", "11010001000", _
"11000101000", "11000100010", "10110111000", "10110001110", "10001101110", _
"10111011000", "10111000110", "10001110110", "11101110110", "11010001110", _
"11000101110", "11011101000", "11011100010", "11011101110", "11101011000", _
"11101000110", "11100010110", "11101101000", "11101100010", "11100011010", _
"11101111010", "11001000010", "11110001010", "10100110000", "10100001100", _
"10010110000", "10010000110", "10000101100", "10000100110", "10110010000", _
"10110000100", "10011010000", "10011000010", "10000110100", "10000110010", _
"11000010010", "11001010000", "11110111010", "11000010100", "10001111010", _
"10100111100", "10010111100", "10010011110", "10111100100", "10011110100", _
"10011110010", "11110100100", "11110010100", "11110010010", "11011011110", _
"11011110110", "11110110110", "10101111000", "10100011110", "10001011110", _
"10111101000", "10111100010", "11110101000", "11110100010", "10111011110", _
"10111101110", "11101011110", "11110101110", "11010000100", "11010010000", _
"11010011100", "1100011101011")
Dim CheckSum As Long
Dim Ct As Integer
Dim Cr As Integer
Dim Tx As String
Dim Tp As String
Dim i As Integer
Tx = ""
If Len(s) > 0 Then
i = 1
Ct = 0
If Mid(s, i, 1) >= "0" And Mid(s, i, 1) <= "9" And _
Mid(s, i + 1, 1) >= "0" And Mid(s, i + 1, 1) <= "9" Then
Tp = "C"
Tx = A(105)
CheckSum = 105
Else
Tp = "B"
Tx = A(104)
CheckSum = 104
End If
While i <= Len(s)
If Len(s) - i > 2 Then
If Tp = "C" Then
If Mid(s, i, 1) >= "0" And Mid(s, i, 1) <= "9" And _
Mid(s, i + 1, 1) >= "0" And Mid(s, i + 1, 1) <= "9" Then
Ct = Ct + 1
Cr = Val(Mid(s, i, 2))
CheckSum = CheckSum + Ct * Cr
Tx = Tx & A(Cr)
i = i + 2
Else
Ct = Ct + 1
Cr = 100
CheckSum = CheckSum + Ct * Cr
Tx = Tx & A(Cr)
Tp = "B"
End If
Else
If Mid(s, i, 1) >= "0" And Mid(s, i, 1) <= "9" And _
Mid(s, i + 1, 1) >= "0" And Mid(s, i + 1, 1) <= "9" And _
Mid(s, i + 2, 1) >= "0" And Mid(s, i + 2, 1) <= "9" And _
Mid(s, i + 3, 1) >= "0" And Mid(s, i + 3, 1) <= "9" Then
Ct = Ct + 1
Cr = 99
CheckSum = CheckSum + Ct * Cr
Tx = Tx & A(Cr)
Tp = "C"
Else
Ct = Ct + 1
Cr = Asc(Mid(s, i, 1)) - 32
CheckSum = CheckSum + Ct * Cr
Tx = Tx & A(Cr)
i = i + 1
End If
End If
Else
If Len(s) - i = 2 Then
If Tp = "C" Then
If Mid(s, i, 1) >= "0" And Mid(s, i, 1) <= "9" And _
Mid(s, i + 1, 1) >= "0" And Mid(s, i + 1, 1) <= "9" Then
Ct = Ct + 1
Cr = Val(Mid(s, i, 2))
CheckSum = CheckSum + Ct * Cr
Tx = Tx & A(Cr)
i = i + 2
Else
Ct = Ct + 1
Cr = 100
CheckSum = CheckSum + Ct * Cr
Tx = Tx & A(Cr)
Tp = "B"
End If
Else
While i <= Len(s)
Ct = Ct + 1
Cr = Asc(Mid(s, i, 1)) - 32
CheckSum = CheckSum + Ct * Cr
Tx = Tx & A(Cr)
i = i + 1
Wend
End If
Else
If Tp = "C" Then
Ct = Ct + 1
Cr = 100
CheckSum = CheckSum + Ct * Cr
Tx = Tx & A(Cr)
Tp = "B"
Else
Ct = Ct + 1
Cr = Asc(Mid(s, i, 1)) - 32
CheckSum = CheckSum + Ct * Cr
Tx = Tx & A(Cr)
i = i + 1
End If
End If
End If
Wend
Cr = CheckSum Mod 103
Tx = Tx & A(Cr)
Tx = Tx & A(106)
End If
Code128 = ToBar63(Tx)
End Function
Function ToBar63(s As String)
Dim i As Integer
ToBar63 = ""
If Len(s) Mod 6 <> 0 Then s = s & Replace(Space(6 - Len(s) Mod 6), " ", "0")
For i = 1 To Len(s) / 6
ToBar63 = ToBar63 & Chr(BinToDec(Mid(s, i * 6 - 5, 6)) + 32)
Next i
End Function
Function BinToDec(Bits As String) As Long
If Len(Bits) > 0 Then
BinToDec = 2 * BinToDec(Left(Bits, Len(Bits) - 1)) + CLng(Right(Bits, 1))
End If
End FunctionThis is a clone of Bar63
120630
Published: 13th February, 2010
Last edited: 13th February, 2010
Created: 13th February, 2010
More sophisticated font for creation barcodes. Contains space - chr(32) and 63 bar characters from chr(33) to chr(95).
This font make possible to display or print different barcodes - Int2of5, Code39, Code93, Code128 and other in applications like excel, word, crystal report. Visual basic function below display barcode of Code128 type.
Function Code128(s As String) As String
Dim A As Variant
A = Array("11011001100", "11001101100", "11001100110", "10010011000", "10010001100", _
"10001001100", "10011001000", "10011000100", "10001100100", "11001001000", _
"11001000100", "11000100100", "10110011100", "10011011100", "10011001110", _
"10111001100", "10011101100", "10011100110", "11001110010", "11001011100", _
"11001001110", "11011100100", "11001110100", "11101101110", "11101001100", _
"11100101100", "11100100110", "11101100100", "11100110100", "11100110010", _
"11011011000", "11011000110", "11000110110", "10100011000", "10001011000", _
"10001000110", "10110001000", "10001101000", "10001100010", "11010001000", _
"11000101000", "11000100010", "10110111000", "10110001110", "10001101110", _
"10111011000", "10111000110", "10001110110", "11101110110", "11010001110", _
"11000101110", "11011101000", "11011100010", "11011101110", "11101011000", _
"11101000110", "11100010110", "11101101000", "11101100010", "11100011010", _
"11101111010", "11001000010", "11110001010", "10100110000", "10100001100", _
"10010110000", "10010000110", "10000101100", "10000100110", "10110010000", _
"10110000100", "10011010000", "10011000010", "10000110100", "10000110010", _
"11000010010", "11001010000", "11110111010", "11000010100", "10001111010", _
"10100111100", "10010111100", "10010011110", "10111100100", "10011110100", _
"10011110010", "11110100100", "11110010100", "11110010010", "11011011110", _
"11011110110", "11110110110", "10101111000", "10100011110", "10001011110", _
"10111101000", "10111100010", "11110101000", "11110100010", "10111011110", _
"10111101110", "11101011110", "11110101110", "11010000100", "11010010000", _
"11010011100", "1100011101011")
Dim CheckSum As Long
Dim Ct As Integer
Dim Cr As Integer
Dim Tx As String
Dim Tp As String
Dim i As Integer
Tx = ""
If Len(s) > 0 Then
i = 1
Ct = 0
If Mid(s, i, 1) >= "0" And Mid(s, i, 1) <= "9" And _
Mid(s, i + 1, 1) >= "0" And Mid(s, i + 1, 1) <= "9" Then
Tp = "C"
Tx = A(105)
CheckSum = 105
Else
Tp = "B"
Tx = A(104)
CheckSum = 104
End If
While i <= Len(s)
If Len(s) - i > 2 Then
If Tp = "C" Then
If Mid(s, i, 1) >= "0" And Mid(s, i, 1) <= "9" And _
Mid(s, i + 1, 1) >= "0" And Mid(s, i + 1, 1) <= "9" Then
Ct = Ct + 1
Cr = Val(Mid(s, i, 2))
CheckSum = CheckSum + Ct * Cr
Tx = Tx & A(Cr)
i = i + 2
Else
Ct = Ct + 1
Cr = 100
CheckSum = CheckSum + Ct * Cr
Tx = Tx & A(Cr)
Tp = "B"
End If
Else
If Mid(s, i, 1) >= "0" And Mid(s, i, 1) <= "9" And _
Mid(s, i + 1, 1) >= "0" And Mid(s, i + 1, 1) <= "9" And _
Mid(s, i + 2, 1) >= "0" And Mid(s, i + 2, 1) <= "9" And _
Mid(s, i + 3, 1) >= "0" And Mid(s, i + 3, 1) <= "9" Then
Ct = Ct + 1
Cr = 99
CheckSum = CheckSum + Ct * Cr
Tx = Tx & A(Cr)
Tp = "C"
Else
Ct = Ct + 1
Cr = Asc(Mid(s, i, 1)) - 32
CheckSum = CheckSum + Ct * Cr
Tx = Tx & A(Cr)
i = i + 1
End If
End If
Else
If Len(s) - i = 2 Then
If Tp = "C" Then
If Mid(s, i, 1) >= "0" And Mid(s, i, 1) <= "9" And _
Mid(s, i + 1, 1) >= "0" And Mid(s, i + 1, 1) <= "9" Then
Ct = Ct + 1
Cr = Val(Mid(s, i, 2))
CheckSum = CheckSum + Ct * Cr
Tx = Tx & A(Cr)
i = i + 2
Else
Ct = Ct + 1
Cr = 100
CheckSum = CheckSum + Ct * Cr
Tx = Tx & A(Cr)
Tp = "B"
End If
Else
While i <= Len(s)
Ct = Ct + 1
Cr = Asc(Mid(s, i, 1)) - 32
CheckSum = CheckSum + Ct * Cr
Tx = Tx & A(Cr)
i = i + 1
Wend
End If
Else
If Tp = "C" Then
Ct = Ct + 1
Cr = 100
CheckSum = CheckSum + Ct * Cr
Tx = Tx & A(Cr)
Tp = "B"
Else
Ct = Ct + 1
Cr = Asc(Mid(s, i, 1)) - 32
CheckSum = CheckSum + Ct * Cr
Tx = Tx & A(Cr)
i = i + 1
End If
End If
End If
Wend
Cr = CheckSum Mod 103
Tx = Tx & A(Cr)
Tx = Tx & A(106)
End If
Code128 = ToBar63(Tx)
End Function
Function ToBar63(s As String)
Dim i As Integer
ToBar63 = ""
If Len(s) Mod 6 <> 0 Then s = s & Replace(Space(6 - Len(s) Mod 6), " ", "0")
For i = 1 To Len(s) / 6
ToBar63 = ToBar63 & Chr(BinToDec(Mid(s, i * 6 - 5, 6)) + 32)
Next i
End Function
Function BinToDec(Bits As String) As Long
If Len(Bits) > 0 Then
BinToDec = 2 * BinToDec(Left(Bits, Len(Bits) - 1)) + CLng(Right(Bits, 1))
End If
End FunctionThis is a clone of Bar31
130310
Published: 13th February, 2010
Last edited: 13th February, 2010
Created: 12th February, 2010
Font for creation barcodes. This font make possible to display or print different barcodes - Int2of5, Code39, Code93, Code128 and other in applications like excel, word, crystal report.
This is a clone of Bar15
140310
Published: 13th February, 2010
Last edited: 13th February, 2010
Created: 12th February, 2010
Font for creation barcodes. This font make possible to display or print different barcodes - Int2of5, Code39, Code93, Code128 and other in applications like excel, word, crystal report.
This is a clone of Bar31
110150
Published: 13th February, 2010
Last edited: 8th February, 2010
Created: 8th February, 2010
Font for creation barcodes. This font make possible to display or print different barcodes - Int2of5, Code39, Code93, Code128 and other in applications like excel, word, crystal report.
161151
Published: 13th February, 2010
Last edited: 8th February, 2010
Created: 8th February, 2010
Font for creation barcodes. This font make possible to display or print different barcodes - Int2of5, Code39, Code93, Code128 and other in applications like excel, word, crystal report.
1412003
Published: 16th May, 2013
Last edited: 28th January, 2013
Created: 26th January, 2013
A monospaced font I did with my dormitory in mind (Robert Jacobsen Kollegiet). The intended use was for the bar logo and menus and such. Never actually got used, but it might be at some point.