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