PureBasic Forum
http://forums.purebasic.com/english/

Barcode
http://forums.purebasic.com/english/viewtopic.php?f=12&t=72400
Page 1 of 1

Author:  TeddyLM [ Tue Mar 05, 2019 7:42 am ]
Post subject:  Barcode

Quote:

Hi
I needed this for a project (and didn't want to use fonts).
Maybe it could be useful to someone else.

TeddyLM



Code:
Enumeration
    #BARCODE_128
    #BARCODE_39
    #BARCODE_2of5
    #BARCODE_93   
    #BARCODE_EAN     
EndEnumeration

Enumeration
    #TEXT_NONE
    #TEXT_CENTER
    #TEXT_EAN
EndEnumeration

Global DISPLAYTEXT$
Global FONT_DEFAULT.i
Global FONT_EAN.i


;==================================
Procedure.s Get_Barcode2of5(Text$)
    Result$ = ""
    DISPLAYTEXT$ = Text$
    If Text$
        If Len(Text$) & 1 : Text$ = "0" + Text$ : EndIf
        ;Start
        Result$ = "b1,s1,b1,s1,"   ;Start
        ;Characters
        For counter = 1 To Len(Text$) Step 2
            Char1$ = Mid(Text$, counter, 1)
            Char2$ = Mid(Text$, counter+1, 1)
            ;Get first combination
            Result1$ = ""
            Select Char1$
                Case "0" : Result1$ + "nnWWn"       
                Case "1" : Result1$ + "WnnnW"
                Case "2" : Result1$ + "nWnnW"
                Case "3" : Result1$ + "WWnnn"
                Case "4" : Result1$ + "nnWnW"
                Case "5" : Result1$ + "WnWnn"
                Case "6" : Result1$ + "nWWnn"
                Case "7" : Result1$ + "nnnWW"
                Case "8" : Result1$ + "WnnWn"
                Case "9" : Result1$ + "nWnWn"
            EndSelect
            ;Get second combination
            Result2$ = ""
            Select Char2$
                Case "0" : Result2$ + "nnWWn"       
                Case "1" : Result2$ + "WnnnW"
                Case "2" : Result2$ + "nWnnW"
                Case "3" : Result2$ + "WWnnn"
                Case "4" : Result2$ + "nnWnW"
                Case "5" : Result2$ + "WnWnn"
                Case "6" : Result2$ + "nWWnn"
                Case "7" : Result2$ + "nnnWW"
                Case "8" : Result2$ + "WnnWn"
                Case "9" : Result2$ + "nWnWn"
            EndSelect
            ;Combine the combinations
            For Loop = 1 To 5
                Select Mid(Result1$, loop, 1)
                    Case "n" : Result$ + ",b1"
                    Case "W" : Result$ + ",b3"
                EndSelect
                Select Mid(Result2$, loop, 1)
                    Case "n" : Result$ + ",s1"
                    Case "W" : Result$ + ",s3"
                EndSelect
            Next
        Next
        ;stop
        Result$ + ",b2,s1,b1,"
    EndIf
    ProcedureReturn Result$
EndProcedure
;Debug Get_Barcode2of5("12345")
;==================================
Procedure.s Get_Barcode39(Text$)
    Result$ = ""
    DISPLAYTEXT$ = UCase(Text$)
    If Text$
        Text$ = UCase(Text$)
        ;Start
        Result$ = "b1,s3,b1,s1,b3,s1,b3,s1,b1"   ;"*"
        Gap$ = ",s1,"
        ;Characters
        For counter = 1 To Len(Text$)
            Char$ = Mid(Text$, counter, 1)
            Select Char$
                Case "0" : Result$ + Gap$ + "b1,s1,b1,s3,b3,s1,b3,s1,b1"       
                Case "1" : Result$ + Gap$ + "b3,s1,b1,s3,b1,s1,b1,s1,b3"       
                Case "2" : Result$ + Gap$ + "b1,s1,b3,s3,b1,s1,b1,s1,b3"       
                Case "3" : Result$ + Gap$ + "b3,s1,b3,s3,b1,s1,b1,s1,b1"       
                Case "4" : Result$ + Gap$ + "b1,s1,b1,s3,b3,s1,b1,s1,b3"       
                Case "5" : Result$ + Gap$ + "b3,s1,b1,s3,b3,s1,b1,s1,b1"       
                Case "6" : Result$ + Gap$ + "b1,s1,b3,s3,b3,s1,b1,s1,b1"       
                Case "7" : Result$ + Gap$ + "b1,s1,b1,s3,b1,s1,b3,s1,b3"       
                Case "8" : Result$ + Gap$ + "b3,s1,b1,s3,b1,s1,b3,s1,b1"       
                Case "9" : Result$ + Gap$ + "b1,s1,b3,s3,b1,s1,b3,s1,b1"       
                Case "A" : Result$ + Gap$ + "b3,s1,b1,s1,b1,s3,b1,s1,b3"       
                Case "B" : Result$ + Gap$ + "b1,s1,b3,s1,b1,s3,b1,s1,b3"       
                Case "C" : Result$ + Gap$ + "b3,s1,b3,s1,b1,s3,b1,s1,b1"       
                Case "D" : Result$ + Gap$ + "b1,s1,b1,s1,b3,s3,b1,s1,b3"       
                Case "E" : Result$ + Gap$ + "b3,s1,b1,s1,b3,s3,b1,s1,b1"       
                Case "F" : Result$ + Gap$ + "b1,s1,b3,s1,b3,s3,b1,s1,b1"       
                Case "G" : Result$ + Gap$ + "b1,s1,b1,s1,b1,s3,b3,s1,b3"       
                Case "H" : Result$ + Gap$ + "b3,s1,b1,s1,b1,s3,b3,s1,b1"       
                Case "I" : Result$ + Gap$ + "b1,s1,b3,s1,b1,s3,b3,s1,b1"       
                Case "J" : Result$ + Gap$ + "b1,s1,b1,s1,b3,s3,b3,s1,b1"       
                Case "K" : Result$ + Gap$ + "b3,s1,b1,s1,b1,s1,b1,s3,b3"       
                Case "L" : Result$ + Gap$ + "b1,s1,b3,s1,b1,s1,b1,s3,b3"       
                Case "M" : Result$ + Gap$ + "b3,s1,b3,s1,b1,s1,b1,s3,b1"      
                Case "N" : Result$ + Gap$ + "b1,s1,b1,s1,b3,s1,b1,s3,b3"       
                Case "O" : Result$ + Gap$ + "b3,s1,b1,s1,b3,s1,b1,s3,b1"       
                Case "P" : Result$ + Gap$ + "b1,s1,b3,s1,b3,s1,b1,s3,b1"       
                Case "Q" : Result$ + Gap$ + "b1,s1,b1,s1,b1,s1,b3,s3,b3"       
                Case "R" : Result$ + Gap$ + "b3,s1,b1,s1,b1,s1,b3,s3,b1"       
                Case "S" : Result$ + Gap$ + "b1,s1,b3,s1,b1,s1,b3,s3,b1"       
                Case "T" : Result$ + Gap$ + "b1,s1,b1,s1,b3,s1,b3,s3,b1"       
                Case "U" : Result$ + Gap$ + "b3,s3,b1,s1,b1,s1,b1,s1,b3"       
                Case "V" : Result$ + Gap$ + "b1,s3,b3,s1,b1,s1,b1,s1,b3"       
                Case "W" : Result$ + Gap$ + "b3,s3,b3,s1,b1,s1,b1,s1,b1"   
                Case "X" : Result$ + Gap$ + "b1,s3,b1,s1,b3,s1,b1,s1,b3"           
                Case "Y" : Result$ + Gap$ + "b3,s3,b1,s1,b3,s1,b1,s1,b1"           
                Case "Z" : Result$ + Gap$ + "b1,s3,b3,s1,b3,s1,b1,s1,b1"   
                Case "-" : Result$ + Gap$ + "b1,s3,b1,s1,b1,s1,b3,s1,b3"
                Case "." : Result$ + Gap$ + "b3,s3,b1,s1,b1,s1,b3,s1,b1"
                Case " " : Result$ + Gap$ + "b1,s3,b3,s1,b1,s1,b3,s1,b1"
                Case "$" : Result$ + Gap$ + "b1,s3,b1,s3,b1,s3,b1,s1,b1"
                Case "/" : Result$ + Gap$ + "b1,s3,b1,s3,b1,s1,b1,s3,b1"
                Case "+" : Result$ + Gap$ + "b1,s3,b1,s1,b1,s3,b1,s3,b1"
                Case "%" : Result$ + Gap$ + "b1,s1,b1,s3,b1,s3,b1,s3,b1"                   
            EndSelect
        Next
        ;stop
        Result$ + Gap$ + "b1,s3,b1,s1,b3,s1,b3,s1,b1" + Gap$
    EndIf
    ProcedureReturn Result$
EndProcedure
;Debug Get_Barcode39("Area51")
;==================================
Procedure.s Get_Barcode128(Text$)      ;Semicolon=<SC>  Char34=
    Result$ = ""
    DISPLAYTEXT$ = Text$
    If Text$       
        ;Calculate checksum
        Value.i = 104       ;STARTB value
        For counter = 1 To Len(Text$)
            Char$ = Mid(Text$, counter, 1)
            Select Char$       
                Case " " :      Value = Value + (0*counter)
                Case "!" :      Value = Value + (1*counter)
                Case #DQUOTE$ : Value = Value + (2*counter)
                Case "#" :      Value = Value + (3*counter)
                Case "$" :      Value = Value + (4*counter)
                Case "%" :      Value = Value + (5*counter)
                Case "&" :      Value = Value + (6*counter)
                Case "'" :      Value = Value + (7*counter)
                Case "(" :      Value = Value + (8*counter)
                Case ")" :      Value = Value + (9*counter)
                Case "*" :      Value = Value + (10*counter)
                Case "+" :      Value = Value + (11*counter)
                Case "," :      Value = Value + (12*counter)
                Case "-" :      Value = Value + (13*counter)
                Case "." :      Value = Value + (14*counter)
                Case "/" :      Value = Value + (15*counter)
                Case "0" :      Value = Value + (16*counter)
                Case "1" :      Value = Value + (17*counter)
                Case "2" :      Value = Value + (18*counter)
                Case "3" :      Value = Value + (19*counter)
                Case "4" :      Value = Value + (20*counter)
                Case "5" :      Value = Value + (21*counter)
                Case "6" :      Value = Value + (22*counter)
                Case "7" :      Value = Value + (23*counter)
                Case "8" :      Value = Value + (24*counter)
                Case "9" :      Value = Value + (25*counter)
                Case ":" :      Value = Value + (26*counter)
                Case ";" :      Value = Value + (27*counter)
                Case "<" :      Value = Value + (28*counter)
                Case "=" :      Value = Value + (29*counter)
                Case ">" :      Value = Value + (30*counter)
                Case "?" :      Value = Value + (31*counter)
                Case "@" :      Value = Value + (32*counter)
                Case "A" :      Value = Value + (33*counter)
                Case "B" :      Value = Value + (34*counter)
                Case "C" :      Value = Value + (35*counter)
                Case "D" :      Value = Value + (36*counter)
                Case "E" :      Value = Value + (37*counter)
                Case "F" :      Value = Value + (38*counter)
                Case "G" :      Value = Value + (39*counter)
                Case "H" :      Value = Value + (40*counter)
                Case "I" :      Value = Value + (41*counter)
                Case "J" :      Value = Value + (42*counter)
                Case "K" :      Value = Value + (43*counter)
                Case "L" :      Value = Value + (44*counter)
                Case "M" :      Value = Value + (45*counter)
                Case "N" :      Value = Value + (46*counter)
                Case "O" :      Value = Value + (47*counter)
                Case "P" :      Value = Value + (48*counter)
                Case "Q" :      Value = Value + (49*counter)
                Case "R" :      Value = Value + (50*counter)
                Case "S" :      Value = Value + (51*counter)
                Case "T" :      Value = Value + (52*counter)
                Case "U" :      Value = Value + (53*counter)
                Case "V" :      Value = Value + (54*counter)
                Case "W" :      Value = Value + (55*counter)
                Case "X" :      Value = Value + (56*counter)
                Case "Y" :      Value = Value + (57*counter)
                Case "Z" :      Value = Value + (58*counter)
                Case "[" :      Value = Value + (59*counter)
                Case "\" :      Value = Value + (60*counter)
                Case "]" :      Value = Value + (61*counter)
                Case "^" :      Value = Value + (62*counter)
                Case "_" :      Value = Value + (63*counter)
                Case "'" :      Value = Value + (64*counter)
                Case "a" :      Value = Value + (65*counter)
                Case "b" :      Value = Value + (66*counter)
                Case "c" :      Value = Value + (67*counter)
                Case "d" :      Value = Value + (68*counter)
                Case "e" :      Value = Value + (69*counter)
                Case "f" :      Value = Value + (70*counter)
                Case "g" :      Value = Value + (71*counter)
                Case "h" :      Value = Value + (72*counter)
                Case "i" :      Value = Value + (73*counter)
                Case "j" :      Value = Value + (74*counter)
                Case "k" :      Value = Value + (75*counter)
                Case "l" :      Value = Value + (76*counter)
                Case "m" :      Value = Value + (77*counter)
                Case "n" :      Value = Value + (78*counter)
                Case "o" :      Value = Value + (79*counter)
                Case "p" :      Value = Value + (80*counter)
                Case "q" :      Value = Value + (81*counter)
                Case "r" :      Value = Value + (82*counter)
                Case "s" :      Value = Value + (83*counter)
                Case "t" :      Value = Value + (84*counter)
                Case "u" :      Value = Value + (85*counter)
                Case "v" :      Value = Value + (86*counter)
                Case "w" :      Value = Value + (87*counter)
                Case "x" :      Value = Value + (88*counter)
                Case "y" :      Value = Value + (89*counter)
                Case "z" :      Value = Value + (90*counter)
                Case "{" :      Value = Value + (91*counter)
                Case "|" :      Value = Value + (92*counter)
                Case "}" :      Value = Value + (93*counter)
                Case "~" :      Value = Value + (94*counter)       
            EndSelect
        Next
        ;Checksum.i = Int(Mod(Value, 103)) 
        Checksum.i = Mod(Value, 103) 
        ;Add character corresponding to the checksum
        Select Checksum
            Case 0 :  Text$ + " "
            Case 1 :  Text$ + "!"
            Case 2 :  Text$ + #DQUOTE$
            Case 3 :  Text$ + "#"
            Case 4 :  Text$ + "$"
            Case 5 :  Text$ + "%"
            Case 6 :  Text$ + "&"
            Case 7 :  Text$ + "'"
            Case 8 :  Text$ + "("
            Case 9 :  Text$ + ")"
            Case 10 : Text$ + "*"
            Case 11 : Text$ + "+"
            Case 12 : Text$ + ","
            Case 13 : Text$ + "-"
            Case 14 : Text$ + "."
            Case 15 : Text$ + "/"
            Case 16 : Text$ + "0"
            Case 17 : Text$ + "1"
            Case 18 : Text$ + "2"
            Case 19 : Text$ + "3"
            Case 20 : Text$ + "4"
            Case 21 : Text$ + "5"
            Case 22 : Text$ + "6"
            Case 23 : Text$ + "7"
            Case 24 : Text$ + "8"
            Case 25 : Text$ + "9"
            Case 26 : Text$ + ":"
            Case 27 : Text$ + ";"
            Case 28 : Text$ + "<"
            Case 29 : Text$ + "="
            Case 30 : Text$ + ">"
            Case 31 : Text$ + "?"
            Case 32 : Text$ + "@"
            Case 33 : Text$ + "A"
            Case 34 : Text$ + "B"
            Case 35 : Text$ + "C"
            Case 36 : Text$ + "D"
            Case 37 : Text$ + "E"
            Case 38 : Text$ + "F"
            Case 39 : Text$ + "G"
            Case 40 : Text$ + "H"
            Case 41 : Text$ + "I"
            Case 42 : Text$ + "J"
            Case 43 : Text$ + "K"
            Case 44 : Text$ + "L"
            Case 45 : Text$ + "M"
            Case 46 : Text$ + "N"
            Case 47 : Text$ + "O"
            Case 48 : Text$ + "P"
            Case 49 : Text$ + "Q"
            Case 50 : Text$ + "R"
            Case 51 : Text$ + "S"
            Case 52 : Text$ + "T"
            Case 53 : Text$ + "U"
            Case 54 : Text$ + "V"
            Case 55 : Text$ + "W"
            Case 56 : Text$ + "X"
            Case 57 : Text$ + "Y"
            Case 58 : Text$ + "Z"
            Case 59 : Text$ + "["
            Case 60 : Text$ + "\"
            Case 61 : Text$ + "]"
            Case 62 : Text$ + "^"
            Case 63 : Text$ + "_"
            Case 64 : Text$ + "'"
            Case 65 : Text$ + "a"
            Case 66 : Text$ + "b"
            Case 67 : Text$ + "c"
            Case 68 : Text$ + "d"
            Case 69 : Text$ + "e"
            Case 70 : Text$ + "f"
            Case 71 : Text$ + "g"
            Case 72 : Text$ + "h"
            Case 73 : Text$ + "i"
            Case 74 : Text$ + "j"
            Case 75 : Text$ + "k"
            Case 76 : Text$ + "l"
            Case 77 : Text$ + "m"
            Case 78 : Text$ + "n"
            Case 79 : Text$ + "o"
            Case 80 : Text$ + "p"
            Case 81 : Text$ + "q"
            Case 82 : Text$ + "r"
            Case 83 : Text$ + "s"
            Case 84 : Text$ + "t"
            Case 85 : Text$ + "u"
            Case 86 : Text$ + "v"
            Case 87 : Text$ + "w"
            Case 88 : Text$ + "x"
            Case 89 : Text$ + "y"
            Case 90 : Text$ + "z"
            Case 91 : Text$ + "{"
            Case 92 : Text$ + "|"
            Case 93 : Text$ + "}"
            Case 94 : Text$ + "~"       
        EndSelect       
        ;Start B
        Result$ = "b2,s1,b1,s2,b1,s4"   ;StartB
        Value = 0
        ;Characters
        For counter = 1 To Len(Text$)
            Char$ = Mid(Text$, counter, 1)
            Select Char$       
                Case " " :      Result$ + ",b2,s1,b2,s2,b2,s2"
                Case "!" :      Result$ + ",b2,s2,b2,s1,b2,s2"
                Case #DQUOTE$ : Result$ + ",b2,s2,b2,s2,b2,s1"
                Case "#" :      Result$ + ",b1,s2,b1,s2,b2,s3"
                Case "$" :      Result$ + ",b1,s2,b1,s3,b2,s2"
                Case "%" :      Result$ + ",b1,s3,b1,s2,b2,s2"
                Case "&" :      Result$ + ",b1,s2,b2,s2,b1,s3"
                Case "'" :      Result$ + ",b1,s2,b2,s3,b1,s2"
                Case "(" :      Result$ + ",b1,s3,b2,s2,b1,s2"
                Case ")" :      Result$ + ",b2,s2,b1,s2,b1,s3"
                Case "*" :      Result$ + ",b2,s2,b1,s3,b1,s2"
                Case "+" :      Result$ + ",b2,s3,b1,s2,b1,s2"
                Case "," :      Result$ + ",b1,s1,b2,s2,b3,s2"
                Case "-" :      Result$ + ",b1,s2,b2,s1,b3,s2"
                Case "." :      Result$ + ",b1,s2,b2,s2,b3,s1"
                Case "/" :      Result$ + ",b1,s1,b3,s2,b2,s2"
                Case "0" :      Result$ + ",b1,s2,b3,s1,b2,s2"
                Case "1" :      Result$ + ",b1,s2,b3,s2,b2,s1"
                Case "2" :      Result$ + ",b2,s2,b3,s2,b1,s1"
                Case "3" :      Result$ + ",b2,s2,b1,s1,b3,s2"
                Case "4" :      Result$ + ",b2,s2,b1,s2,b3,s1"
                Case "5" :      Result$ + ",b2,s1,b3,s2,b1,s2"
                Case "6" :      Result$ + ",b2,s2,b3,s1,b1,s2"
                Case "7" :      Result$ + ",b3,s1,b2,s1,b3,s1"
                Case "8" :      Result$ + ",b3,s1,b1,s2,b2,s2"
                Case "9" :      Result$ + ",b3,s2,b1,s1,b2,s2"
                Case ":" :      Result$ + ",b3,s2,b1,s2,b2,s1"
                Case ";" :      Result$ + ",b3,s1,b2,s2,b1,s2"
                Case "<" :      Result$ + ",b3,s2,b2,s1,b1,s2"
                Case "=" :      Result$ + ",b3,s2,b2,s2,b1,s1"
                Case ">" :      Result$ + ",b2,s1,b2,s1,b2,s3"
                Case "?" :      Result$ + ",b2,s1,b2,s3,b2,s1"
                Case "@" :      Result$ + ",b2,s3,b2,s1,b2,s1"
                Case "A" :      Result$ + ",b1,s1,b1,s3,b2,s3"
                Case "B" :      Result$ + ",b1,s3,b1,s1,b2,s3"
                Case "C" :      Result$ + ",b1,s3,b1,s3,b2,s1"
                Case "D" :      Result$ + ",b1,s1,b2,s3,b1,s3"
                Case "E" :      Result$ + ",b1,s3,b2,s1,b1,s3"
                Case "F" :      Result$ + ",b1,s3,b2,s3,b1,s1"
                Case "G" :      Result$ + ",b2,s1,b1,s3,b1,s3"
                Case "H" :      Result$ + ",b2,s3,b1,s1,b1,s3"
                Case "I" :      Result$ + ",b2,s3,b1,s3,b1,s1"
                Case "J" :      Result$ + ",b1,s1,b2,s1,b3,s3"
                Case "K" :      Result$ + ",b1,s1,b2,s3,b3,s1"
                Case "L" :      Result$ + ",b1,s3,b2,s1,b3,s1"
                Case "M" :      Result$ + ",b1,s1,b3,s1,b2,s3"
                Case "N" :      Result$ + ",b1,s1,b3,s3,b2,s1"
                Case "O" :      Result$ + ",b1,s3,b3,s1,b2,s1"
                Case "P" :      Result$ + ",b3,s1,b3,s1,b2,s1"
                Case "Q" :      Result$ + ",b2,s1,b1,s3,b3,s1"
                Case "R" :      Result$ + ",b2,s3,b1,s1,b3,s1"
                Case "S" :      Result$ + ",b2,s1,b3,s1,b1,s3"
                Case "T" :      Result$ + ",b2,s1,b3,s3,b1,s1"
                Case "U" :      Result$ + ",b2,s1,b3,s1,b3,s1"
                Case "V" :      Result$ + ",b3,s1,b1,s1,b2,s3"
                Case "W" :      Result$ + ",b3,s1,b1,s3,b2,s1"
                Case "X" :      Result$ + ",b3,s3,b1,s1,b2,s1"
                Case "Y" :      Result$ + ",b3,s1,b2,s1,b1,s3"
                Case "Z" :      Result$ + ",b3,s1,b2,s3,b1,s1"
                Case "[" :      Result$ + ",b3,s3,b2,s1,b1,s1"
                Case "\" :      Result$ + ",b3,s1,b4,s1,b1,s1"
                Case "]" :      Result$ + ",b2,s2,b1,s4,b1,s1"
                Case "^" :      Result$ + ",b4,s3,b1,s1,b1,s1"
                Case "_" :      Result$ + ",b1,s1,b1,s2,b2,s4"
                Case "'" :      Result$ + ",b1,s1,b1,s4,b2,s2"
                Case "a" :      Result$ + ",b1,s2,b1,s1,b2,s4"
                Case "b" :      Result$ + ",b1,s2,b1,s4,b2,s1"
                Case "c" :      Result$ + ",b1,s4,b1,s1,b2,s2"
                Case "d" :      Result$ + ",b1,s4,b1,s2,b2,s1"
                Case "e" :      Result$ + ",b1,s1,b2,s2,b1,s4"
                Case "f" :      Result$ + ",b1,s1,b2,s4,b1,s2"
                Case "g" :      Result$ + ",b1,s2,b2,s1,b1,s4"
                Case "h" :      Result$ + ",b1,s2,b2,s4,b1,s1"
                Case "i" :      Result$ + ",b1,s4,b2,s1,b1,s2"
                Case "j" :      Result$ + ",b1,s4,b2,s2,b1,s1"
                Case "k" :      Result$ + ",b2,s4,b1,s2,b1,s1"
                Case "l" :      Result$ + ",b2,s2,b1,s1,b1,s4"
                Case "m" :      Result$ + ",b4,s1,b3,s1,b1,s1"
                Case "n" :      Result$ + ",b2,s4,b1,s1,b1,s2"
                Case "o" :      Result$ + ",b1,s3,b4,s1,b1,s1"
                Case "p" :      Result$ + ",b1,s1,b1,s2,b4,s2"
                Case "q" :      Result$ + ",b1,s2,b1,s1,b4,s2"
                Case "r" :      Result$ + ",b1,s2,b1,s2,b4,s1"
                Case "s" :      Result$ + ",b1,s1,b4,s2,b1,s2"
                Case "t" :      Result$ + ",b1,s2,b4,s1,b1,s2"
                Case "u" :      Result$ + ",b1,s2,b4,s2,b1,s1"
                Case "v" :      Result$ + ",b4,s1,b1,s2,b1,s2"
                Case "w" :      Result$ + ",b4,s2,b1,s1,b1,s2"
                Case "x" :      Result$ + ",b4,s2,b1,s2,b1,s1"
                Case "y" :      Result$ + ",b2,s1,b2,s1,b4,s1"
                Case "z" :      Result$ + ",b2,s1,b4,s1,b2,s1"
                Case "{" :      Result$ + ",b4,s1,b2,s1,b2,s1"
                Case "|" :      Result$ + ",b1,s1,b1,s1,b4,s3"
                Case "}" :      Result$ + ",b1,s1,b1,s3,b4,s1"
                Case "~" :      Result$ + ",b1,s3,b1,s1,b4,s1"
            EndSelect
        Next   
        ;stop
        Result$ + ",b2,s3,b3,s1,b1,s1,b2,"  ;STOP           
    EndIf
    ProcedureReturn Result$
EndProcedure
;Debug Get_Barcode128("Area51")
;==================================
Procedure.s Get_Barcode93(Text$)
    Result$ = ""
    DISPLAYTEXT$ = UCase(Text$)
    If Text$
        Text$ = UCase(Text$)
        Reversed$ = ReverseString(Text$)
        ;Start
        Result$ = "b1,s1,b1,s1,b1,b1,b1,b1,s1"   ;"*"
        ;Calculate checksum C 
        Value = 0
        Weight.i = 1
        For counter = 1 To Len(Reversed$)
            Char$ = Mid(Reversed$, counter, 1)
            Select Char$                                     
                Case "0" : Value + (0*Weight)
                Case "1" : Value + (1*Weight)
                Case "2" : Value + (2*Weight)
                Case "3" : Value + (3*Weight)
                Case "4" : Value + (4*Weight)
                Case "5" : Value + (5*Weight)
                Case "6" : Value + (6*Weight)
                Case "7" : Value + (7*Weight)
                Case "8" : Value + (8*Weight)
                Case "9" : Value + (9*Weight)
                Case "A" : Value + (10*Weight)
                Case "B" : Value + (11*Weight)
                Case "C" : Value + (12*Weight)
                Case "D" : Value + (13*Weight)
                Case "E" : Value + (14*Weight)
                Case "F" : Value + (15*Weight)
                Case "G" : Value + (16*Weight)
                Case "H" : Value + (17*Weight)
                Case "I" : Value + (18*Weight)
                Case "J" : Value + (19*Weight)
                Case "K" : Value + (20*Weight)
                Case "L" : Value + (21*Weight)
                Case "M" : Value + (22*Weight)
                Case "N" : Value + (23*Weight)
                Case "O" : Value + (24*Weight)
                Case "P" : Value + (25*Weight)
                Case "Q" : Value + (26*Weight)
                Case "R" : Value + (27*Weight)
                Case "S" : Value + (28*Weight)
                Case "T" : Value + (29*Weight)
                Case "U" : Value + (30*Weight)
                Case "V" : Value + (31*Weight)
                Case "W" : Value + (32*Weight)
                Case "X" : Value + (33*Weight)
                Case "Y" : Value + (34*Weight)
                Case "Z" : Value + (35*Weight)
                Case "-" : Value + (36*Weight)
                Case "." : Value + (37*Weight)
                Case " " : Value + (38*Weight)
                Case "$" : Value + (39*Weight)
                Case "/" : Value + (40*Weight)
                Case "+" : Value + (41*Weight)
                Case "%" : Value + (42*Weight)
            EndSelect
            Weight = Weight + 1 : If Weight = 21 : Weight = 1 : EndIf
        Next       
        ChecksumValue = Mod(Value, 47)
        ChecksumChar$ = StringField("0,1,2,3,4,5,6,7,8,9,A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,U,V,W,X,Y,Z,-,., ,$,/,+,%", ChecksumValue+1, ",") 
        Reversed$ = ChecksumChar$ + Reversed$
        Text$ = Text$ + ChecksumChar$
        ;Calculate checksum K 
        Value = 0
        Weight.i = 1
        For counter = 1 To Len(Reversed$)
            Char$ = Mid(Reversed$, counter, 1)
            Select Char$                                     
                Case "0" : Value + (0*Weight)
                Case "1" : Value + (1*Weight)
                Case "2" : Value + (2*Weight)
                Case "3" : Value + (3*Weight)
                Case "4" : Value + (4*Weight)
                Case "5" : Value + (5*Weight)
                Case "6" : Value + (6*Weight)
                Case "7" : Value + (7*Weight)
                Case "8" : Value + (8*Weight)
                Case "9" : Value + (9*Weight)
                Case "A" : Value + (10*Weight)
                Case "B" : Value + (11*Weight)
                Case "C" : Value + (12*Weight)
                Case "D" : Value + (13*Weight)
                Case "E" : Value + (14*Weight)
                Case "F" : Value + (15*Weight)
                Case "G" : Value + (16*Weight)
                Case "H" : Value + (17*Weight)
                Case "I" : Value + (18*Weight)
                Case "J" : Value + (19*Weight)
                Case "K" : Value + (20*Weight)
                Case "L" : Value + (21*Weight)
                Case "M" : Value + (22*Weight)
                Case "N" : Value + (23*Weight)
                Case "O" : Value + (24*Weight)
                Case "P" : Value + (25*Weight)
                Case "Q" : Value + (26*Weight)
                Case "R" : Value + (27*Weight)
                Case "S" : Value + (28*Weight)
                Case "T" : Value + (29*Weight)
                Case "U" : Value + (30*Weight)
                Case "V" : Value + (31*Weight)
                Case "W" : Value + (32*Weight)
                Case "X" : Value + (33*Weight)
                Case "Y" : Value + (34*Weight)
                Case "Z" : Value + (35*Weight)
                Case "-" : Value + (36*Weight)
                Case "." : Value + (37*Weight)
                Case " " : Value + (38*Weight)
                Case "$" : Value + (39*Weight)
                Case "/" : Value + (40*Weight)
                Case "+" : Value + (41*Weight)
                Case "%" : Value + (42*Weight)
            EndSelect
            Weight = Weight + 1 : If Weight = 16 : Weight = 1 : EndIf
        Next       
        ChecksumValue = Mod(Value, 47)
        ChecksumChar$ = StringField("0,1,2,3,4,5,6,7,8,9,A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,U,V,W,X,Y,Z,-,., ,$,/,+,%", ChecksumValue+1, ",")
        Text$ = Text$ + ChecksumChar$       
        ;Characters
        For counter = 1 To Len(Text$)
            Char$ = Mid(Text$, counter, 1)
            Select Char$                                     
                Case "0" : Result$ + ",b1,s3,b1,s1,b1,s2"
                Case "1" : Result$ + ",b1,s1,b1,s2,b1,s3"
                Case "2" : Result$ + ",b1,s1,b1,s3,b1,s2"
                Case "3" : Result$ + ",b1,s1,b1,s4,b1,s1"
                Case "4" : Result$ + ",b1,s2,b1,s1,b1,s3"
                Case "5" : Result$ + ",b1,s2,b1,s2,b1,s2"
                Case "6" : Result$ + ",b1,s2,b1,s3,b1,s1"
                Case "7" : Result$ + ",b1,s1,b1,s1,b1,s4"
                Case "8" : Result$ + ",b1,s3,b1,s2,b1,s1"
                Case "9" : Result$ + ",b1,s4,b1,s1,b1,s1"
                Case "A" : Result$ + ",b2,s1,b1,s1,b1,s3"
                Case "B" : Result$ + ",b2,s1,b1,s2,b1,s2"
                Case "C" : Result$ + ",b2,s1,b1,s3,b1,s1"
                Case "D" : Result$ + ",b2,s2,b1,s1,b1,s2"
                Case "E" : Result$ + ",b2,s2,b1,s2,b1,s1"
                Case "F" : Result$ + ",b2,s3,b1,s1,b1,s1"
                Case "G" : Result$ + ",b1,s1,b2,s1,b1,s3"
                Case "H" : Result$ + ",b1,s1,b2,s2,b1,s2"
                Case "I" : Result$ + ",b1,s1,b2,s3,b1,s1"
                Case "J" : Result$ + ",b1,s2,b2,s1,b1,s2"
                Case "K" : Result$ + ",b1,s3,b2,s1,b1,s1"
                Case "L" : Result$ + ",b1,s1,b1,s1,b2,s3"
                Case "M" : Result$ + ",b1,s1,b1,s2,b2,s2"
                Case "N" : Result$ + ",b1,s1,b1,s3,b2,s1"
                Case "O" : Result$ + ",b1,s2,b1,s1,b2,s2"
                Case "P" : Result$ + ",b1,s3,b1,s1,b2,s1"
                Case "Q" : Result$ + ",b2,s1,b2,s1,b1,s2"
                Case "R" : Result$ + ",b2,s1,b2,s2,b1,s1"
                Case "S" : Result$ + ",b2,s1,b1,s1,b2,s2"
                Case "T" : Result$ + ",b2,s1,b1,s2,b2,s1"
                Case "U" : Result$ + ",b2,s2,b1,s1,b2,s1"
                Case "V" : Result$ + ",b2,s2,b2,s1,b1,s1"
                Case "W" : Result$ + ",b1,s1,b2,s1,b2,s2"
                Case "X" : Result$ + ",b1,s1,b2,s2,b2,s1"
                Case "Y" : Result$ + ",b1,s2,b2,s1,b2,s1"
                Case "Z" : Result$ + ",b1,s2,b3,s1,b1,s1"
                Case "-" : Result$ + ",b1,s2,b1,s1,b3,s1"
                Case "." : Result$ + ",b3,s1,b1,s1,b1,s2"
                Case " " : Result$ + ",b3,s1,b1,s2,b1,s1"
                Case "$" : Result$ + ",b3,s2,b1,s1,b1,s1"
                Case "/" : Result$ + ",b1,s1,b2,s1,b3,s1"
                Case "+" : Result$ + ",b1,s1,b3,s1,b2,s1"
                Case "%" : Result$ + ",b2,s1,b1,s1,b3,s1" 
            EndSelect
        Next     
        ;stop
        Result$ + ",b1,s1,b1,s1,b1,b1,b1,b1,s1,b1,"
    EndIf
    ProcedureReturn Result$
EndProcedure

;==================================
Procedure.s Get_BarcodeEAN(Text$)
    Result$ = ""
    If Text$
        Text$ = Right("0000000000000" + Text$, 12)
        ;Start
        Result$ = "b1,s1,b1"   
        ;Calculate checksum
        Value = 0
        Weight.i = 3
        For counter = 1 To 13
            Char$ = Mid(ReverseString(Text$), counter, 1)
            Select Char$                                     
                Case "0" : Value + (0*Weight)
                Case "1" : Value + (1*Weight)
                Case "2" : Value + (2*Weight)
                Case "3" : Value + (3*Weight)
                Case "4" : Value + (4*Weight)
                Case "5" : Value + (5*Weight)
                Case "6" : Value + (6*Weight)
                Case "7" : Value + (7*Weight)
                Case "8" : Value + (8*Weight)
                Case "9" : Value + (9*Weight)
            EndSelect
            Weight = Weight + 2 : If Weight = 5 : Weight = 1 : EndIf
        Next     
        ChecksumValue = 0
        While Mod(Value + ChecksumValue, 10) <> 0
            ChecksumValue = ChecksumValue + 1
        Wend
        Text$ = Text$ + Str(ChecksumValue)
        DISPLAYTEXT$ = Text$
       
        ;Get encoding tables     
        Select Left(Text$, 1)
            Case "0" : CurrentParity$ = "000000"
            Case "1" : CurrentParity$ = "001011"
            Case "2" : CurrentParity$ = "001101"
            Case "3" : CurrentParity$ = "001110"
            Case "4" : CurrentParity$ = "010011"
            Case "5" : CurrentParity$ = "011001"
            Case "6" : CurrentParity$ = "011100"
            Case "7" : CurrentParity$ = "010101"
            Case "8" : CurrentParity$ = "010110"
            Case "9" : CurrentParity$ = "011010"     
        EndSelect
        ;
        For counter = 1 To 6
            Digit$ = Mid(Text$, counter+1, 1)
            Select Digit$   
                Case "0"
                    Select Mid(CurrentParity$, counter, 1)
                        Case "0" : Result$ + ",s3,b2,s1,b1"
                        Case "1" : Result$ + ",s1,b1,s2,b3"
                    EndSelect
                Case "1"
                    Select Mid(CurrentParity$, counter, 1)
                        Case "0" : Result$ + ",s2,b2,s2,b1"
                        Case "1" : Result$ + ",s1,b2,s2,b2"
                    EndSelect
                Case "2"
                    Select Mid(CurrentParity$, counter, 1)
                        Case "0" : Result$ + ",s2,b1,s2,b2"
                        Case "1" : Result$ + ",s2,b2,s1,b2"
                    EndSelect
                Case "3"
                    Select Mid(CurrentParity$, counter, 1)
                        Case "0" : Result$ + ",s1,b4,s1,b1"
                        Case "1" : Result$ + ",s1,b1,s4,b1"
                    EndSelect
                Case "4"
                    Select Mid(CurrentParity$, counter, 1)
                        Case "0" : Result$ + ",s1,b1,s3,b2"
                        Case "1" : Result$ + ",s2,b3,s1,b1"
                    EndSelect
                Case "5"
                    Select Mid(CurrentParity$, counter, 1)
                        Case "0" : Result$ + ",s1,b2,s3,b1"
                        Case "1" : Result$ + ",s1,b3,s2,b1"
                    EndSelect
                Case "6"
                    Select Mid(CurrentParity$, counter, 1)
                        Case "0" : Result$ + ",s1,b1,s1,b4"
                        Case "1" : Result$ + ",s4,b1,s1,b1"
                    EndSelect
                Case "7"
                    Select Mid(CurrentParity$, counter, 1)
                        Case "0" : Result$ + ",s1,b3,s1,b2"
                        Case "1" : Result$ + ",s2,b1,s3,b1"
                    EndSelect
                Case "8"
                    Select Mid(CurrentParity$, counter, 1)
                        Case "0" : Result$ + ",s1,b2,s1,b3"
                        Case "1" : Result$ + ",s3,b1,s2,b1"
                    EndSelect
                Case "9"
                    Select Mid(CurrentParity$, counter, 1)
                        Case "0" : Result$ + ",s3,b1,s1,b2"
                        Case "1" : Result$ + ",s2,b1,s1,b3"
                    EndSelect
            EndSelect           
        Next       
        ;
        ;center part
        Result$ + ",s1,b1,s1,b1,s1"
        ;Second part is always Odd
        For counter = 8 To 13
            Char$ = Mid(Text$, counter, 1)
            Select Char$                                     
                Case "0" : Result$ + ",b1,b1,b1,s1,s1,b1,s1"
                Case "1" : Result$ + ",b1,b1,s1,s1,b1,b1,s1"
                Case "2" : Result$ + ",b1,b1,s1,b1,b1,s1,s1"
                Case "3" : Result$ + ",b1,s1,s1,s1,s1,b1,s1"
                Case "4" : Result$ + ",b1,s1,b1,b1,b1,s1,s1"
                Case "5" : Result$ + ",b1,s1,s1,b1,b1,b1,s1"
                Case "6" : Result$ + ",b1,s1,b1,s1,s1,s1,s1"
                Case "7" : Result$ + ",b1,s1,s1,s1,b1,s1,s1"
                Case "8" : Result$ + ",b1,s1,s1,b1,s1,s1,s1"
                Case "9" : Result$ + ",b1,b1,b1,s1,b1,s1,s1"
            EndSelect
        Next       
        ;stop
        Result$ + ",b1,s1,b1,"
    EndIf
   
    ProcedureReturn Result$
EndProcedure                   


;==================================
;==================================
;==================================
Procedure Draw_Barcode(ImageNr.l, Coding.l, Text$, PosX, PosY, BarWidth, BarHeight, Flag.i=#TEXT_NONE)
    If IsImage(ImageNr) 
        If StartDrawing(ImageOutput(ImageNr))
            TextPosX.i = PosX
            ;Get coded text$
            Select Coding
                Case #BARCODE_39 :      Code$ = Get_Barcode39(Text$)
                Case #BARCODE_2of5 :    Code$ = Get_Barcode2of5(Text$)
                Case #BARCODE_93 :      Code$ = Get_Barcode93(Text$)
                Case #BARCODE_EAN :     Code$ = Get_BarcodeEAN(Text$)
                Default :               Code$ = Get_Barcode128(Text$)
            EndSelect       
            ;Barcode
            NbrSquares = CountString(Code$, ",")
            For counter = 1 To NbrSquares
                ThisSquare$ = StringField(Code$, counter, ",")
                Select ThisSquare$
                    Case "b1" : Box(PosX, PosY, BarWidth, BarHeight, #Black) : PosX = PosX + BarWidth
                    Case "b2" : Box(PosX, PosY, BarWidth*2, BarHeight, #Black) : PosX = PosX + (BarWidth*2)
                    Case "b3" : Box(PosX, PosY, BarWidth*3, BarHeight, #Black) : PosX = PosX + (BarWidth*3)
                    Case "b4" : Box(PosX, PosY, BarWidth*4, BarHeight, #Black) : PosX = PosX + (BarWidth*4)
                    Case "s1" : PosX = PosX + BarWidth
                    Case "s2" : PosX = PosX + (BarWidth*2)
                    Case "s3" : PosX = PosX + (BarWidth*3)
                    Case "s4" : PosX = PosX + (BarWidth*4)
                EndSelect
            Next 
            ;Text
            Select Flag
                Case #TEXT_CENTER   
                    DrawingFont(FontID(0))
                    BarcodeLength.l = PosX - TextPosX
                    TextLength.l = TextWidth(DISPLAYTEXT$)
                    NewPosX.l = (BarcodeLength/2) - (TextLength/2)
                    DrawText(TextPosX + NewPosX, PosY+BarHeight, DISPLAYTEXT$, #Black, #White)                     
                Case #TEXT_EAN   
                    DrawingFont(FontID(1))
                    Text$ = Left(DISPLAYTEXT$, 1)
                    TextWidth.l = TextWidth(Text$)
                    TextHeight.l = TextHeight(Text$)
                    NewPosY.l = (PosY+BarHeight) - (TextHeight/2)
                    DrawText(TextPosX - TextWidth, NewPosY, Text$, #Black, #White)   
                    ;
                    Text$ = Mid(DISPLAYTEXT$, 2, 6)
                    DrawText(TextPosX + (BarWidth*4), NewPosY, Text$, #Black, #White)
                    ;
                    Text$ = Right(DISPLAYTEXT$, 6)
                    DrawText(TextPosX + (BarWidth*50), NewPosY, Text$, #Black, #White)
            EndSelect           
            StopDrawing()
        EndIf   
    EndIf
EndProcedure   

;==================================
;==================================
;==================================
If OpenWindow(0, 0, 0, 800, 900, "2DDrawing Example", #PB_Window_SystemMenu|#PB_Window_ScreenCentered)
    BARWIDTH = 2 
    If CreateImage(0, 800, 900, 24, #White)
        FONT_DEFAULT= LoadFont(0, "Arial", 7*BARWIDTH)
        FONT_EAN.i = LoadFont(1, "Arial", 8*BARWIDTH)
        Draw_Barcode(0, #BARCODE_128, "Barcode 128", 100, 100, BARWIDTH, 50, #TEXT_CENTER)
        Draw_Barcode(0, #BARCODE_39, "BARCODE 39", 100, 250, BARWIDTH, 50, #TEXT_CENTER)
        Draw_Barcode(0, #BARCODE_2of5, "29012019", 100, 400, BARWIDTH, 50, #TEXT_CENTER)
        Draw_Barcode(0, #BARCODE_93, "CODE 93", 100, 550, BARWIDTH, 50, #TEXT_CENTER)
        Draw_Barcode(0, #BARCODE_EAN, "590123412345", 100, 700, BARWIDTH, 100, #TEXT_EAN)
        ImageGadget(1, 0, 0, 800, 600, ImageID(0))
    EndIf
    ;
    Repeat
      Event = WaitWindowEvent()
    Until Event = #PB_Event_CloseWindow
EndIf

Author:  Mindphazer [ Tue Mar 05, 2019 9:30 am ]
Post subject:  Re: Barcode

Nice and crossplatform code !
Very useful to me
Many thanks !

Author:  davido [ Tue Mar 05, 2019 3:03 pm ]
Post subject:  Re: Barcode

@TeddyLM,
Very interesting.
Thank you for sharing.

Author:  Kwai chang caine [ Wed Mar 06, 2019 2:40 pm ]
Post subject:  Re: Barcode

Works nice
Thanks for sharing 8)

Author:  TeddyLM [ Wed Mar 06, 2019 5:54 pm ]
Post subject:  Re: Barcode

I added the variable BARWIDTH so that the fonts are adjusted to the size of the barcode.

TeddyLM

Author:  RSBasic [ Thu Apr 18, 2019 1:57 pm ]
Post subject:  Re: Barcode

Thanks for sharing!

Page 1 of 1 All times are UTC + 1 hour
Powered by phpBB © 2000, 2002, 2005, 2007 phpBB Group
http://www.phpbb.com/