Bar63thin

Share:
by Pimon
Cloned from Bar63 by Pimon, Bar31 by Pimon, Bar15 by Pimon.

Download disabled

The designer of this FontStruction has chosen not to make it available for download from this website by choosing an “All Rights Reserved" license.

Please respect their decision and desist from requesting license changes in the comments.

If you would like to use the FontStruction for a specific project, you may be able to contact the designer directly about obtaining a license.

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 Function
Info: Created on 13th February 2010 . Last edited on 13th February 2010.
License Creative Commons
Categories:
Sets:
Tags:
Fave Tags:
  • -

0 Comments

Also of Interest

More from the Gallery

Bar15thinby Pimon
Bar15by Pimon
Bar63by Pimon
Bar63thinby Pimon
Dutchby igorrossi
driftwoodby arian.durst
Typewrittenby minidonut
AT Twelveby architaraz

From the Blog

News

New Bricks: Square Connectors

News

The Video Game Font Preservation Society

News

FontStruct goes open source!

News

New Bricks: Half Arcs