Private Sub CreateBarcode()
Dim X As Integer, Y As Integer, z As Integer, pos As Integer
Dim Barcode As String
Dim Cur As String
Dim CurVal As Integer
Dim BC(43) As String
BC(0) = "000110100" '0
BC(1) = "100100001" '1
BC(2) = "001100001" '2
BC(3) = "101100000" '3
BC(4) = "000110001" '4
BC(5) = "100110000" '5
BC(6) = "001110000" '6
BC(7) = "000100101" '7
BC(8) = "100100100" '8
BC(9) = "001100100" '9
BC(10) = "100001001" 'A
BC(11) = "001001001" 'B
BC(12) = "101001000" 'C
BC(13) = "000011001" 'D
BC(14) = "100011000" 'E
BC(15) = "001011000" 'F
BC(16) = "000001101"
BC(17) = "100001100"
BC(18) = "001001100"
BC(19) = "000011100"
BC(20) = "100000011"
BC(21) = "001000011"
BC(22) = "101000010"
BC(23) = "000010011"
BC(24) = "100010010"
BC(25) = "001010010"
BC(26) = "000000111"
BC(27) = "100000110"
BC(28) = "001000110"
BC(29) = "000010110"
BC(30) = "110000001"
BC(31) = "011000001"
BC(32) = "111000000" 'W
BC(33) = "010010001" 'X
BC(34) = "110010000" 'Y
BC(35) = "011010000" 'Z
BC(36) = "010000101" '-
BC(37) = "110000100" '.
BC(38) = "011000100" '<spc>
BC(39) = "010101000" '$
BC(40) = "010100010" '/
BC(41) = "010001010" '+
BC(42) = "000101010" '%
BC(43) = "010010100" '* (used for start/stop character only)
picBarCode.Cls
pos = 10
Barcode = UCase(FixedItemCode) 'fixeditem code = the charactes in a textbox that is entered and converted to a barcode.
'Add Start & Stop characters
Barcode = "*" & Barcode & "*"
'Generate Barcode
For X = 1 To Len(Barcode)
Cur = Mid$(Barcode, X, 1)
Select Case Cur
Case "0" To "9"
CurVal = Val(Cur)
Case "A" To "Z"
CurVal = Asc(Cur) - 55
Case "-"
CurVal = 36
Case "."
CurVal = 37
Case " "
CurVal = 38
Case "$"
CurVal = 39
Case "/"
CurVal = 40
Case "+"
CurVal = 41
Case "%"
CurVal = 42
Case "*"
CurVal = 43
Case Else 'oops!
picBarCode.Cls
picBarCode.Print Cur & " is Invalid"
Exit Sub
End Select
For Y = 1 To 9
If Y / 2 = Int(Y / 2) Then
'SPACE
pos = pos + 1 + (3 * Val(Mid$(BC(CurVal), Y, 1)))
Else
'BAR
For z = 1 To 1 + (3 * Val(Mid$(BC(CurVal), Y, 1)))
picBarCode.Line (pos, 1)-(pos, 50)
pos = pos + 1
Next z
End If
Next Y
pos = pos + 1 'make inter-character gap (ie: 1 narrow space)
Next X
picBarCode.CurrentX = Len(Barcode) * 7 'kinda center
picBarCode.Print Barcode
SavePicture picBarCode.Image, BarcodePicture