It is currently Sun Dec 15, 2019 12:17 am

All times are UTC + 1 hour




Post new topic Reply to topic  [ 6 posts ] 
Author Message
 Post subject: Barcode
PostPosted: Tue Mar 05, 2019 7:42 am 
Offline
Enthusiast
Enthusiast
User avatar

Joined: Wed Apr 30, 2003 2:04 pm
Posts: 133
Location: Germany (French expat)
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


Last edited by TeddyLM on Wed Mar 06, 2019 5:49 pm, edited 1 time in total.

Top
 Profile  
Reply with quote  
 Post subject: Re: Barcode
PostPosted: Tue Mar 05, 2019 9:30 am 
Offline
Enthusiast
Enthusiast

Joined: Mon Sep 10, 2012 10:41 am
Posts: 124
Location: Savoie
Nice and crossplatform code !
Very useful to me
Many thanks !

_________________
MacBook Pro 13" Retina - 16 Gb - OSX 10.14 - Iphone X - iPad at home
...and unfortunately... Windows at work...


Top
 Profile  
Reply with quote  
 Post subject: Re: Barcode
PostPosted: Tue Mar 05, 2019 3:03 pm 
Offline
Addict
Addict

Joined: Fri Nov 09, 2012 11:04 pm
Posts: 1715
Location: Uttoxeter, UK
@TeddyLM,
Very interesting.
Thank you for sharing.

_________________
DE AA EB


Top
 Profile  
Reply with quote  
 Post subject: Re: Barcode
PostPosted: Wed Mar 06, 2019 2:40 pm 
Offline
Addict
Addict
User avatar

Joined: Sun Nov 05, 2006 11:42 pm
Posts: 4548
Location: Lyon - France
Works nice
Thanks for sharing 8)

_________________
ImageThe happiness is a road...
Not a destination


Top
 Profile  
Reply with quote  
 Post subject: Re: Barcode
PostPosted: Wed Mar 06, 2019 5:54 pm 
Offline
Enthusiast
Enthusiast
User avatar

Joined: Wed Apr 30, 2003 2:04 pm
Posts: 133
Location: Germany (French expat)
I added the variable BARWIDTH so that the fonts are adjusted to the size of the barcode.

TeddyLM


Top
 Profile  
Reply with quote  
 Post subject: Re: Barcode
PostPosted: Thu Apr 18, 2019 1:57 pm 
Offline
Moderator
Moderator
User avatar

Joined: Thu Dec 31, 2009 11:05 pm
Posts: 1109
Location: Berlin (Germany)
Thanks for sharing!

_________________
ImageImageImageImage Image


Top
 Profile  
Reply with quote  
Display posts from previous:  Sort by  
Post new topic Reply to topic  [ 6 posts ] 

All times are UTC + 1 hour


Who is online

Users browsing this forum: No registered users and 7 guests


You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum

Search for:
Jump to:  

 


Powered by phpBB © 2008 phpBB Group
subSilver+ theme by Canver Software, sponsor Sanal Modifiye