Page 1 of 1

Barcode

Posted: Tue Mar 05, 2019 7:42 am
by TeddyLM

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

TeddyLM

Code: Select all

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

Re: Barcode

Posted: Tue Mar 05, 2019 9:30 am
by Mindphazer
Nice and crossplatform code !
Very useful to me
Many thanks !

Re: Barcode

Posted: Tue Mar 05, 2019 3:03 pm
by davido
@TeddyLM,
Very interesting.
Thank you for sharing.

Re: Barcode

Posted: Wed Mar 06, 2019 2:40 pm
by Kwai chang caine
Works nice
Thanks for sharing 8)

Re: Barcode

Posted: Wed Mar 06, 2019 5:54 pm
by TeddyLM
I added the variable BARWIDTH so that the fonts are adjusted to the size of the barcode.

TeddyLM

Re: Barcode

Posted: Thu Apr 18, 2019 1:57 pm
by RSBasic
Thanks for sharing!