home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 5_2007-2008.ISO / data / Zips / Pharmacy_22101822142008.psc / Pharmacy / barcode.bas < prev   
BASIC Source File  |  2007-03-16  |  99KB  |  1,930 lines
  1. Attribute VB_Name = "barcode"
  2.  
  3. '*********************************************************************
  4. '*  Visual Basic / VBA Functions for Bar Code Fonts 5.01
  5. '*  Copyright, IDAutomation.com, Inc. 2000-2005. All rights reserved.
  6. '*
  7. '*  Visit http://www.idautomation.com/fonts/tools/vba/ for more
  8. '*  information about the functions in this file.
  9. '*
  10. '*  You may incorporate our Source Code in your application
  11. '*  only if you own a valid license from IDAutomation.com, Inc.
  12. '*  for the associated font and this text and the copyright notices
  13. '*  are not removed from the source code.
  14. '*
  15. '*  Distributing our source code or fonts outside your
  16. '*  organization requires a Developer License.
  17. '*********************************************************************
  18.  
  19. 'START OF DECLARACTIONS
  20. Private I As Integer
  21. Private F As Integer
  22. Private DataToPrint As String
  23. Private DataToEncode As String
  24. Private OnlyCorrectData As String
  25. Private PrintableString As String
  26. Private Encoding As String
  27. Private WeightedTotal As Long
  28. Private WeightValue As Integer
  29. Private CurrentValue As Long
  30. Private CheckDigitValue As Integer
  31. Private Factor As Integer
  32. Private CheckDigit As Integer
  33. Private CurrentEncoding As String
  34. Private NewLine As String
  35. Private msg As String
  36. Private CurrentChar As String
  37. Private CurrentCharNum As Integer
  38. Private C128_StartA As String
  39. Private C128_StartB As String
  40. Private C128_StartC As String
  41. Private C128_Stop As String
  42. Private C128Start As String
  43. Private C128CheckDigit As String
  44. Private StartCode As String
  45. Private StopCode As String
  46. Private Fnc1 As String
  47. Private LeadingDigit As Integer
  48. Private EAN2AddOn As String
  49. Private EAN5AddOn As String
  50. Private EANAddOnToPrint As String
  51. Private HumanReadableText As String
  52. Private StringLength As Integer
  53. Private CorrectFNC As Integer
  54. 'END OF DECLARACTIONS
  55.  
  56.  
  57. Public Function Code128(DataToFormat As String, Optional ReturnType As Integer, Optional ApplyTilde As Boolean) As String
  58. '*********************************************************************
  59. '*  Visual Basic / VBA Functions for Bar Code Fonts 5.01
  60. '*  Copyright, IDAutomation.com, Inc. 2000-2005. All rights reserved.
  61. '*
  62. '*  Visit http://www.idautomation.com/fonts/tools/vba/ for more
  63. '*  information about the functions in this file.
  64. '*
  65. '*  You may incorporate our Source Code in your application
  66. '*  only if you own a valid license from IDAutomation.com, Inc.
  67. '*  for the associated font and this text and the copyright notices
  68. '*  are not removed from the source code.
  69. '*
  70. '*  Distributing our source code or fonts outside your
  71. '*  organization requires a Developer License.
  72. '*********************************************************************
  73.     CorrectFNC = 0
  74.     PrintableString = ""
  75.     
  76.     'Additional logic needed in case ReturnType is not entered
  77.     If ReturnType <> 0 And ReturnType <> 1 And ReturnType <> 2 Then ReturnType = 0
  78.     
  79.     'Additions for ApplyTilde 2-11-2005
  80.     'in case ApplyTilde is null, set it to false
  81.     If ApplyTilde <> True Then ApplyTilde = False
  82.     
  83.     If ApplyTilde Then
  84.         DataToEncode = DataToFormat
  85.         DataToFormat = ""
  86.         OnlyCorrectData = ""
  87.         StringLength = Len(DataToEncode)
  88.         For I = 1 To StringLength
  89.             If (I < StringLength - 2) And Mid(DataToEncode, I, 2) = "~m" And IsNumeric(Mid(DataToEncode, I + 2, 2)) Then
  90.                 WeightValue = Val(Mid(DataToEncode, I + 2, 2))
  91.                 If (I - WeightValue) < 1 Then WeightValue = I - 1
  92.                 CheckDigitValue = MOD10(Mid(DataToEncode, I - WeightValue, WeightValue))
  93.                 OnlyCorrectData = OnlyCorrectData & ChrW(CheckDigitValue + 48)
  94.                 I = I + 3
  95.             ElseIf (I < StringLength - 2) And Mid(DataToEncode, I, 1) = "~" And IsNumeric(Mid(DataToEncode, I + 1, 3)) Then
  96.                 CurrentCharNum = Val(Mid(DataToEncode, I + 1, 3))
  97.                 OnlyCorrectData = OnlyCorrectData & ChrW(CurrentCharNum)
  98.                 I = I + 3
  99.             Else
  100.                OnlyCorrectData = OnlyCorrectData & Mid(DataToEncode, I, 1)
  101.             End If
  102.         Next I
  103.         DataToFormat = OnlyCorrectData
  104.         DataToEncode = ""
  105.     End If
  106.     
  107.     'Here we select character set A, B or C for the START character
  108.     StringLength = Len(DataToFormat)
  109.     CurrentCharNum = AscW(Mid(DataToFormat, 1, 1))
  110.     If CurrentCharNum < 32 Then C128Start = ChrW(203)
  111.     If CurrentCharNum > 31 And CurrentCharNum < 127 Then C128Start = ChrW(204)
  112.     If CurrentCharNum = 197 Then C128Start = ChrW(204) 'Added 2-18-05 for FNC2
  113.     If ((StringLength > 4) And IsNumeric(Mid(DataToFormat, 1, 4))) Then C128Start = ChrW(205)
  114.     '202 & 212-215 is for the FNC1, with this Start C is mandatory
  115.     If CurrentCharNum = 202 Then C128Start = ChrW(205)
  116.     If CurrentCharNum = 212 Then C128Start = ChrW(205)
  117.     If CurrentCharNum = 213 Then C128Start = ChrW(205)
  118.     If CurrentCharNum = 214 Then C128Start = ChrW(205)
  119.     If CurrentCharNum = 215 Then C128Start = ChrW(205)
  120.     If C128Start = ChrW(203) Then CurrentEncoding = "A"
  121.     If C128Start = ChrW(204) Then CurrentEncoding = "B"
  122.     If C128Start = ChrW(205) Then CurrentEncoding = "C"
  123.     For I = 1 To StringLength
  124.     
  125.         'Added 2-18-05 for FNC2 / check for FNC2 which is ASCII 197 in any set other than C
  126.         If (CurrentCharNum = 197) Then
  127.             If CurrentEncoding = "C" Then 'switch to B
  128.                 DataToEncode = DataToEncode & ChrW(200)
  129.                 CurrentEncoding = "B"
  130.             End If
  131.             DataToEncode = DataToEncode & ChrW(197)
  132.             I = I + 1
  133.         End If
  134.     
  135.         'check for FNC1 in any set which is ASCII 202 and ASCII 212-215
  136.         CurrentCharNum = AscW(Mid(DataToFormat, I, 1))
  137.         If ((CurrentCharNum = 202) Or (CurrentCharNum = 212) Or (CurrentCharNum = 213) Or (CurrentCharNum = 214) Or (CurrentCharNum = 215)) Then
  138.             DataToEncode = DataToEncode & ChrW(202)
  139.         'check for switching to character set C
  140.         ElseIf ((I < StringLength - 2) And (IsNumeric(Mid(DataToFormat, I, 1))) And (IsNumeric(Mid(DataToFormat, I + 1, 1))) And (IsNumeric(Mid(DataToFormat, I, 4)))) Or ((I < StringLength) And (IsNumeric(Mid(DataToFormat, I, 1))) And (IsNumeric(Mid(DataToFormat, I + 1, 1))) And (CurrentEncoding = "C")) Then
  141.         'switch to set C if not already in it
  142.             If CurrentEncoding <> "C" Then DataToEncode = DataToEncode & ChrW(199)
  143.             CurrentEncoding = "C"
  144.             CurrentChar = (Mid(DataToFormat, I, 2))
  145.             CurrentValue = CInt(CurrentChar)
  146.         'set the CurrentValue to the number of String CurrentChar
  147.             If (CurrentValue < 95 And CurrentValue > 0) Then DataToEncode = DataToEncode & ChrW(CurrentValue + 32)
  148.             If CurrentValue > 94 Then DataToEncode = DataToEncode & ChrW(CurrentValue + 100)
  149.             If CurrentValue = 0 Then DataToEncode = DataToEncode & ChrW(194)
  150.             I = I + 1
  151.         'check for switching to character set A
  152.         ElseIf (I <= StringLength) And ((AscW(Mid(DataToFormat, I, 1)) < 31) Or ((CurrentEncoding = "A") And (AscW(Mid(DataToFormat, I, 1)) > 32 And (AscW(Mid(DataToFormat, I, 1))) < 96))) Then
  153.         'switch to set A if not already in it
  154.             If CurrentEncoding <> "A" Then DataToEncode = DataToEncode & ChrW(201)
  155.             CurrentEncoding = "A"
  156.         'Get the ASCII value of the next character
  157.             CurrentCharNum = AscW(Mid(DataToFormat, I, 1))
  158.             If CurrentCharNum = 32 Then
  159.                 DataToEncode = DataToEncode & ChrW(194)
  160.             ElseIf CurrentCharNum < 32 Then
  161.                 DataToEncode = DataToEncode & ChrW(CurrentCharNum + 96)
  162.             ElseIf CurrentCharNum > 32 Then
  163.                 DataToEncode = DataToEncode & ChrW(CurrentCharNum)
  164.             End If
  165.         'check for switching to character set B
  166.         ElseIf (I <= StringLength) And ((AscW(Mid(DataToFormat, I, 1))) > 31 And (AscW(Mid(DataToFormat, I, 1)))) < 127 Then
  167.         'switch to set B if not already in it
  168.             If CurrentEncoding <> "B" Then DataToEncode = DataToEncode & ChrW(200)
  169.             CurrentEncoding = "B"
  170.         'Get the ASCII value of the next character
  171.             CurrentCharNum = (AscW(Mid(DataToFormat, I, 1)))
  172.             If CurrentCharNum = 32 Then
  173.                 DataToEncode = DataToEncode & ChrW(194)
  174.             Else
  175.                 DataToEncode = DataToEncode & ChrW(CurrentCharNum)
  176.             End If
  177.         End If
  178.     Next I
  179.     
  180.     HumanReadableText = ""
  181. 'FORMAT TEXT FOR AIs
  182.     StringLength = Len(DataToFormat)
  183.     For I = 1 To StringLength
  184.     CorrectFNC = 0
  185.     'Get ASCII value of each character
  186.         CurrentCharNum = AscW(Mid(DataToFormat, I, 1))
  187.     'Check for FNC1
  188.         If ((I < StringLength - 2) And ((CurrentCharNum = 202) Or ((CurrentCharNum > 211) And (CurrentCharNum < 219)))) Then
  189.         'It appears that there is an AI
  190.         'Get the value of each number pair (ex: 5 and 6 = 5*10+6 =56)
  191.             CurrentChar = (Mid(DataToFormat, I + 1, 2))
  192.             CurrentCharNum = CInt(CurrentChar)
  193.         'Is 2 digit AI by entering ASCII 212?
  194.             If ((CorrectFNC = 0) And (AscW(Mid(DataToFormat, I, 1)) = 212)) Then
  195.                 HumanReadableText = HumanReadableText & " (" & (Mid(DataToFormat, I + 1, 2)) & ") "
  196.                 I = I + 2
  197.                 CorrectFNC = 1
  198.         'Is 3 digit AI by entering ASCII 213?
  199.             ElseIf ((I < StringLength - 3) And (CorrectFNC = 0) And (AscW(Mid(DataToFormat, I, 1)) = 213)) Then
  200.                 HumanReadableText = HumanReadableText & " (" & (Mid(DataToFormat, I + 1, 3)) & ") "
  201.                 I = I + 3
  202.                 CorrectFNC = 1
  203.         'Is 4 digit AI by entering ASCII 214?
  204.             ElseIf ((I < StringLength - 4) And (CorrectFNC = 0) And (AscW(Mid(DataToFormat, I, 1)) = 214)) Then
  205.                 HumanReadableText = HumanReadableText & " (" & (Mid(DataToFormat, I + 1, 4)) & ") "
  206.                 I = I + 4
  207.                 CorrectFNC = 1
  208.         'Is 5 digit AI by entering ASCII 215?
  209.             ElseIf ((I < StringLength - 5) And (CorrectFNC = 0) And (AscW(Mid(DataToFormat, I, 1)) = 215)) Then
  210.                 HumanReadableText = HumanReadableText & " (" & (Mid(DataToFormat, I + 1, 5)) & ") "
  211.                 I = I + 5
  212.                 CorrectFNC = 1
  213.         'Is 6 digit AI by entering ASCII 216?
  214.             ElseIf ((I < StringLength - 6) And (CorrectFNC = 0) And (AscW(Mid(DataToFormat, I, 1)) = 216)) Then
  215.                 HumanReadableText = HumanReadableText & " (" & (Mid(DataToFormat, I + 1, 6)) & ") "
  216.                 I = I + 6
  217.                 CorrectFNC = 1
  218.         'Is 7 digit AI by entering ASCII 217?
  219.             ElseIf ((I < StringLength - 7) And (CorrectFNC = 0) And (AscW(Mid(DataToFormat, I, 1)) = 217)) Then
  220.                 HumanReadableText = HumanReadableText & " (" & (Mid(DataToFormat, I + 1, 7)) & ") "
  221.                 I = I + 7
  222.                 CorrectFNC = 1
  223.         'Is 8 digit AI by entering ASCII 218?
  224.             ElseIf ((I < StringLength - 8) And (CorrectFNC = 0) And (AscW(Mid(DataToFormat, I, 1)) = 218)) Then
  225.                 HumanReadableText = HumanReadableText & " (" & (Mid(DataToFormat, I + 1, 8)) & ") "
  226.                 I = I + 8
  227.                 CorrectFNC = 1
  228.         'Is 4 digit AI by detection?
  229.             ElseIf ((I < StringLength - 4) And (CorrectFNC = 0) And ((CurrentCharNum <= 81 And CurrentCharNum >= 80) Or (CurrentCharNum <= 34 And CurrentCharNum >= 31))) Then
  230.                 HumanReadableText = HumanReadableText & " (" & (Mid(DataToFormat, I + 1, 4)) & ") "
  231.                 I = I + 4
  232.                 CorrectFNC = 1
  233.         'Is 3 digit AI by detection?
  234.             ElseIf ((I < StringLength - 3) And (CorrectFNC = 0) And ((CurrentCharNum <= 49 And CurrentCharNum >= 40) Or (CurrentCharNum <= 25 And CurrentCharNum >= 23))) Then
  235.                 HumanReadableText = HumanReadableText & " (" & (Mid(DataToFormat, I + 1, 3)) & ") "
  236.                 I = I + 3
  237.                 CorrectFNC = 1
  238.         'Is 2 digit AI by detection?
  239.             ElseIf ((CurrentCharNum <= 30 And (CorrectFNC = 0) And CurrentCharNum >= 0) Or (CurrentCharNum <= 99 And CurrentCharNum >= 90)) Then
  240.                 HumanReadableText = HumanReadableText & " (" & (Mid(DataToFormat, I + 1, 2)) & ") "
  241.                 I = I + 2
  242.                 CorrectFNC = 1
  243.         'If no AI was detected, set default to 4 digit AI:
  244.             ElseIf ((I < StringLength - 4) And (CorrectFNC = 0)) Then
  245.                 HumanReadableText = HumanReadableText & " (" & (Mid(DataToFormat, I + 1, 4)) & ") "
  246.                 I = I + 4
  247.                 CorrectFNC = 1
  248.             End If
  249.         ElseIf (AscW(Mid(DataToFormat, I, 1)) < 32) Then
  250.             HumanReadableText = HumanReadableText & " "
  251.         ElseIf ((AscW(Mid(DataToFormat, I, 1)) > 31) And (AscW(Mid(DataToFormat, I, 1)) < 128)) Then
  252.             HumanReadableText = HumanReadableText & Mid(DataToFormat, I, 1)
  253.         End If
  254.     Next I
  255.     DataToFormat = ""
  256.     '<<<< Calculate Modulo 103 Check Digit >>>>
  257.     WeightedTotal = AscW(C128Start) - 100
  258.     StringLength = Len(DataToEncode)
  259.     For I = 1 To StringLength
  260.         CurrentCharNum = AscW(Mid(DataToEncode, I, 1))
  261.         If CurrentCharNum < 135 Then CurrentValue = CurrentCharNum - 32
  262.         If CurrentCharNum > 134 Then CurrentValue = CurrentCharNum - 100
  263.         If CurrentCharNum = 194 Then CurrentValue = 0
  264.         CurrentValue = CurrentValue * I
  265.         WeightedTotal = WeightedTotal + CurrentValue
  266.         If CurrentCharNum = 32 Then CurrentCharNum = 194
  267.         PrintableString = PrintableString & ChrW(CurrentCharNum)
  268.     Next I
  269.     CheckDigitValue = (WeightedTotal Mod 103)
  270.     If CheckDigitValue < 95 And CheckDigitValue > 0 Then C128CheckDigit = ChrW(CheckDigitValue + 32)
  271.     If CheckDigitValue > 94 Then C128CheckDigit = ChrW(CheckDigitValue + 100)
  272.     If CheckDigitValue = 0 Then C128CheckDigit = ChrW(194)
  273.     DataToEncode = ""
  274.     'ReturnType 0 returns data formatted to the barcode font
  275.     If ReturnType = 0 Then Code128 = C128Start & PrintableString & C128CheckDigit & ChrW(206) & " "
  276.     'ReturnType 1 returns data formatted for human readable text
  277.     If ReturnType = 1 Then Code128 = HumanReadableText
  278.     'ReturnType 2 returns the check digit for the data supplied
  279.     If ReturnType = 2 Then Code128 = C128CheckDigit
  280. End Function
  281.  
  282.  
  283.  
  284. Public Function Code128a(DataToEncode As String) As String
  285. '*********************************************************************
  286. '*  Visual Basic / VBA Functions for Bar Code Fonts 5.01
  287. '*  Copyright, IDAutomation.com, Inc. 2000-2005. All rights reserved.
  288. '*
  289. '*  Visit http://www.idautomation.com/fonts/tools/vba/ for more
  290. '*  information about the functions in this file.
  291. '*
  292. '*  You may incorporate our Source Code in your application
  293. '*  only if you own a valid license from IDAutomation.com, Inc.
  294. '*  for the associated font and this text and the copyright notices
  295. '*  are not removed from the source code.
  296. '*
  297. '*  Distributing our source code or fonts outside your
  298. '*  organization requires a Developer License.
  299. '*********************************************************************
  300.      PrintableString = ""
  301.      WeightedTotal = 103
  302.      PrintableString = ChrW(203)
  303.      StringLength = Len(DataToEncode)
  304.      For I = 1 To StringLength
  305.           CurrentCharNum = AscW(Mid(DataToEncode, I, 1))
  306.           If CurrentCharNum < 135 Then CurrentValue = CurrentCharNum - 32
  307.           If CurrentCharNum > 134 Then CurrentValue = CurrentCharNum - 100
  308.           CurrentValue = CurrentValue * I
  309.           WeightedTotal = WeightedTotal + CurrentValue
  310.           If CurrentCharNum = 32 Then CurrentCharNum = 194
  311.           PrintableString = PrintableString & ChrW(CurrentCharNum)
  312.      Next I
  313.      CheckDigitValue = (WeightedTotal Mod 103)
  314.      If CheckDigitValue < 95 And CheckDigitValue > 0 Then C128CheckDigit = ChrW(CheckDigitValue + 32)
  315.      If CheckDigitValue > 94 Then C128CheckDigit = ChrW(CheckDigitValue + 100)
  316.      If CheckDigitValue = 0 Then C128CheckDigit = ChrW(194)
  317.      PrintableString = PrintableString & C128CheckDigit & ChrW(206) & " "
  318.      Code128a = PrintableString
  319. End Function
  320.  
  321.  
  322.  
  323. Public Function Code128b(DataToEncode As String) As String
  324. '*********************************************************************
  325. '*  Visual Basic / VBA Functions for Bar Code Fonts 5.01
  326. '*  Copyright, IDAutomation.com, Inc. 2000-2005. All rights reserved.
  327. '*
  328. '*  Visit http://www.idautomation.com/fonts/tools/vba/ for more
  329. '*  information about the functions in this file.
  330. '*
  331. '*  You may incorporate our Source Code in your application
  332. '*  only if you own a valid license from IDAutomation.com, Inc.
  333. '*  for the associated font and this text and the copyright notices
  334. '*  are not removed from the source code.
  335. '*
  336. '*  Distributing our source code or fonts outside your
  337. '*  organization requires a Developer License.
  338. '*********************************************************************
  339.      PrintableString = ""
  340.      WeightedTotal = 104
  341.      PrintableString = ChrW(204)
  342.      StringLength = Len(DataToEncode)
  343.      For I = 1 To StringLength
  344.           CurrentCharNum = AscW(Mid(DataToEncode, I, 1))
  345.           If CurrentCharNum < 135 Then CurrentValue = CurrentCharNum - 32
  346.           If CurrentCharNum > 134 Then CurrentValue = CurrentCharNum - 100
  347.           CurrentValue = CurrentValue * I
  348.           WeightedTotal = WeightedTotal + CurrentValue
  349.           If CurrentCharNum = 32 Then CurrentCharNum = 194
  350.           PrintableString = PrintableString & ChrW(CurrentCharNum)
  351.      Next I
  352.      CheckDigitValue = (WeightedTotal Mod 103)
  353.      If CheckDigitValue < 95 And CheckDigitValue > 0 Then C128CheckDigit = ChrW(CheckDigitValue + 32)
  354.      If CheckDigitValue > 94 Then C128CheckDigit = ChrW(CheckDigitValue + 100)
  355.      If CheckDigitValue = 0 Then C128CheckDigit = ChrW(194)
  356.      PrintableString = PrintableString & C128CheckDigit & ChrW(206) & " "
  357.      Code128b = PrintableString
  358. End Function
  359.  
  360.  
  361. Public Function Code128c(DataToEncode As String, Optional ReturnType As Integer) As String
  362. '*********************************************************************
  363. '*  Visual Basic / VBA Functions for Bar Code Fonts 5.01
  364. '*  Copyright, IDAutomation.com, Inc. 2000-2005. All rights reserved.
  365. '*
  366. '*  Visit http://www.idautomation.com/fonts/tools/vba/ for more
  367. '*  information about the functions in this file.
  368. '*
  369. '*  You may incorporate our Source Code in your application
  370. '*  only if you own a valid license from IDAutomation.com, Inc.
  371. '*  for the associated font and this text and the copyright notices
  372. '*  are not removed from the source code.
  373. '*
  374. '*  Distributing our source code or fonts outside your
  375. '*  organization requires a Developer License.
  376. '*********************************************************************
  377.     'Additional logic needed in case ReturnType is not entered
  378.      If ReturnType <> 0 And ReturnType <> 1 And ReturnType <> 2 Then ReturnType = 0
  379.      PrintableString = ""
  380.      OnlyCorrectData = ""
  381.      StringLength = Len(DataToEncode)
  382.      For I = 1 To StringLength
  383.           If IsNumeric(Mid(DataToEncode, I, 1)) Then OnlyCorrectData = OnlyCorrectData & Mid(DataToEncode, I, 1)
  384.      Next I
  385.      DataToEncode = OnlyCorrectData
  386.      If (Len(DataToEncode) Mod 2) = 1 Then DataToEncode = "0" & DataToEncode
  387.      PrintableString = ChrW(205)
  388.      WeightedTotal = 105
  389.      WeightValue = 1
  390.      StringLength = Len(DataToEncode)
  391.      For I = 1 To StringLength Step 2
  392.           CurrentValue = CInt(Mid(DataToEncode, I, 2))
  393.           If CurrentValue < 95 And CurrentValue > 0 Then PrintableString = PrintableString & ChrW(CurrentValue + 32)
  394.           If CurrentValue > 94 Then PrintableString = PrintableString & ChrW(CurrentValue + 100)
  395.           If CurrentValue = 0 Then PrintableString = PrintableString & ChrW(194)
  396.           CurrentValue = CurrentValue * WeightValue
  397.           WeightedTotal = WeightedTotal + CurrentValue
  398.           WeightValue = WeightValue + 1
  399.      Next I
  400.      CheckDigitValue = (WeightedTotal Mod 103)
  401.      If CheckDigitValue < 95 And CheckDigitValue > 0 Then C128CheckDigit = ChrW(CheckDigitValue + 32)
  402.      If CheckDigitValue > 94 Then C128CheckDigit = ChrW(CheckDigitValue + 100)
  403.      If CheckDigitValue = 0 Then C128CheckDigit = ChrW(194)
  404.      If ReturnType = 0 Then Code128c = PrintableString & C128CheckDigit & ChrW(206) & " "
  405.      If ReturnType = 1 Then Code128c = DataToEncode & CheckDigitValue
  406.      If ReturnType = 2 Then Code128c = Str(CheckDigitValue)
  407. End Function
  408.  
  409.  
  410. Public Function I2of5(DataToEncode As String) As String
  411. '*********************************************************************
  412. '*  Visual Basic / VBA Functions for Bar Code Fonts 5.01
  413. '*  Copyright, IDAutomation.com, Inc. 2000-2005. All rights reserved.
  414. '*
  415. '*  Visit http://www.idautomation.com/fonts/tools/vba/ for more
  416. '*  information about the functions in this file.
  417. '*
  418. '*  You may incorporate our Source Code in your application
  419. '*  only if you own a valid license from IDAutomation.com, Inc.
  420. '*  for the associated font and this text and the copyright notices
  421. '*  are not removed from the source code.
  422. '*
  423. '*  Distributing our source code or fonts outside your
  424. '*  organization requires a Developer License.
  425. '*********************************************************************
  426.  
  427.      DataToPrint = ""
  428.      DataToEncode = RTrim(LTrim(DataToEncode))
  429. ' Check to make sure data is numeric and remove dashes, etc.
  430.      OnlyCorrectData = ""
  431.      StringLength = Len(DataToEncode)
  432.      For I = 1 To StringLength
  433.     'Add all numbers to OnlyCorrectData string
  434.           If IsNumeric(Mid(DataToEncode, I, 1)) Then OnlyCorrectData = OnlyCorrectData & Mid(DataToEncode, I, 1)
  435.      Next I
  436.      DataToEncode = OnlyCorrectData
  437. 'Check for an even number of digits, add 0 if not even
  438.      If (Len(DataToEncode) Mod 2) = 1 Then DataToEncode = "0" & DataToEncode
  439. 'Assign start and stop codes
  440.      StartCode = ChrW(203)
  441.      StopCode = ChrW(204)
  442.      StringLength = Len(DataToEncode)
  443.      For I = 1 To StringLength Step 2
  444.     'Get the value of each number pair
  445.           CurrentCharNum = Val((Mid(DataToEncode, I, 2)))
  446.     'Get the ASCII value of CurrentChar according to chart by to the value
  447.           If CurrentCharNum < 94 Then DataToPrint = DataToPrint & ChrW(CurrentCharNum + 33)
  448.           If CurrentCharNum > 93 Then DataToPrint = DataToPrint & ChrW(CurrentCharNum + 103)
  449.      Next I
  450. 'Get Printable String
  451.      PrintableString = StartCode + DataToPrint + StopCode & " "
  452. 'Return PrintableString
  453.      I2of5 = PrintableString
  454. End Function
  455.  
  456.  
  457.  
  458. Public Function USPS_EAN128(DataToEncode As String, Optional ReturnType As Integer) As String
  459. '*********************************************************************
  460. '*  Visual Basic / VBA Functions for Bar Code Fonts 5.01
  461. '*  Copyright, IDAutomation.com, Inc. 2000-2005. All rights reserved.
  462. '*
  463. '*  Visit http://www.idautomation.com/fonts/tools/vba/ for more
  464. '*  information about the functions in this file.
  465. '*
  466. '*  You may incorporate our Source Code in your application
  467. '*  only if you own a valid license from IDAutomation.com, Inc.
  468. '*  for the associated font and this text and the copyright notices
  469. '*  are not removed from the source code.
  470. '*
  471. '*  Distributing our source code or fonts outside your
  472. '*  organization requires a Developer License.
  473. '*********************************************************************
  474. '
  475. ' Used for 22 digit USPS special services labels such as delivery confirmation in
  476. ' EAN128 with Code 128 fonts. This new EAN128 format is mandatory as of
  477. ' January 10, 2004 according to the USPS Delivery Confirmation Service
  478. ' defined in the September 2002 version of Publication 91. Enter a 19 or
  479. ' 20 digit number; only the first 19 are used. This number is made up of
  480. ' the following:  2 digit service code + 9 digit customer ID + 8 digit
  481. ' sequential package ID + MOD 10 check digit that can be calculated by
  482. ' this function if excluded. In this function, the application identifier
  483. ' of 91 is automatically added for you.
  484. '
  485. ' Other USPS EAN128 barcode types must be created by calling Code128() with the appropriate
  486. ' ASCII 0202 and AIs included as documented at:
  487. ' http://www.idautomation.com/code128faq.html#EAN128andUCC128
  488. '
  489. ' Check to make sure data is numeric and remove dashes, etc.
  490.      'Additional logic needed in case ReturnType is not entered
  491.      If ReturnType <> 0 And ReturnType <> 1 And ReturnType <> 2 Then ReturnType = 0
  492.      OnlyCorrectData = ""
  493.      Dim DataForCheck As String
  494.      StringLength = Len(DataToEncode)
  495.      For I = 1 To StringLength
  496.     'Add all numbers to OnlyCorrectData string
  497.           If IsNumeric(Mid(DataToEncode, I, 1)) Then OnlyCorrectData = OnlyCorrectData & Mid(DataToEncode, I, 1)
  498.      Next I
  499. 'Remove check digits and (AI) if they were added to input
  500.      If Len(OnlyCorrectData) > "19" Then OnlyCorrectData = (Mid(OnlyCorrectData, 1, 19))
  501. 'End sub if incorrect number
  502.      If Len(OnlyCorrectData) <> "19" Then OnlyCorrectData = "0000000000000000000"
  503. 'Add in the AI of 91
  504.      DataToEncode = "91" & OnlyCorrectData
  505. 'Get the MOD 10 Check Digit
  506.      CheckDigit = MOD10(DataToEncode)
  507. 'Now that we have calculated the MOD 10 for the data, send the string
  508. 'to the Code128() funtion. This function will:
  509. ' - Add in the start and stop codes
  510. ' - Add in the AI and START C
  511. ' - Calculate the MOD 103 required when using Code 128
  512. ' - Interleave the numbers into printable characters
  513. 'ReturnType 0 returns data formatted to the barcode font
  514.      If ReturnType = 0 Then USPS_EAN128 = Code128(ChrW(202) & DataToEncode & CheckDigit, 0)
  515. 'ReturnType 1 returns data formatted for human readable text
  516.      If ReturnType = 1 Then USPS_EAN128 = Mid(DataToEncode, 1, 4) & " " & Mid(DataToEncode, 5, 4) & " " & Mid(DataToEncode, 9, 4) & " " & Mid(DataToEncode, 13, 4) & " " & Mid(DataToEncode, 17, 4) & " " & Mid(DataToEncode, 21, 1) & CheckDigit
  517. 'ReturnType 2 returns the MOD10 check digit for the data supplied
  518.      If ReturnType = 2 Then USPS_EAN128 = Str(CheckDigit)
  519. End Function
  520.  
  521.  
  522. Public Function Code39Mod43(DataToEncode As String, Optional ReturnType As Integer) As String
  523. '*********************************************************************
  524. '*  Visual Basic / VBA Functions for Bar Code Fonts 5.01
  525. '*  Copyright, IDAutomation.com, Inc. 2000-2005. All rights reserved.
  526. '*
  527. '*  Visit http://www.idautomation.com/fonts/tools/vba/ for more
  528. '*  information about the functions in this file.
  529. '*
  530. '*  You may incorporate our Source Code in your application
  531. '*  only if you own a valid license from IDAutomation.com, Inc.
  532. '*  for the associated font and this text and the copyright notices
  533. '*  are not removed from the source code.
  534. '*
  535. '*  Distributing our source code or fonts outside your
  536. '*  organization requires a Developer License.
  537. '*********************************************************************
  538.      'DataToEncode = RTrim(DataToEncode)
  539.      'Additional logic needed in case ReturnType is not entered
  540.      If ReturnType <> 0 And ReturnType <> 1 And ReturnType <> 2 Then ReturnType = 0
  541.      DataToEncode = UCase(DataToEncode)
  542.      DataToPrint = ""
  543.      OnlyCorrectData = ""
  544. 'only pass correct data
  545.      StringLength = Len(DataToEncode)
  546.      For I = 1 To StringLength
  547.     'Get each character one at a time
  548.           CurrentCharNum = (AscW(Mid(DataToEncode, I, 1)))
  549.     'Get the value of CurrentChar according to MOD43
  550.     '0-9
  551.           If CurrentCharNum < 58 And CurrentCharNum > 47 Then OnlyCorrectData = OnlyCorrectData & Mid(DataToEncode, I, 1)
  552.     'A-Z
  553.           If CurrentCharNum < 91 And CurrentCharNum > 64 Then OnlyCorrectData = OnlyCorrectData & Mid(DataToEncode, I, 1)
  554.     'Space
  555.           If CurrentCharNum = 32 Then OnlyCorrectData = OnlyCorrectData & Mid(DataToEncode, I, 1)
  556.     '-
  557.           If CurrentCharNum = 45 Then OnlyCorrectData = OnlyCorrectData & Mid(DataToEncode, I, 1)
  558.     '.
  559.           If CurrentCharNum = 46 Then OnlyCorrectData = OnlyCorrectData & Mid(DataToEncode, I, 1)
  560.     '$
  561.           If CurrentCharNum = 36 Then OnlyCorrectData = OnlyCorrectData & Mid(DataToEncode, I, 1)
  562.     '/
  563.           If CurrentCharNum = 47 Then OnlyCorrectData = OnlyCorrectData & Mid(DataToEncode, I, 1)
  564.     '+
  565.           If CurrentCharNum = 43 Then OnlyCorrectData = OnlyCorrectData & Mid(DataToEncode, I, 1)
  566.     '%
  567.           If CurrentCharNum = 37 Then OnlyCorrectData = OnlyCorrectData & Mid(DataToEncode, I, 1)
  568.      Next I
  569.      DataToEncode = OnlyCorrectData
  570.      WeightedTotal = 0
  571.      StringLength = Len(DataToEncode)
  572.      For I = 1 To StringLength
  573.     'Get each character one at a time
  574.           CurrentCharNum = (AscW(Mid(DataToEncode, I, 1)))
  575.     'Get the value of CurrentChar according to MOD43
  576.     '0-9
  577.           If CurrentCharNum < 58 And CurrentCharNum > 47 Then CurrentValue = CurrentCharNum - 48
  578.     'A-Z
  579.           If CurrentCharNum < 91 And CurrentCharNum > 64 Then CurrentValue = CurrentCharNum - 55
  580.     'Space
  581.           If CurrentCharNum = 32 Then CurrentValue = 38
  582.     '-
  583.           If CurrentCharNum = 45 Then CurrentValue = 36
  584.     '.
  585.           If CurrentCharNum = 46 Then CurrentValue = 37
  586.     '$
  587.           If CurrentCharNum = 36 Then CurrentValue = 39
  588.     '/
  589.           If CurrentCharNum = 47 Then CurrentValue = 40
  590.     '+
  591.           If CurrentCharNum = 43 Then CurrentValue = 41
  592.     '%
  593.           If CurrentCharNum = 37 Then CurrentValue = 42
  594.     'To print the barcode symbol representing a space you will
  595.     'to type or print "=" (the equal character) instead of a space character.
  596.           If CurrentCharNum = 32 Then CurrentCharNum = 61
  597.     'gather data to print
  598.           DataToPrint = DataToPrint & ChrW(CurrentCharNum)
  599.     'add the values together
  600.           WeightedTotal = WeightedTotal + CurrentValue
  601.      Next I
  602. 'divide the WeightedTotal by 43 and get the remainder, this is the CheckDigit
  603.      CheckDigitValue = (WeightedTotal Mod 43)
  604.     'Assign values to characters
  605.     '0-9
  606.      If CheckDigitValue < 10 Then CheckDigit = CheckDigitValue + 48
  607.     'A-Z
  608.      If CheckDigitValue < 36 And CheckDigitValue > 9 Then CheckDigit = CheckDigitValue + 55
  609.     'Space
  610.      If CheckDigitValue = 38 Then CheckDigit = 61
  611.     '-
  612.      If CheckDigitValue = 36 Then CheckDigit = 45
  613.     '.
  614.      If CheckDigitValue = 37 Then CheckDigit = 46
  615.     '$
  616.      If CheckDigitValue = 39 Then CheckDigit = 36
  617.     '/
  618.      If CheckDigitValue = 40 Then CheckDigit = 47
  619.     '+
  620.      If CheckDigitValue = 41 Then CheckDigit = 43
  621.     '%
  622.      If CheckDigitValue = 42 Then CheckDigit = 37
  623.      
  624. 'ReturnType 0 returns data formatted to the barcode font
  625.      If ReturnType = 0 Then Code39Mod43 = "!" & DataToPrint & ChrW(CheckDigit) & "!" & " "
  626. 'ReturnType 1 returns data formatted for human readable text
  627.      If ReturnType = 1 Then Code39Mod43 = DataToPrint & ChrW(CheckDigit)
  628. 'ReturnType 2 returns the  check digit for the data supplied
  629.      If ReturnType = 2 Then Code39Mod43 = ChrW(CheckDigit)
  630. End Function
  631.  
  632.  
  633. Public Function Code39(DataToEncode As String) As String
  634. '*********************************************************************
  635. '*  Visual Basic / VBA Functions for Bar Code Fonts 5.01
  636. '*  Copyright, IDAutomation.com, Inc. 2000-2005. All rights reserved.
  637. '*
  638. '*  Visit http://www.idautomation.com/fonts/tools/vba/ for more
  639. '*  information about the functions in this file.
  640. '*
  641. '*  You may incorporate our Source Code in your application
  642. '*  only if you own a valid license from IDAutomation.com, Inc.
  643. '*  for the associated font and this text and the copyright notices
  644. '*  are not removed from the source code.
  645. '*
  646. '*  Distributing our source code or fonts outside your
  647. '*  organization requires a Developer License.
  648. '*********************************************************************
  649.  
  650.      DataToPrint = ""
  651.      DataToEncode = RTrim(LTrim(DataToEncode))
  652. 'Check for spaces in code
  653.      StringLength = Len(DataToEncode)
  654.      For I = 1 To StringLength
  655.     'Get each character one at a time
  656.           CurrentChar = (Mid(DataToEncode, I, 1))
  657.     'To print the barcode symbol representing a space you will
  658.     'to type or print "=" (the equal character) instead of a space character.
  659.           If CurrentChar = " " Then CurrentChar = "="
  660.           DataToPrint = DataToPrint & CurrentChar
  661.      Next I
  662. 'Get Printable String
  663.      PrintableString = "!" & DataToPrint & "!" & " "
  664. 'Return PrintableString
  665.      Code39 = PrintableString
  666. End Function
  667.  
  668.  
  669.  
  670.  
  671.  
  672. Public Function I2of5Mod10(DataToEncode As String, Optional ReturnType As Integer) As String
  673. '*********************************************************************
  674. '*  Visual Basic / VBA Functions for Bar Code Fonts 5.01
  675. '*  Copyright, IDAutomation.com, Inc. 2000-2005. All rights reserved.
  676. '*
  677. '*  Visit http://www.idautomation.com/fonts/tools/vba/ for more
  678. '*  information about the functions in this file.
  679. '*
  680. '*  You may incorporate our Source Code in your application
  681. '*  only if you own a valid license from IDAutomation.com, Inc.
  682. '*  for the associated font and this text and the copyright notices
  683. '*  are not removed from the source code.
  684. '*
  685. '*  Distributing our source code or fonts outside your
  686. '*  organization requires a Developer License.
  687. '*********************************************************************
  688.      'Additional logic needed in case ReturnType is not entered
  689.      If ReturnType <> 0 And ReturnType <> 1 And ReturnType <> 2 Then ReturnType = 0
  690. ' Get data from user, this is the DataToEncode
  691.      DataToEncode = RTrim(LTrim(DataToEncode))
  692.      DataToPrint = ""
  693. ' Check to make sure data is numeric and remove dashes, etc.
  694.      OnlyCorrectData = ""
  695.      StringLength = Len(DataToEncode)
  696.      For I = 1 To StringLength
  697.     'Add all numbers to OnlyCorrectData string
  698.           If IsNumeric(Mid(DataToEncode, I, 1)) Then OnlyCorrectData = OnlyCorrectData & Mid(DataToEncode, I, 1)
  699.      Next I
  700.      DataToEncode = OnlyCorrectData
  701. '<<<< Calculate Check Digit >>>>
  702.      Factor = 3
  703.      WeightedTotal = 0
  704.      For I = Len(DataToEncode) To 1 Step -1
  705.     'Get the value of each number starting at the end
  706.           CurrentCharNum = Mid(DataToEncode, I, 1)
  707.     'multiply by the weighting factor which is 3,1,3,1...
  708.     'and add the sum together
  709.           WeightedTotal = WeightedTotal + CurrentCharNum * Factor
  710.     'change factor for next calculation
  711.           Factor = 4 - Factor
  712.      Next I
  713. 'Find the CheckDigit by finding the smallest number that = a multiple of 10
  714.      I = (WeightedTotal Mod 10)
  715.      If I <> 0 Then
  716.           CheckDigit = (10 - I)
  717.      Else
  718.           CheckDigit = 0
  719.      End If
  720. 'Add check digit to number to DataToEncode
  721.      DataToEncode = DataToEncode & CheckDigit
  722. 'Check for an even number of digits, add 0 if not even
  723.      If (Len(DataToEncode) Mod 2) = 1 Then DataToEncode = "0" & DataToEncode
  724.      StringLength = Len(DataToEncode)
  725.      For I = 1 To StringLength Step 2
  726.     'Get the value of each number pair
  727.           CurrentCharNum = (Mid(DataToEncode, I, 2))
  728.     'Get the ASCII value of CurrentChar according to chart by to the value
  729.           If CurrentCharNum < 94 Then DataToPrint = DataToPrint & ChrW(CurrentCharNum + 33)
  730.           If CurrentCharNum > 93 Then DataToPrint = DataToPrint & ChrW(CurrentCharNum + 103)
  731.      Next I
  732. 'ReturnType 0 returns data formatted to the barcode font
  733.      If ReturnType = 0 Then I2of5Mod10 = ChrW(203) & DataToPrint & ChrW(204) & " "
  734. 'ReturnType 1 returns data formatted for human readable text
  735.      If ReturnType = 1 Then I2of5Mod10 = DataToEncode
  736. 'ReturnType 2 returns the  check digit for the data supplied
  737.      If ReturnType = 2 Then I2of5Mod10 = Str$(CheckDigit)
  738. End Function
  739.  
  740.  
  741.  
  742. Public Function MSI(DataToEncode As String, Optional ReturnType As Integer) As String
  743. '*********************************************************************
  744. '*  Visual Basic / VBA Functions for Bar Code Fonts 5.01
  745. '*  Copyright, IDAutomation.com, Inc. 2000-2005. All rights reserved.
  746. '*
  747. '*  Visit http://www.idautomation.com/fonts/tools/vba/ for more
  748. '*  information about the functions in this file.
  749. '*
  750. '*  You may incorporate our Source Code in your application
  751. '*  only if you own a valid license from IDAutomation.com, Inc.
  752. '*  for the associated font and this text and the copyright notices
  753. '*  are not removed from the source code.
  754. '*
  755. '*  Distributing our source code or fonts outside your
  756. '*  organization requires a Developer License.
  757. '*********************************************************************
  758.     'Additional logic needed in case ReturnType is not entered
  759.     If ReturnType <> 0 And ReturnType <> 1 And ReturnType <> 2 Then ReturnType = 0
  760. ' The MSI encoding function will only accept digits.  Any non-numeric characters
  761. ' will be discarded
  762.     Dim DataToPrint As String       'output for function
  763.     Dim OnlyCorrectData As String   'Only numeric characters pulled from DataToEncode
  764.     Dim StringLength As Long        'Length of string
  765.     Dim Idx As Integer              'for loop counter
  766.     Dim OddNumbers As String        'String of odd position numbers used to create check digit
  767.     Dim EvenNumberSum As Long       'all of the even position numbers added up
  768.     Dim OddNumberProduct As Long    'Product of OddNumbers variable
  769.     Dim sOddNumberProduct As String 'String version of OddNumberProduct variable
  770.     Dim OddNumberSum As Long        'Sum of individual digits in sOddNumberProduct
  771.     Dim OddDigit As Boolean         'Used to determine even/odd position digits.
  772.     Dim CheckDigit As String        'This is the CheckDigit
  773.     DataToPrint = ""
  774.     OnlyCorrectData = ""
  775.     'Take off any extra spaces
  776.     DataToEncode = Trim(DataToEncode)
  777.     
  778.     'Check to make sure data is numeric and remove dashes, etc.
  779.      StringLength = Len(DataToEncode)
  780.      For Idx = 1 To StringLength
  781.         'Add all numbers to OnlyCorrectData string
  782.         If IsNumeric(Mid(DataToEncode, Idx, 1)) = True Then
  783.             OnlyCorrectData = OnlyCorrectData & Mid(DataToEncode, Idx, 1)
  784.         End If
  785.      Next Idx
  786.      
  787.      DataToEncode = OnlyCorrectData
  788.      
  789.      '<<<< Calculate Check Digit >>>>
  790.      'To create the check digit follow these steps
  791.      '1)Starting from the units position, create a new number with all of the odd
  792.      '  position digits in their original sequence.
  793.      '2)Multiply this new number by 2.
  794.      '3)Add all of the digits of the product from step two.
  795.      '4)Add all of the digits not used in step one to the result in step three.
  796.      '5)Determine the smallest number which when added to the result in step four
  797.      '  will result in a multiple of 10. This is the check character.
  798.  
  799.     'Step 1 -- Create a new number of the odd position digits starting from the right and going left, but store the
  800.     'digits from left to right.
  801.     'We will create the odd position number & prepare for Step 4 by getting the sum of all even position charactesr
  802.     StringLength = Len(DataToEncode)
  803.     OddNumbers = ""
  804.     OddDigit = True
  805.     EvenNumberSum = 0
  806.     For Idx = StringLength To 1 Step -1
  807.         If OddDigit = True Then
  808.             OddNumbers = Mid(DataToEncode, Idx, 1) & OddNumbers
  809.             OddDigit = False
  810.         Else
  811.             EvenNumberSum = EvenNumberSum + Val(Mid(DataToEncode, Idx, 1))
  812.             OddDigit = True
  813.         End If
  814.     Next Idx
  815.     
  816.     'Step 2 -- Multiply this new number by 2.
  817.     OddNumberProduct = Val(OddNumbers) * 2
  818.  
  819.     'Step 3 -- Add all of the digits of the product from step two.
  820.     sOddNumberProduct = Format(OddNumberProduct)
  821.     StringLength = Len(sOddNumberProduct)
  822.     OddNumberSum = 0
  823.  
  824.     For Idx = 1 To StringLength
  825.         OddNumberSum = OddNumberSum + Val(Mid(sOddNumberProduct, Idx, 1))
  826.     Next Idx
  827.     
  828.     'Step 4 -- Add all of the digits not used in step one to the result in step three.
  829.     'We will store the result in OddNumberSum just so we don't have to create another variable
  830.     OddNumberSum = OddNumberSum + EvenNumberSum
  831.     
  832.     'Step 5 -- Determine the smallest number which when added to the result in step four
  833.     '  will result in a multiple of 10. This is the check character.
  834.     OddNumberSum = OddNumberSum Mod 10
  835.     If OddNumberSum <> 0 Then
  836.         CheckDigit = Format(10 - OddNumberSum)
  837.     Else
  838.         CheckDigit = "0"
  839.     End If
  840.     
  841.     Select Case ReturnType
  842.         Case 0  'Returns formatted data for barcode
  843.             DataToPrint = "(" & DataToEncode & CheckDigit & ")" & " "
  844.         Case 1  'Returns data formatted for human readable text.  Which means all of the invalid characters where
  845.                 'stripped out.
  846.             DataToPrint = DataToEncode
  847.         Case 2  'Returns just the check digit
  848.             DataToPrint = CheckDigit
  849.     End Select
  850.     
  851.     MSI = DataToPrint
  852.     
  853. End Function
  854.  
  855.  
  856. Public Function UPCa(DataToEncode As String) As String
  857. '*********************************************************************
  858. '*  Visual Basic / VBA Functions for Bar Code Fonts 5.01
  859. '*  Copyright, IDAutomation.com, Inc. 2000-2005. All rights reserved.
  860. '*
  861. '*  Visit http://www.idautomation.com/fonts/tools/vba/ for more
  862. '*  information about the functions in this file.
  863. '*
  864. '*  You may incorporate our Source Code in your application
  865. '*  only if you own a valid license from IDAutomation.com, Inc.
  866. '*  for the associated font and this text and the copyright notices
  867. '*  are not removed from the source code.
  868. '*
  869. '*  Distributing our source code or fonts outside your
  870. '*  organization requires a Developer License.
  871. '*********************************************************************
  872.      DataToPrint = ""
  873.      DataToEncode = RTrim(LTrim(DataToEncode))
  874. ' Check to make sure data is numeric and remove dashes, etc.
  875.      OnlyCorrectData = ""
  876.      StringLength = Len(DataToEncode)
  877.      For I = 1 To StringLength
  878.     'Add all numbers to OnlyCorrectData string
  879.           If IsNumeric(Mid(DataToEncode, I, 1)) Then OnlyCorrectData = OnlyCorrectData & Mid(DataToEncode, I, 1)
  880.      Next I
  881. 'Remove check digits if they added one
  882.      If Len(OnlyCorrectData) < "11" Then OnlyCorrectData = "00000000000"
  883.      If Len(OnlyCorrectData) = "15" Then OnlyCorrectData = "00000000000"
  884.      If Len(OnlyCorrectData) > "18" Then OnlyCorrectData = "00000000000"
  885.      If Len(OnlyCorrectData) = "12" Then OnlyCorrectData = Mid(OnlyCorrectData, 1, 11)
  886.      If Len(OnlyCorrectData) = "14" Then OnlyCorrectData = (Mid(OnlyCorrectData, 1, 11) & Mid(OnlyCorrectData, 13, 2))
  887.      If Len(OnlyCorrectData) = "17" Then OnlyCorrectData = (Mid(OnlyCorrectData, 1, 11) & Mid(OnlyCorrectData, 13, 5))
  888.      EAN2AddOn = ""
  889.      EAN5AddOn = ""
  890.      EANAddOnToPrint = ""
  891.      If Len(OnlyCorrectData) = 16 Then EAN5AddOn = Mid(OnlyCorrectData, 12, 5)
  892.      If Len(OnlyCorrectData) = 13 Then EAN2AddOn = Mid(OnlyCorrectData, 12, 2)
  893. 'split 12 digit number from add-on
  894.  
  895.      DataToEncode = Mid(OnlyCorrectData, 1, 11)
  896. '<<<< Calculate Check Digit >>>>
  897.      Factor = 3
  898.      WeightedTotal = 0
  899.      For I = Len(DataToEncode) To 1 Step -1
  900.     'Get the value of each number starting at the end
  901.           CurrentCharNum = Mid(DataToEncode, I, 1)
  902.     'multiply by the weighting factor which is 3,1,3,1...
  903.     'and add the sum together
  904.           WeightedTotal = WeightedTotal + CurrentCharNum * Factor
  905.     'change factor for next calculation
  906.           Factor = 4 - Factor
  907.      Next I
  908. 'Find the CheckDigit by finding the number + WeightedTotal that = a multiple of 10
  909. 'divide by 10, get the remainder and subtract from 10
  910.      I = (WeightedTotal Mod 10)
  911.      If I <> 0 Then
  912.           CheckDigit = (10 - I)
  913.      Else
  914.           CheckDigit = 0
  915.      End If
  916.      DataToEncode = DataToEncode & CheckDigit
  917. 'Now that have the total number including the check digit, determine character to print
  918. 'for proper barcoding
  919.      StringLength = Len(DataToEncode)
  920.      For I = 1 To StringLength
  921.     'Get the ASCII value of each number
  922.           CurrentCharNum = AscW(Mid(DataToEncode, I, 1))
  923.     'Print different barcodes according to the location of the CurrentChar
  924.           Select Case I
  925.           Case 1
  926.         'For the first character print the human readable character, the normal
  927.         'guard pattern and then the barcode without the human readable character
  928.                If ChrW(CurrentCharNum) > 4 Then DataToPrint = ChrW(CurrentCharNum + 64) & "(" & ChrW(CurrentCharNum + 49)
  929.                If ChrW(CurrentCharNum) < 5 Then DataToPrint = ChrW(CurrentCharNum + 37) & "(" & ChrW(CurrentCharNum + 49)
  930.           Case 2
  931.                DataToPrint = DataToPrint & ChrW(CurrentCharNum)
  932.           Case 3
  933.                DataToPrint = DataToPrint & ChrW(CurrentCharNum)
  934.           Case 4
  935.                DataToPrint = DataToPrint & ChrW(CurrentCharNum)
  936.           Case 5
  937.                DataToPrint = DataToPrint & ChrW(CurrentCharNum)
  938.           Case 6
  939.         'Print the center guard pattern after the 6th character
  940.                DataToPrint = DataToPrint & ChrW(CurrentCharNum) & "*"
  941.           Case 7
  942.         'Add 27 to the ASII value of characters 6-12 to print from character set+ C
  943.         'this is required when printing to the right of the center guard pattern
  944.                DataToPrint = DataToPrint & ChrW(CurrentCharNum + 27)
  945.           Case 8
  946.                DataToPrint = DataToPrint & ChrW(CurrentCharNum + 27)
  947.           Case 9
  948.                DataToPrint = DataToPrint & ChrW(CurrentCharNum + 27)
  949.           Case 10
  950.                DataToPrint = DataToPrint & ChrW(CurrentCharNum + 27)
  951.           Case 11
  952.                DataToPrint = DataToPrint & ChrW(CurrentCharNum + 27)
  953.           Case 12
  954.         'For the last character print the barcode without the human readable character,
  955.         'the normal guard pattern and then the human readable character.
  956.                If ChrW(CurrentCharNum) > 4 Then DataToPrint = DataToPrint & ChrW(CurrentCharNum + 59) & "(" & ChrW(CurrentCharNum + 64)
  957.                If ChrW(CurrentCharNum) < 5 Then DataToPrint = DataToPrint & ChrW(CurrentCharNum + 59) & "(" & ChrW(CurrentCharNum + 37)
  958.           End Select
  959.      Next I
  960. 'Process 5 digit add on if it exists
  961.      If Len(EAN5AddOn) = 5 Then
  962.           EANAddOnToPrint = ""
  963.     'Get check digit for add on
  964.           Factor = 3
  965.           WeightedTotal = 0
  966.           For I = Len(EAN5AddOn) To 1 Step -1
  967.         'Get the value of each number starting at the end
  968.                CurrentCharNum = Mid(EAN5AddOn, I, 1)
  969.         'multiply by the weighting factor which is 3,9,3,9.
  970.         'and add the sum together
  971.                If Factor = 3 Then WeightedTotal = WeightedTotal + CurrentCharNum * 3
  972.                If Factor = 1 Then WeightedTotal = WeightedTotal + CurrentCharNum * 9
  973.         'change factor for next calculation
  974.                Factor = 4 - Factor
  975.           Next I
  976.     'Find the CheckDigit by extracting the right-most number from WeightedTotal
  977.           CheckDigit = Val(Right$(WeightedTotal, 1))
  978.     'Now we must encode the add-on CheckDigit into the number sets
  979.     'by using variable parity between character sets A and B
  980.           Select Case CheckDigit
  981.           Case 0
  982.                Encoding = "BBAAA"
  983.           Case 1
  984.                Encoding = "BABAA"
  985.           Case 2
  986.                Encoding = "BAABA"
  987.           Case 3
  988.                Encoding = "BAAAB"
  989.           Case 4
  990.                Encoding = "ABBAA"
  991.           Case 5
  992.                Encoding = "AABBA"
  993.           Case 6
  994.                Encoding = "AAABB"
  995.           Case 7
  996.                Encoding = "ABABA"
  997.           Case 8
  998.                Encoding = "ABAAB"
  999.           Case 9
  1000.                Encoding = "AABAB"
  1001.           End Select
  1002.     'Now that we have the total number including the check digit, determine character to print
  1003.     'for proper barcoding:
  1004.           For I = 1 To Len(EAN5AddOn)
  1005.         'Get the value of each number
  1006.         'it is encoded with variable parity
  1007.                CurrentChar = Mid(EAN5AddOn, I, 1)
  1008.                CurrentEncoding = Mid(Encoding, I, 1)
  1009.         'Print different barcodes according to the location of the CurrentChar and CurrentEncoding
  1010.                Select Case CurrentEncoding
  1011.                Case "A"
  1012.                     If CurrentChar = "0" Then EANAddOnToPrint = EANAddOnToPrint & ChrW(34)
  1013.                     If CurrentChar = "1" Then EANAddOnToPrint = EANAddOnToPrint & ChrW(35)
  1014.                     If CurrentChar = "2" Then EANAddOnToPrint = EANAddOnToPrint & ChrW(36)
  1015.                     If CurrentChar = "3" Then EANAddOnToPrint = EANAddOnToPrint & ChrW(37)
  1016.                     If CurrentChar = "4" Then EANAddOnToPrint = EANAddOnToPrint & ChrW(38)
  1017.                     If CurrentChar = "5" Then EANAddOnToPrint = EANAddOnToPrint & ChrW(44)
  1018.                     If CurrentChar = "6" Then EANAddOnToPrint = EANAddOnToPrint & ChrW(46)
  1019.                     If CurrentChar = "7" Then EANAddOnToPrint = EANAddOnToPrint & ChrW(47)
  1020.                     If CurrentChar = "8" Then EANAddOnToPrint = EANAddOnToPrint & ChrW(58)
  1021.                     If CurrentChar = "9" Then EANAddOnToPrint = EANAddOnToPrint & ChrW(59)
  1022.                Case "B"
  1023.                     If CurrentChar = "0" Then EANAddOnToPrint = EANAddOnToPrint & ChrW(122)
  1024.                     If CurrentChar = "1" Then EANAddOnToPrint = EANAddOnToPrint & ChrW(61)
  1025.                     If CurrentChar = "2" Then EANAddOnToPrint = EANAddOnToPrint & ChrW(63)
  1026.                     If CurrentChar = "3" Then EANAddOnToPrint = EANAddOnToPrint & ChrW(64)
  1027.                     If CurrentChar = "4" Then EANAddOnToPrint = EANAddOnToPrint & ChrW(91)
  1028.                     If CurrentChar = "5" Then EANAddOnToPrint = EANAddOnToPrint & ChrW(92)
  1029.                     If CurrentChar = "6" Then EANAddOnToPrint = EANAddOnToPrint & ChrW(93)
  1030.                     If CurrentChar = "7" Then EANAddOnToPrint = EANAddOnToPrint & ChrW(95)
  1031.                     If CurrentChar = "8" Then EANAddOnToPrint = EANAddOnToPrint & ChrW(123)
  1032.                     If CurrentChar = "9" Then EANAddOnToPrint = EANAddOnToPrint & ChrW(125)
  1033.                End Select
  1034.         'add in the space & add-on guard pattern
  1035.                Select Case I
  1036.                Case 1
  1037.             'EANAddOnToPrint = ChrW(32) & ChrW(43) & EANAddOnToPrint & ChrW(33)
  1038.                     EANAddOnToPrint = ChrW(43) & EANAddOnToPrint & ChrW(33)
  1039.             'Now print add-on delineators between each add-on character
  1040.                Case 2
  1041.                     EANAddOnToPrint = EANAddOnToPrint & ChrW(33)
  1042.                Case 3
  1043.                     EANAddOnToPrint = EANAddOnToPrint & ChrW(33)
  1044.                Case 4
  1045.                     EANAddOnToPrint = EANAddOnToPrint & ChrW(33)
  1046.                Case 5
  1047.                     EANAddOnToPrint = EANAddOnToPrint
  1048.                End Select
  1049.           Next I
  1050.      End If
  1051. 'Process 2 digit add on if it exists
  1052.      If Len(EAN2AddOn) = 2 Then
  1053.           EANAddOnToPrint = ""
  1054.     'Get encoding for add on
  1055.           For I = 0 To 99 Step 4
  1056.                If Val(EAN2AddOn) = I Then Encoding = "AA"
  1057.                If Val(EAN2AddOn) = I + 1 Then Encoding = "AB"
  1058.                If Val(EAN2AddOn) = I + 2 Then Encoding = "BA"
  1059.                If Val(EAN2AddOn) = I + 3 Then Encoding = "BB"
  1060.           Next I
  1061.     'Now that we have the total number including the encoding
  1062.     'determine what to print
  1063.           For I = 1 To Len(EAN2AddOn)
  1064.         'Get the value of each number
  1065.         'it is encoded with variable parity
  1066.                CurrentChar = Mid(EAN2AddOn, I, 1)
  1067.                CurrentEncoding = Mid(Encoding, I, 1)
  1068.         'Print different barcodes according to the location of the CurrentChar and CurrentEncoding
  1069.                Select Case CurrentEncoding
  1070.                Case "A"
  1071.                     If CurrentChar = "0" Then EANAddOnToPrint = EANAddOnToPrint & ChrW(34)
  1072.                     If CurrentChar = "1" Then EANAddOnToPrint = EANAddOnToPrint & ChrW(35)
  1073.                     If CurrentChar = "2" Then EANAddOnToPrint = EANAddOnToPrint & ChrW(36)
  1074.                     If CurrentChar = "3" Then EANAddOnToPrint = EANAddOnToPrint & ChrW(37)
  1075.                     If CurrentChar = "4" Then EANAddOnToPrint = EANAddOnToPrint & ChrW(38)
  1076.                     If CurrentChar = "5" Then EANAddOnToPrint = EANAddOnToPrint & ChrW(44)
  1077.                     If CurrentChar = "6" Then EANAddOnToPrint = EANAddOnToPrint & ChrW(46)
  1078.                     If CurrentChar = "7" Then EANAddOnToPrint = EANAddOnToPrint & ChrW(47)
  1079.                     If CurrentChar = "8" Then EANAddOnToPrint = EANAddOnToPrint & ChrW(58)
  1080.                     If CurrentChar = "9" Then EANAddOnToPrint = EANAddOnToPrint & ChrW(59)
  1081.                Case "B"
  1082.                     If CurrentChar = "0" Then EANAddOnToPrint = EANAddOnToPrint & ChrW(122)
  1083.                     If CurrentChar = "1" Then EANAddOnToPrint = EANAddOnToPrint & ChrW(61)
  1084.                     If CurrentChar = "2" Then EANAddOnToPrint = EANAddOnToPrint & ChrW(63)
  1085.                     If CurrentChar = "3" Then EANAddOnToPrint = EANAddOnToPrint & ChrW(64)
  1086.                     If CurrentChar = "4" Then EANAddOnToPrint = EANAddOnToPrint & ChrW(91)
  1087.                     If CurrentChar = "5" Then EANAddOnToPrint = EANAddOnToPrint & ChrW(92)
  1088.                     If CurrentChar = "6" Then EANAddOnToPrint = EANAddOnToPrint & ChrW(93)
  1089.                     If CurrentChar = "7" Then EANAddOnToPrint = EANAddOnToPrint & ChrW(95)
  1090.                     If CurrentChar = "8" Then EANAddOnToPrint = EANAddOnToPrint & ChrW(123)
  1091.                     If CurrentChar = "9" Then EANAddOnToPrint = EANAddOnToPrint & ChrW(125)
  1092.                End Select
  1093.         'add in the space & add-on guard pattern
  1094.                Select Case I
  1095.                Case 1
  1096.             'EANAddOnToPrint = ChrW(32) & ChrW(43) & EANAddOnToPrint & ChrW(33)
  1097.                     EANAddOnToPrint = ChrW(43) & EANAddOnToPrint & ChrW(33)
  1098.             'Now print add-on delineators between each add-on character
  1099.                Case 2
  1100.                     EANAddOnToPrint = EANAddOnToPrint
  1101.                End Select
  1102.           Next I
  1103.      End If
  1104. 'Get Printable String
  1105.      PrintableString = DataToPrint & EANAddOnToPrint & " "
  1106. 'Return PrintableString
  1107.      UPCa = PrintableString
  1108. End Function
  1109.  
  1110. Public Function UPCe(DataToEncode As String) As String
  1111. '*********************************************************************
  1112. '*  Visual Basic / VBA Functions for Bar Code Fonts 5.01
  1113. '*  Copyright, IDAutomation.com, Inc. 2000-2005. All rights reserved.
  1114. '*
  1115. '*  Visit http://www.idautomation.com/fonts/tools/vba/ for more
  1116. '*  information about the functions in this file.
  1117. '*
  1118. '*  You may incorporate our Source Code in your application
  1119. '*  only if you own a valid license from IDAutomation.com, Inc.
  1120. '*  for the associated font and this text and the copyright notices
  1121. '*  are not removed from the source code.
  1122. '*
  1123. '*  Distributing our source code or fonts outside your
  1124. '*  organization requires a Developer License.
  1125. '*********************************************************************
  1126. ' Get data from user, this is the DataToEncode
  1127.      DataToEncode = RTrim(LTrim(DataToEncode))
  1128.      DataToPrint = ""
  1129. ' Check to make sure data is numeric and remove dashes, etc.
  1130.      OnlyCorrectData = ""
  1131.      StringLength = Len(DataToEncode)
  1132.      For I = 1 To StringLength
  1133.     'Add all numbers to OnlyCorrectData string
  1134.           If IsNumeric(Mid(DataToEncode, I, 1)) Then OnlyCorrectData = OnlyCorrectData & Mid(DataToEncode, I, 1)
  1135.      Next I
  1136. 'Remove check digits if they added one
  1137.      If Len(OnlyCorrectData) < "11" Then OnlyCorrectData = "00005000000"
  1138.      If Len(OnlyCorrectData) = "15" Then OnlyCorrectData = "00005000000"
  1139.      If Len(OnlyCorrectData) > "18" Then OnlyCorrectData = "00005000000"
  1140.      If Len(OnlyCorrectData) = "12" Then OnlyCorrectData = Mid(OnlyCorrectData, 1, 11)
  1141.      If Len(OnlyCorrectData) = "14" Then OnlyCorrectData = (Mid(OnlyCorrectData, 1, 11) & Mid(OnlyCorrectData, 13, 2))
  1142.      If Len(OnlyCorrectData) = "17" Then OnlyCorrectData = (Mid(OnlyCorrectData, 1, 11) & Mid(OnlyCorrectData, 13, 5))
  1143.      EAN2AddOn = ""
  1144.      EAN5AddOn = ""
  1145.      EANAddOnToPrint = ""
  1146.      If Len(OnlyCorrectData) = 16 Then EAN5AddOn = Mid(OnlyCorrectData, 12, 5)
  1147.      If Len(OnlyCorrectData) = 13 Then EAN2AddOn = Mid(OnlyCorrectData, 12, 2)
  1148. 'split 12 digit number from add-on
  1149.  
  1150.      DataToEncode = Mid(OnlyCorrectData, 1, 11)
  1151.      
  1152. '<<<< Calculate Check Digit >>>>
  1153.      Factor = 3
  1154.      WeightedTotal = 0
  1155.      For I = Len(DataToEncode) To 1 Step -1
  1156.     'Get the value of each number starting at the end
  1157.           CurrentCharNum = Mid(DataToEncode, I, 1)
  1158.     'multiply by the weighting factor which is 3,1,3,1...
  1159.     'and add the sum together
  1160.           WeightedTotal = WeightedTotal + CurrentCharNum * Factor
  1161.     'change factor for next calculation
  1162.           Factor = 4 - Factor
  1163.      Next I
  1164. 'Find the CheckDigit by finding the number + WeightedTotal that = a multiple of 10
  1165. 'divide by 10, get the remainder and subtract from 10
  1166.      I = (WeightedTotal Mod 10)
  1167.      If I <> 0 Then
  1168.           CheckDigit = (10 - I)
  1169.      Else
  1170.           CheckDigit = 0
  1171.      End If
  1172.      
  1173.      DataToEncode = DataToEncode & CheckDigit
  1174. 'Compress UPC-A to UPC-E if possible
  1175.      Dim D1 As String
  1176.      Dim D2 As String
  1177.      Dim D3 As String
  1178.      Dim D4 As String
  1179.      Dim D5 As String
  1180.      Dim D6 As String
  1181.      Dim D7 As String
  1182.      Dim D8 As String
  1183.      Dim D9 As String
  1184.      Dim D10 As String
  1185.      Dim D11 As String
  1186.      Dim D12 As String
  1187.      D1 = Mid(DataToEncode, 1, 1)
  1188.      D2 = Mid(DataToEncode, 2, 1)
  1189.      D3 = Mid(DataToEncode, 3, 1)
  1190.      D4 = Mid(DataToEncode, 4, 1)
  1191.      D5 = Mid(DataToEncode, 5, 1)
  1192.      D6 = Mid(DataToEncode, 6, 1)
  1193.      D7 = Mid(DataToEncode, 7, 1)
  1194.      D8 = Mid(DataToEncode, 8, 1)
  1195.      D9 = Mid(DataToEncode, 9, 1)
  1196.      D10 = Mid(DataToEncode, 10, 1)
  1197.      D11 = Mid(DataToEncode, 11, 1)
  1198.      D12 = Mid(DataToEncode, 12, 1)
  1199. 'Condition A
  1200.      If (D11 = "5" Or D11 = "6" Or D11 = "7" Or D11 = "8" Or D11 = "9") And D6 <> "0" And (D7 = "0" And D8 = "0" And D9 = "0" And D10 = "0") Then
  1201.           DataToEncode = D2 & D3 & D4 & D5 & D6 & D11
  1202.      End If
  1203. 'Condition B
  1204.      If (D6 = "0" And D7 = "0" And D8 = "0" And D9 = "0" And D10 = "0") And D5 <> "0" Then
  1205.           DataToEncode = D2 & D3 & D4 & D5 & D11 & "4"
  1206.      End If
  1207. 'Condition C
  1208.      If (D5 = "0" And D6 = "0" And D7 = "0" And D8 = "0") And (D4 = "1" Or D4 = "2" Or D4 = "0") Then
  1209.           DataToEncode = D2 & D3 & D9 & D10 & D11 & D4
  1210.      End If
  1211. 'Condition D
  1212.      If (D5 = "0" And D6 = "0" And D7 = "0" And D8 = "0" And D9 = "0") And (D4 = "3" Or D4 = "4" Or D4 = "5" Or D4 = "6" Or D4 = "7" Or D4 = "8" Or D4 = "9") Then
  1213.           DataToEncode = D2 & D3 & D4 & D10 & D11 & "3"
  1214.      End If
  1215. '
  1216. 'Run UPC-E compression only if DataToEncode = 6
  1217.      If Len(DataToEncode) = 6 Then
  1218.     'Now we must encode the check character into the symbol
  1219.     'by using variable parity between character sets A and B
  1220.           Select Case D12
  1221.           Case "0"
  1222.                Encoding = "BBBAAA"
  1223.           Case "1"
  1224.                Encoding = "BBABAA"
  1225.           Case "2"
  1226.                Encoding = "BBAABA"
  1227.           Case "3"
  1228.                Encoding = "BBAAAB"
  1229.           Case "4"
  1230.                Encoding = "BABBAA"
  1231.           Case "5"
  1232.                Encoding = "BAABBA"
  1233.           Case "6"
  1234.                Encoding = "BAAABB"
  1235.           Case "7"
  1236.                Encoding = "BABABA"
  1237.           Case "8"
  1238.                Encoding = "BABAAB"
  1239.           Case "9"
  1240.                Encoding = "BAABAB"
  1241.           End Select
  1242.           StringLength = Len(DataToEncode)
  1243.           For I = 1 To StringLength
  1244.         'Get the ASCII value of each number
  1245.                CurrentCharNum = AscW(Mid(DataToEncode, I, 1))
  1246.                CurrentEncoding = Mid(Encoding, I, 1)
  1247.         'Print different barcodes according to the location of the CurrentChar and CurrentEncoding
  1248.                Select Case CurrentEncoding
  1249.                Case "A"
  1250.                     DataToPrint = DataToPrint & ChrW(CurrentCharNum)
  1251.                Case "B"
  1252.                     DataToPrint = DataToPrint & ChrW(CurrentCharNum + 17)
  1253.                End Select
  1254.         'add in the 1st character along with guard patterns
  1255.                Select Case I
  1256.                Case 1
  1257.             'For the LeadingDigit print the human readable character,
  1258.             'the normal guard pattern and then the rest of the barcode
  1259.                     DataToPrint = ChrW(85) & "(" & DataToPrint
  1260.                Case 6
  1261.             'Print the SPECIAL guard pattern and check character
  1262.                     If CInt(D12) > 4 Then DataToPrint = DataToPrint & ")" & ChrW(AscW(D12) + 64)
  1263.                     If CInt(D12) < 5 Then DataToPrint = DataToPrint & ")" & ChrW(AscW(D12) + ToPrint & ChrW(59)
  1264.      & ChrW(AscW(D12 Curnt =c9aToPrint = Dt Iauman readable character,r into the symbol
  1265.     'by using variable parity between character sets A and B
  1266.           Select Case D12
  1267.           Case "0"
  1268.                Encoding = "BBBAAA"
  1269.           Case "1"
  1270.                Encoding = "BBABAA"
  1271.           Case "2"
  1272.                Enc        CurrentEncodin= "BBBAAA"
  1273. pSf CuC1ddOnToP     Enc     ccccccccccccc
  1274.    3, 1)
  1275.      D4c
  1276.    3, BBABAA"
  1277.           Case "2"
  1278.  rrentEUBBABAA"
  1279.           Case "2"
  1280.  rrentEUBBABAA"
  1281.           Case "2"
  1282.  rrentEUBBABAA"
  1283.           Case "2"
  1284.  rrentEUBBABAA"
  1285.           Case "2"
  1286.  rrentEUBBABAA"
  1287.           Case "2"
  1288.  rrentEUBBABAA"
  1289.           Case "2"
  1290.  rrentEUBBABAA"
  1291.           Case "2"
  1292.  rrentEwion requires a Dev BBABAA"
  1293.           Case "2"
  1294.   Case 'uires a D                      CIAL guard pa & ChrW(95)
  1295.              2
  1296.           Case "0"
  1297.    re TAL guar        Case "2"
  1298.   Case 'uires a D                      CIAL guard pa & ChrW(95)
  1299.              2
  1300.           Case "0"
  1301.    re TAL guar        Case "2"
  1302.   Case 'uires a D                      CIAL guard pa & ChrW(95)
  1303.              2
  1304.           Case "0"
  1305.    re grIaFtCharNum rn and then the human readable character.
  1306.     = Mid(En.
  1307.     = n.
  1308.  AAA"
  1309.  rest of the)AA") Then
  1310.           DataToEncode = D2 & D3 & D9 & D10 & D11 &>3odi           f the barcodets   UPCa =a/ for more
  1311. '*des accord "1"t UP 
  1312. '*  informaD8 = "0" And D9 =rrentChar = "3" Then EANAddOnToPrint = EANAddOnToP     StringLeNAddOnToPrint = oPr        >'cc
  1313.    3, 1)
  1314.   1"
  1315.               
  1316.  rrentEUBBABAA" Case "2"
  1317.   Case 'uires a D                               Encoding = d         DataToEncode = D2 & D3 & D9 & D10 & D11 &>3odi           f the barcodets   UPCa =a/ for more
  1318. '*des accord "1"t UP 
  1319. '*  informaD8 = "0" And D9 =rrentChar = "3" Then EANAddOnToPrint = EANAddOnToP     StringLeNAddOnToPrint = oPr        >'cc
  1320.    3, 1)
  1321.                'gLeNAddOnToPrint = oPrEB"
  1322.          4cc
  1323.    3, 1)
  1324.                'gLeNAddOnToPrint = oPrEB"
  1325.          4cc
  1326.    3, 1)
  1327.                'gLeNAddOnToPrint = oPrEW     -gLeNAd3, 1)
  1328.                'gLegLeNAddOnToPrint = oPrEW    hrW(95oLeNt = EANAddOnToP     StringLeNAddOnToPrint = oPr        >'cc
  1329.    3, 1)
  1330.                'gLeNAddOnToPrint = oPrEB"
  1331.       td43 = "!" & DataToPrint & ChrW(CheckDigit) & "!" & " "
  1332. 'ReturnType 1 returns data formatted for human readable text
  1333.      If ReturnType = 1 Then Code39Mod43 = DataToPrint & ChrW(CheckDigit)
  1334. 'ReturnType 2 returns the  check digit for the data supplied
  1335.       C5 If RetuCrns the  ch it for the data supplied
  1336.       C5 If RetuCrns the  ch it for the data supplied
  1337.       C5 If RetuCrns the  ch it for the data supplied
  1338.       C5 If f RetuCrns the  ch itsh it for the data supplied
  1339.       C5 If f RetuCrns the  ch itsh it for the data supplied
  1340.       C5 If f RetuCr      "0" And 
  1341.          int ch it for the dat1")
  1342.                Case "BEndringLeNAddOnToPrintEwion re1"
  1343.     'Get encoding for a1"                   If Curl  S) 4A  'G      & D10 & D11 &>3odi           f th1= "BABB0")r
  1344.        G      & D10 & 4gd
  1345.  rint = oPr        >'cc
  1346.    3, 1)
  1347.   & D11 &>3odi ABB0")r
  1348.   om user, this is the DataToEncodedOnToP        url  S) 4A  'G    aDataT     ncod d         DataTo    If CurrentCharAd3, 1)
  1349.             9G    aData    DataTo    If CurrentCharAd3, 8, 1)
  1350.      D9 = Mid(DataToEncode, 9, 1)
  1351.      D10 = Mid(DataToEncode, 10, 14de) And D9 = "0" And D10 = "0") Then
  1352.           DataToEncode)    'gLeNAddOnToPrint =9nd D9 = "0" And D10 = "0") Then
  1353.           DataTobol
  1354.     'by using variable parity between character sets A and B
  1355.           SeleEW )    'by using variable parity between chara DataToa sRhum rW(CheckDigit) & "!" & " "
  1356. 'ReturnTyp            9G    aData    DataTo    If (95)
  1357.           rW(CheckDigit) & "!" 5r- " "
  1358. 'h it for the data supr the drint = oPrEB"
  1359.          4cc
  1360.  Nv 4cc  aDat            'gLeNAddOnToPrint = oPrEB"
  1361.       td4M     64)
  1362.                     If CInt(D12) < 5 neI     If7 5 neI     If7 5 neI     If7 5 neI     If7 5, 1)NAddOnToPrint = oPrEB") = 1 Talue of each num.a, 13, 5"nToPrintetuCrns the  ch it for tc
  1363.    3, 1)
  1364.                'gLeNAddOnToPrint = oPrEB"
  1365.       td43 = "!" & DataToPrint & ChrW(CheckDigit) & "!" & " "
  1366. 'ReturnType 1 returns data formatted for human readable text
  1367.      If ReturnType = 1 Then Code39Mod43 = DataToPrint & ChrW(CheckDigit)
  1368. 'ReteachCurrentringLeNAddOnToPrintEwion re1"
  1369.   snd ICurredsnd rredsnd rrrentringLeNAddOnToPrintE 2 returns the  chPrintE 2 returns the  chPrintE 2 returns the  cthe  chPrintE 2 returns thToPrint & ChrW(Creturns the  c"
  1370.          4cc
  1371.  Nv 4cc  a 2 returns the  check digit for & DataToPrint & Chr    'by using v     .7armatt(43) & EANA
  1372.     ' ret8b        9G    aData    heckDigit = 0
  1373.      End If
  1374. 'Add check digit 0oPrintD11 &>3odi           f the barcodets   UPCa =a/ for more
  1375. '*des accord "1"t UP 
  1376. '*  informaD8 3Prinsf3odi    gd "1"t UP 
  1377. '*                It1BBBAAAmaDA 5 Then DataToPrint = DataToPrint & ")" & ChrW(AscW(D12) + ToPrint & ChrW(59)
  1378.      & ChrW(AscW(D12 Curnt =c9aToPrint = Dt Iauman readable character,r into the symbol
  1379.     'by using variable parity between character sets A and B
  1380.           Select Case D12  Dim D5 As String
  1381.      Deric and remove dashes, etc.
  1382.      OnlyCorrectData = ""
  1383.      StringLength = Len(DataToEncode)
  1384.      For I = 1 To StringLength
  1385.     'Add all numbers to OnlyCorrectData string
  1386.           If IsNumeric(Mid(DataToEncode, I, 1)) Then OnlyCorrectData = OnlyCorrect'eNA, 1))  character along
  1387.   3oded  For I = 1
  1388.                     If CIntAA"
  1389.           arint 
  1390.          4cc
  1391.  Nv 4cc  a 2 returns the  check  & Chr   7eturns the  check  & Chr   7eturns the  check  & Chr= Val(OddNumbers) * 2
  1392.  
  1393.     'Step 3 -- Add all of the digits of the product frNAddOnToPrinShar = "3" Then EIW(AscW(D12) + ToPrint & ChrWo)g              Case 1
  1394.             'For the LeadingDigit print the human readable character,
  1395.             'the normal guard pattern and then the rest of the barcode
  1396.                     DataToPrint = ChrW(85) & "(" & DataToPrint
  1397.                Case 6
  1398. "(" &    Case "3"
  1399.                Encoding = "BBAAAB"
  1400.           Case "4"
  1401.                Encoding = "BABBAA"
  1402.           Case "5"
  1403.                Encoding = "BAABBA"
  1404.           Case "6"
  1405.                Encoding = "BAAABB"
  1406.           Case "7"
  1407.                Encodch w=g = "BABAAB"
  1408.           Case "9"
  1409.                Encoding = "BAABAB"
  1410.           End Select
  1411.           StringLength = Len(DataToEncodecoPrint ret8b        9G    aData    heckDigit = 0
  1412.    x    Case "5"
  1413.                Encoding = "BAABBA"
  1414.          "BABB0")r
  1415.        G      & D10 & 4gd
  1416.  rint = oPr        >'cc
  1417.    3, 1)
  1418.   & D11 &>3odi ABB0")r
  1419.   om user, this is the DataToEncoded Case "3"
  1420.                Encoding = "BBAAAB"
  1421.           Case "4"
  1422.                Encoding = "BABBAA"
  1423.           Case "5"
  1424.    7 OddNumberSum just so we don't have to create another variable
  1425.     OddNumbo create anothoo var)" A OddNumbo create anothoo var)" A OddNumbo create anotho Case  &     ng = "B  Case "9hand then tt for the data supr the drint = oPrEB"
  1426.          4cc
  1427.  Nv 4cc  aDat            'gLeNAddOnToPrint = oPrEB"
  1428.       td4M     64)
  1429.             DBt = oPrEB"o    If CurrentChar   'G
  1430. 'A = oPrEBI'G
  1431. 'A = oPr  'so we hts     ns tf CurrentChar"B ?iAB"
  1432.  nToPf2cc
  1433.  Nv 4cc  aDat            'gLsnco+A all 4"
  1434.                Encoding = "BABBAA"te anothoo var)"snco+A all 4"
  1435.                Encoding = "BABBAA"t3n2  Dim D5 As Strinda    DataToEncode1sdncoding = "BBA    ot3n2nBBAA"50lAoeToEncoding = "BBA    "4"
  1436.                Encoding = "BABBAA"OnToPrint =coding = "BABBAA"t3n2  Dim D5 As Strinda    DataToEncode1sdncoding = "BBA    otint =codin
  1437.   = the'rEB"
  1438.          4cc
  1439.  Nv 4cc  aDat            'gLeNAddOnToPrint = oPrEB"
  1440.       td4M     64)
  1441.                     If CInt(D12) < 5 neI     If7 5 neI     If7 5 neI     If7 5 neI     If7 5, 1)NAddOnToPrint = oPrEB") = 1 Talue of each num.a, 13, 5"nToPrintetuCr1eI     If7 5 neI     If7 5, 1)NAddOnToCtuCr 5, 1)NAl + Cur7 5 neI     If7 5, 1)
  1442.     aoPrib0sAddOnToCtuCr 5, 1)NAl + Cim gth e "0"0    If CInt(D12) < 5 e "0"0    If CInt(D12) < 5 e "0"0    If CInt(D12) < 5 e "0"0    If CInt(D12) < 5 ef CInt(D12) < 5 e "0"0    If CInt(D12) < 5 e "0"0    If CInt(D12) < 5 e "0"0    If CInt(D12))r= "BBAABA"
  1443.  c        'No    & ChrW(AB freI     If7 5, 1)oPrgit = 0
  1444.      E"8" Or"
  1445.  cd6 CharNum + 27)4ABB0")r
  1446.   om userar"B I'so we hts
  1447.                Case "B"
  1448.                     DataToPrint = DataToPr               Case "B"  I       DataToPrint4cc************1harNumtaT. & DataToPrint
  1449.     64)
  1450.      2
  1451.           harNumtaT. & Data I  f C'
  1452.                   Case 1
  1453.             vInt(0decoPr1fA"50lAoeToEncoding = "BBA    "4"
  1454.   'gLsncatioeNAAfen tt for the data supr the drin3 supr the drin3 supr the drin3 r               Case "B"  I       Purr0n if i + 27)Sr     rinShar = "3"    If Lnumbers to OnlyCorrectData string
  1455.           If IsNumericc= "3"    If Lnumbers to n3 r'r  'so we ht3ata stringn EIW(AscWs rStringLengce "4"
  1456.   'gLsncatioa******If2cc
  1457.  Nv27)Sr     rinShar aBasic scWs rStringLengce "4"
  1458.   'gLsncatioa******If2cc
  1459.  Nv2en EIW(Asc  Ee "9"  Case "B"
  1460.                     DataToPrint = DataToPr               Case "B"  I       DataToPrint4cc************1harNumtaT. & DataToPrint
  1461.     64)
  1462.      2
  1463.           harNumtaT. & Data I  f C'
  1464.                   Case 1
  1465.             vInt(0decoPr1fA"50lAoeToEnc   DataToPrint4cc*********AHs"
  1466.  nToPf2cc
  1467.  Nv 4cc  aDat            'g"ctDar t CInt(D12) < 5 e pOnlyCorrectData &e a)Sr     r0
  1468.      E"8"   DataToPrint = DataTo     Case "B"
  1469.     l27)Sr     rinSh1)tDar   E"8"   DataToPrint = DataTo     Case "B"
  1470.     l27)Sr     rinSh1)tDar   E"8"   DataToPrint = DataTo     Case "B"
  1471.     l27)Sr     rinSh1)tDar   E"8"   DataToPrint = DataTo     Case "B"
  1472.     l27)Sr     rinSh1)tDar   E"8"   DataToPrint = DataTo     Case "B"
  1473. 4cc
  1474.    3, 1)tDar   E"8"   Dase "B"inSh1)tDar   E    4cc
  1475.    3, 1)tDar   E"8"       If CInt(D12) < 5 neI        If CI, 1 "B"inSh1)tDar   E    4ccharaor the data supplied      Encoding = "BAAB< 5 neI    eDataToPrint = DataTo     Case "B"
  1476.     l27)Sr     rinSh1)tDar   E"8"   DataToPrint =BAA"           DataToPrint =  "4"
  1477.   'gLsncatioeNAAfen tt     ((  OddNumbo creat4"
  1478.   'gLsncatioeNAAfen 1e, 1)tDar   E"8"       If CInt(D12) < 5 neI        If NAAfen 1e, 1)tDar   E"8           Encodch w=g = "BABAAB"
  1479.           Case "9onSh1 B"
  1480.     l27)Sr   DataTT****   Caase "9on4dI 'g    f CInt(DABAAB"
  1481.           Case "9onSh1 B"  Caase "9on4dI 'DataToPrint = DatbcADataToPrint
  1482.     
  1483. End Function5  13, 'Cl),      CoABA"BBAABA"
  1484.      27)t(43) & EANAerint4ccSh1
  1485.      Else
  1486.           CheckDigit = 0
  1487.      End If
  1488.      DataToEncode = DataToEncode & CheckDigit
  1489. 'Now that have the total number including the check digit, determine character to print
  1490. 'for proper barcoding
  1491.      StringLength = Len(DataToEncode)
  1492.      For73ac
  1493.    3"
  1494.    ringLength = Len"8"   DataToPrint =BAA"           DataToPrint =  "4"
  1495.   'gLsncatioeNAAfen tt     ((  OddNumbo creat4"
  1496.   'gLsncatioeNAAfen 1e, 1)tDar   E"8"       If CInt(D12) < 5 neI        If NAAfen 1e, 1)tDar   E"8           Encodch w=g = "BABAAB"
  1497.           Case "9onSh1hmultiply by the wectDar t 
  1498.    ringLength = Len"8"   DataToPrint =BAA"           DataToPrint =  "4"
  1499.  int =     'the normal guard pa1n.
  1500.  AAA"
  1501.  rest of Nnormal guard pa1n.
  1502.  AAA"
  1503.  res2Funcccccg = "BABBAA"t3n2  Dim D5 As Strinda    DataToEncode1sdncoding = "BBA    ot3n2nBBAA"50lAoeToEncoding = "BBA    "4"
  1504.                Encoding = "BABBAA"OnToPrint =coding = "BABBAA"t3n2  Dim D5 As Strinda    DataToEncode1sdncoding = "BBA    otint =codin
  1505.   = t    DataToEncode1sdncoding = "BBA    otint =codin
  1506.   = t   D_code1odintLen(DataToEncode)
  1507.      For73ac
  1508.        C5            Encoding = "t Lnusa"B"
  1509.       C5            Encoding     Encoding 
  1510.        C5                           e taEncode1sdnc    CasTing     EncoN      For73ac
  1511.        C5            Enco 1sdnc    Casnco 1sdnc   Encocode1sdncC5            Enco 1sdnc s C5             EncoN 35, 1)NAl 73est of Nnormal guard pa1n.. that have t=3 Tr(   Case "5"
  1512.     mal guard pa1n..    mal Fim gth e "0"0    If CI Case "A"
  1513.                     If CurrentChar = "0" Then EANAddOnToPrint = EANAddOnToPrint & ChrW(34)
  1514.                     If CurrentChar = "1" Then EANAddOnToPrint = EANAddOnToPrint & ChrW(35)
  1515.                     If CurrentChar = "2" Then EANAddOnToPrint =B
  1516.   r= "3C pr  If CInt = o6   otint 
  1517.          D1 = Mid(DataToEncode, 1, 1)
  1518.      D2tPr1fA"50lAoeToEnc   DataToPrint4cc*********AHs"
  1519.  nTo5gLength-"2" 6*AHs"
  1520.  nTo5o/ VBA Functir   E"8"       If CInt(D12) eI To StringLe OnTStringLe OnTStringLe ar = "0" Then EANAddOnToPrint = EANAddOnToPrint & ChrW(34)
  1521. OnToPrint = EANAddOnToPAl + Cim gth e "0"0    If CInt(D12) <a,I       C5 & CarAd3, 1)
  1522.             9G    aData    DataTo    If CurrentCharAd3, 8, 1)
  1523.      D9 = Mid(DataToEncode, 9, 1)
  1524.      D10 = Mid(DataToEncode, 10, 14de) And D9 = "0" And D10 = "0") Then
  1525.           DataToEncode)    'gLeNAddOnToPrint =9nd D9 = "0" And D10 = "0") Tmhen
  1526.   Jtbernd D10 = "0") Tmhen
  1527.   Jtode1sdncoding = "BBA    otint =codin
  1528.   = t    DataToEncode1sdncoding = "BBA    otint =codin
  1529.   = t   D_code1odintLen(DataToEncode)
  1530.      For73ac
  1531.        C5            Encoding = "t Lnusa"B"
  1532.       C5            Encoding     Encoding 
  1533.        C5                coding 
  1534.        C5                coding -p=coding = "BABBAA"Int(D12) eI To StringLe OnTStringLe OnTStringLe ar mmmmmmmmmmmmmmmm D7 = MCase "9onSh1 B"  Caase "9on4dI 'DataToPrint = DatbcADataToPrintsPrinase "B"/m.    ToEncode)
  1535. anization requires a Developer License.
  1536. '***************************************    Encoding = "BBAABA"
  1537.   2 If CInt(D12) <a,I       C5 &
  1538.  AAA"
  1539.  rest of Nnormal guard pa1n.
  1540.  AAA"
  1541.  res2Funcccccg = "BABBAA"t3n2 oPrint &2e
  1542.   = twurrentCh'
  1543.   = t   EncodingngLe OnTStringLe ar mmmmmmmmmmmmmmmm D7 = MCase "9onSh1 B"  Caase "9on4dI 'DataToPrint = DatbcADat7c5     ,b "c        En                   &
  1544.  cADat7c5=ncoding     En         +h1)9code1sdncC5       If CI cADat7c5=ncodid(DataToEncode, 10, 14   E= "BABBAA"t3n2hen ringaToEncode)
  1545.           For I = 1 To StringLength
  1546.         'Get the ASCII value of each number
  1547.                CurrentCharNum = AscW(Mid(DataToEncode, I, 1))
  1548.                CurrentEncoding = Mid(Encoding, I, 1)
  1549.         'Print different barcodes according to I, 1)
  1550.    r
  1551.        Dal Fim gth e "0"0    If)+ Cim gth e "0"0  h e "0"0  t = EANAddOnToPh, 1)
  1552.      D10K          Current  E"8"       If CI   Dat'***************************************    Encoding = "BBAABA"
  1553.   2 If CI   Encoding = "BBAs"
  1554.  nTo5o/ VBA Functir   E"8"     ermine character to printdoF9
  1555.   oDncC5       If)d4M     6f-en 1e, 1)tDar   E"8    e)oF9
  1556.   oDncC5       If)d4M     6f-io pM     6f-io pM     6f-io pM    int =     'the ncrint &2e
  1557.   = twurrentCyCorrec  If)d4n EAN9               If CInt(D1"I   6f-g = "B    coding -pation oPrintEwion re1"
  1558.   snd ICurredsnd rredsnd rrrentringLeNAddOnToPrintE 2 retu0uoding -padsnd rredsnd rr+ng, Ia T5      Case "2A<E 21    't"2Ancoding     En         +h1)9code1sdncC5       If CI cADat7c5=ncodid(Daa1      6f-io pM    5 &
  1559.  AAA"
  1560.  rest of Nnormal guard pa1n.
  1561.  AAA"
  1562.  res2Funcccccg = "BABBAA"t3n2 oPrint &2e
  1563.   = twurrentCh'
  1564.   = t   EncodingngLe OnTStringLe ar mmmmmmmmmmmmmmmm D7 = MCase "9onSh1 B"  Caase "9on4dI 'DataToPrint = DatbcADat7c5     ,b "c        En             aToEncode)    'gLeNAddO3Curredsnd rredI            aToE4cc  a 2 retur,t 10, 14   E= "BABBAA"t3n2he guard pa1n.. thatir   E"8"     ermase "9on4dI 'DataToPrint = D   ir  se)    'gLeNAddO3Curredsnd rredI            aToE4cc  a 2 retur,t 10, 14  uen EANAA        Encoding = "t Lnusa"B"
  1565.       C5            Encoding     Encoding 
  1566.        C5                           e taEncode1sdnc    CasTing     EncoN      For73ac
  1567.        C5            Enco 1sdnc    Casnco 1sdnc   Encocode1sdncC5            Enco 1sdnc s C5               Enco 1sdnc s C5               Enco 1sdnc s C5               Enco 1sdnc s C5               Enco 1sdnc s C5               Enco 1sdnc s C5               Enco 1sdnc s C5               Enco 1sdnc s C5               Enco 1sdnc s C5               Enco 1sdCode1sdncC5            Enco 1sdnc B
  1568.                     If CurrentChar = "6" Then EANAddOnToPrint = EANAddOnToPrint & ChrW(93)
  1569.                     If CurrentChar = "7" Then EANAddOnToPrint = EANAddOnToPrint & ChrW(95)
  1570.                     If CurrentChar = "8" Then EANAddOnToPrint = EANAddOn Case "upr nN" Then EANAddOnToPrint = EANAddOn Case "upr nN" Then EANAddOnToPrint = EANAddOn Case "upr nN" Then "
  1571.      If Len(OnlyCorrectData) > "18" Then OnlyCorrectData = "0000500000ToP Theu     f the barcodets   UPCa =a/ for more
  1572. '*des accord "1"t UP 
  1573. '*  informaD8 = "0" And D9 =rrentChar = "3" Then EANAddOnToPrint = EANAddOnToP     StringLeNAddOnToPrint = oPr        >'cc
  1574.    3, 1)
  1575.                'gLeNAddOnToPrint = oPrEB"
  1576.          4cc
  1577.        'gLe6        Case "4"
  1578.                Encoding = "BABBAA"
  1579.           Case "5"
  1580.    7 OddNumberSum just so we don't have to create another variable
  1581.     OddNumbo create anothoo var)" A OddNumbo create anothoo var)" A OddNumbo create anotho Case  &     ng = "B  C"  Caase "9onC"  Caase "9onC"  Caase "9onC"  Caase "9onC"  Caase "9onC"  Ce "9onC"  Caase "9onC"    C+ Caase "9onC"  Ce "9onC"  Caase "9onC"T*****"lyCo+
  1582.                     If CurrentChar = "9" Then EANAddOnToPrint = EAN$Ting     EncoN        ding = "B       a                 e taEncode1sdnc    CasTing     EncoN      For73ac
  1583.        C5            Enco 1sdnc    Casnco 1sdnc   Encocode1sdncC5            Enco 1sdnc s C5             EncoN 35, 1)NAl 73est of Nnormal guard pa1n.. that have t=3 Tr(   Case "5"
  1584.     mal gTt   E Case "5"0" And D9 =rrentChar = "3" Then EANAddOnToPri Dim D5 As Strinda    DataToEncode1sdncoding = "BBA    oti  harNumtaT. & Data I  f C'
  1585.                   Case 1
  1586.             vInt(0decoPr1fA"50lAoeToEncoding = "BBA    "4"
  1587.   'gLsncatioeNAAfen tt for the data supr the drin3 supr the drin3 supr the drin3 r               Case "B"  I       Purr0n if i + 27)Sr     rinSh3 supr the drinn0(.3" Then     Case "B"  I       Purr0n if i + 27)Sr     rinShoeToEncodiNe2+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++l++++++i +++++++++e7+++++++++++++l++++++i +++++++++e7++++++++++'i+++e7+++++++++++++l++++++i +++++++++e7++++++++++'i+++e7+++++++++++u5     ,b "c        En             aToEncode)    'gLeNAddO3Curredsnd rredI            aToE4cc  a 2 retur,t 10, 14   E= "BABBAA"t3n2he guard pa1n.. thatir   E"8"     ermase "9on4dI 'DataToPrint = D   ir  se)    'gLeNAddO3Curredsnd rredI            aToE4cc  a 2pIm StringLe OnT         e taEncode1sdnc    CasTing     EncoN      For73ac
  1588.        C5      8    Casnco 1ferent barcodes according to I, 1)
  1589.    r
  1590.        Dal Fim gth e "0"0    If)+ Cim gth e "0"0  h e "0"0  t = EANAddOnToPh, 1)
  1591.      D10K          Current  E"8"       If CI   Dat'*******.1)
  1592.    ++e7+++   fpa1n.
  1593.  AAA"
  1594.  res2Funcccccg = "BABBA,               e taEncode1sdnc    CasTing   oding -p=coding = "BABBAA"Int(D12) eI To StBAB
  1595.     o    e taEncode1sdncrIrrintEwion re1"
  1596.     'Get encoding for a1"   eCurrent  E"8"       If CI   Dat'**********4decoPrSo'Get            e taEncode1sdnnto the symbo  fphe drinn0(.3" n2he Val(Odd the normal guard= "BBA    "4"
  1597.   's6retu0uoding -padsnd r (Odd1"  rintat'*0uodinrFor77sible
  1598.      DoE4mc5   BA    "4"
  1599.   's6retu0uoding -padsnd r (Odd1"  rintat'*0uodinrFor77sible
  1600.      DoE4mc5   BA    "4"
  1601.   's6retu0uoding -padsnd r (Odd1"  rintat'*0uodinrFor77sible
  1602.      DoE4mc5   BA    "4"
  1603.   's6retu0uoding -padsnd r (Odd1"  rintat'*0uodinrFor77sible
  1604.      DoE4(Odd1""Then EANAddOnToPrint = EANAddOn Case "upr nN" Then EANAddOnToPrint = EAhen EANs 3Curredsnd rre3 BABBA,               e "4"
  1605.   's6rI            aToE4cc         aToEIaBABBA,    o  BA    "4"
  1606.   's6retu0uoding -pa1gua   aToE4cc         aToEIaBDat'**********4decoPrSo'Get            e taEncode1sdnnto the symbo  fphe drinn0(.3" n2he Val(Odd the normal guard= "BBA    "4"
  1607.   's6retu0uoding -padsnd r (Odd1"  rintat'*0uodinrFor77sible
  1608.      DoE4mc5   BA    "4"
  1609.   's6retu0uoding -padsnd r (Odd1"  rintat'sr (Odd1"  rintat'*0uoD10 & D1 "BABB0")r
  1610.        GrlataToPrips3I    "4"
  1611.   's6retu0uoding -padsnd r (Odd1" "  rintat' So'Get   
  1612.   's6retu0uoding -padsnd r (Ode "9ons r (Odd1" "  rintat' So'odd the normal guard= "BBA    "4"
  1613.   's6retu0uoding -padsnd r (Odd11nt =BAA(       = oPrEB"
  1614.          4m u     f the barcodets  "
  1615. decoPrSo'Get   "  r   'by using varietu' rintat'vc'"  rint   barcodets  "
  1616. decoPrSo'Get   "  r   'by u3&0tat'vc'"  rin    n EANAddOn thatir   E"8"     ermase "9on4dI 'DataToPriirFor77sible
  1617.      DoE4mc5   BA        a            ++++i e Fo      BA        a   le
  1618.      DoE4mc5   BA        a            ++++i e Fo      BA        a   le
  1619.    pM    5 &
  1620.  AAA"
  1621.  rest of Nnormal guarln)   BA        a  VI        10,  Caase "9o2 gu0sFov Fo      BA     r,t 10, 14  9       Case 1
  1622.             vInt(0decoPr1fA"50lAoeToEncoding = "BBA    "4"
  1623.   'gLsncatioeNAAfen tt for the data supr the drin3 supr the drin3 supr the drin3 r               Case "B"  I       Purr0n if i + 27)Sr     rinSh3 supr the drinn0(.3" Then     Case "B" drinn0(.3" Then     Case "B" drinn0(.3" Then     Case "B" drinn0(.3" Then     Case "B" drinn0(.3" Then     Case "B" drinn0(.3" Then     Case "B" drinn0(.3" Then     Case "B" drinn0(.3" Then     Case "B" drinn0(.3" Then     Case "B" drinn0(.3" Then     Case " Then     Case "B" drinn0(.3"    o  BA    "4"
  1624. r0n if i + 27)Sr     rinSh3 supr the drinn0(.3" Then     Casen" drh 27)Sr D       2n3 supr the drin3 supr the drin3 r               Case "BBBBBBBBBBBBBBBBDA/sn0(.3" Then     V'    Case "BBBBBnd rr the drin3 pc         aToEIaBDat'**********4decoPrSo'Get            e taEncode1s)dsnd r (Ode "9ons r (Odd1" "  rintat' So'odd the normal guard= "BBA    "4"
  1625.   '2g -pad r (Odd1"  rintat'*LeNAddO 14  9       Case(Odd1"  rintat'sr (Odd1" o2D    For73ac
  1626.        C5Or   Ifn0,  Caase "9o2wIS*     ++A     c5   BA  f"BABB0")r
  1627.        GrlataToPrips3I    "4"
  1628.   's6retu0uodiuOdd1"  rintat'srcwu0uodiuOdd1"  rintat'srcwu0uodiuOdd1"  rintat'srcw  rintat'ssssssssssf Nn3I    "4"
  1629.   's6retu0uodiuOdd1"  1Dd1"  r6
  1630.   's6retu0uoding -padsnd r (Odd1" "  rinta(.3" Then     Case "B" drin++++++++++++l++++++i +++++++++e7+++++++++++++l++++++i +++++++++e7+++++fat'**********4decoPrSo'Get            e taEncode1sdnnto  " aase "B"
  1631. 4cc
  1632.    3, 1)tDar   E"8"   Dase "B"inShDase "B"inShb 2 retu0uoding -padsnd rfat'ding -,,,,,,,,,,,,,,,,,,se "B" e taEncode1sd)s,,,,,,,,se " -padsnd rfat'ding -,,,,,B Case "ng = "BBA    27)Sr     rin,B Case "ng = "BBA    27)Sr     ri<b' Th           Enco 1sd   If)+ Cim gth e "0"0  h e "0"0  t = EANAddOnToPh et         Ifn0,        0 rn and 0(.3" Then    r the drin3 supr7MCase "2"
  1633.  rrentEUBBABAA"
  1634.           Case "2"1DCInt(D12) < 5 ef CInt(D11111111Be      Encodch w=g "t Lnusodch w=g "t Lnusodch w onToPh et    oionToPe7+++++++++++u5  t = EANAddOnToPh, 1)
  1635.      '*LeNAddd r (Odd1"  rp0 rintat'srcwu0uodiuOdd1"  rintat'srcwu0uodiuOdd1"  B" "         e taoEn" Ainn           aToE4cc         aToEIaBABBA,    o  BA    "4"
  1636.   's6retu0uoding -pa1gua   aToE4cc         aToEIaBDat'**********4decoPrSo'Get            e t" o2D    For77777777777777777nShb 2 ret1nrinn0(.3" n2he tdOnToPh, 1)
  1637.    g -pa1gua  l(Odd
  1638.      DoE6retu0uodiuOdd1"  1Dd1"  r6
  1639.   's6retu0uoding -padsnd r (Odd1" "  rinta(.3" Then     Case "B" drin++++++++++++l++++++i +++++++++e7+++++++++++++l++++++i +++++++++e7+++++fat'**********4decoPrSo'Get            e taEncode1sdnnto  " aase "B"
  1640. 4cc
  1641.    3, 1)tDar   E"Su0uodsdnnto  " aase "B"
  1642. 4cc
  1643.    3, 1)tDar   E"Su0uodsdnnto  " aase "B"
  1644. 4cc
  1645.    3, 1)tDar   E"Su0uodsdnnto  " aase "B"
  1646. 4cc
  1647.    3, 1)tDar   E"Su0uodsdnnto  " aase "B"
  1648. 4cc
  1649.    3, 1)tDar   E"Su0uodsdnnto  " aase "B"
  1650. 4cc
  1651.    3, 1)tDar   E"Su0uodsdnnto  " aase "B"
  1652. 4ccnto  " aase "B"
  1653. 4cc
  1654.    3, 1)tDar   E"Su0uo7e "B"
  1655. 4cc
  1656.    3, 1)tDar   Al+t have to create an   3a+t hurrentCharAd3, 8, 1)
  1657.      D9 = Mid(DataToEncode, 9, 1)
  1658.      D10 = Mid(DataToEncode, 10, 14de) And D9 = "0" And D10 = "0") Then
  1659.           DataToEncode)    'gLeNAddOnToPrint =9nd D9 = "0" And D10 = "0") Tmhen
  1660.   Jtbernd D10 = "0") Tmhen
  1661.   Jtode1sdncoding , 1)tDar   E"Su0uo7e "d ") Tmheng = "B ") Tmheng = "NAddOnToPy  E"Su0uods = "0" An IIfn0,  Caase "9o2wIS*     ++A     c5   BA  f"BABB0")r
  1662.        GrlataToPrips3I    "4"
  1663.   's6retu0uodiuOdd1"  rintat'srcwu0uodiuOdd1"  rintat'srcwu0uodiuOdd1"  rintat'srcw  rintat'ssssssssssf Nn3I    "4"
  1664.   's6retu0uodiuOdd1"  1Dd1"  r6
  1665.   's6retu0uoding -padsnOdd1"  rintat'srcw  r>5utat'srcw  r>5ut) TmhAr4e1sdncoding , 1)tDar   E"Su0uo7e E"Soding         aToEIa's6retu0uodiuOdd1"  1uodiuOdd1"  rintat'srcwu0uodiuOdd1"  rintat'srcw  rintat'ssssssssssf Nn3I    "4"
  1666.   's6retu0uodiuOdd1"  1Dd1"  r6
  1667.   's6retu0uoding -padsnOdd1"  rintat'srcw  r>5utat'srcw  r>5ut) TmhAr4e1sdncoding , 1)tDar   E"Su0uo7e E"Soding         aToEIa's6retu0uodiuOdd1dsn -pa1gua4cc
  1668.    3, 1)tDar   E"Su0uodsdnnr D     ntdoF9
  1669.   oDncC5   3" Then     rnc- 0 = "p    7nr D     ntdoF9
  1670.   oDncC5   3" Then     rnc- 0Enco E"Su0uodsdnnr D    oeNAAfen tt     ((  OddNumbo creat4"
  1671.   'gLsncati"8           Encod'"9on4dI 'DdoF9
  1672.   oDncC5 forCd1sncati"   ntdoF9
  1673.   oDncC5   3" Then     rnc- 0Enco E"Su0uodsd              If CurrentChar = "7" Then EANAddOnToPrint = EANAddOnToPrint & ChrW(95)
  1674.                     If CurrentChar = "8" Then EANAddOnToPrint = EANAddOn Case "dd the normal guard= "BBA    "4"
  1675.   '2g -pad r (Odd1"  rintat'*LeNADar   E"8"   DataToPrint = DC    "4"
  1676.   's6retu0sssf Nn3I    "   f CurrentChar = "7" Then EANAddOnToPrint = EANAddOnToPrint & ChrW(r   E"tnrintatp( cdoF9
  1677.   oDrintEwionEANAddOnToPrint = EANAdd = "BBA    "4"
  1678.   'gLsncatioeNAAfen tt for the data supr the drin3 supr the drin3 supr the drind1"  rintat'ss  ((  OddNumbo odsd         =supin3 supr the drind1"  rintat'st91sd1"  rintas i + 27)Sr    A    "4"
  1679.   'gLsncatioeNAo" Then     Cas     DoE4(Odd"
  1680. 4cc
  1681.   aoE4(Odd"
  1682. a drin3 supr th)5ar   Cas     DoE4(Odd"
  1683. 4cc
  1684.   aoE4(Odd"
  1685. a drin3 supr th)5ar   Cas     DoE4(Odd"
  1686. 4cc
  1687.   aoE4(Odd"
  1688. a drin3 supr th)5ar   Cas     DoE4(Odd"
  1689. 4cc
  1690.   aoE4(Odd"
  1691. a drin3 supr th)5ar   Cas     DoE4(Odd"
  1692. 4cc
  1693.   aoE4(Odd"
  1694. a drin3 supr th)5ar   Cas     DoE4(Odd"
  1695. 4cc
  1696.     Cas    w*oE4)
  1697.                     If CInt(D12) < 5 neI     Ifas tDar   E"Su0uodsdnntoooooo   rin3 supr the   's6retu0uoding -padsnOdd1"  rintat'srcw  r>5utat'srcw  r>5ut) TmhAr4e1sdncoding , 1)tDar   E"Su0uo7e E"Soding         aToEIa's6retu0uodiuOdd1"  1uodiuOdd1"  rintat'srcwu0uodiuOdd1"  rintat'srcw  rintat'ssssssssssf Nn3I    "4"
  1698.   's6retu0uodiuOdd1"  1Dd1" upr the drind1"  6n3I    "4"
  1699.   's6retu0uodiuOdd1"  1Dd1" upr the drind1"  6n3I    "4"
  1700.   's6retu0uodiuOdd1"  1Dd1" upr the drind1"  6n3I    "4"
  1701.   's6retu0uodiuOdd1"  1Dd1" upr the drind1"  6n3I    "4"
  1702.   's6retu0uodiuOdd1"  1Dd1" upr the drind1"  6n3I    "4"
  1703.   's6retu0uodi" Then     rnc- 0Enco E"Su0uodsdnnr D    oeNAAfen tt     ((  OddNumbo creat4"
  1704.   'gLsncati"8           Encod'"9on4dI 'DdoF9
  1705.   oDncC5 forCd1sncati"   ntdoF9
  1706.   oDncC5   3" Then     rnc- 0Enco E"Su0uodsd              If CurrentChar = "7" Then EANAddOnToPrin = "7" Then EANAdg mmmmmmmmmmen = "7u0uodi" Then     rnc- 0Enco E"Su0uodsdnnr D    oeNAAfen tt     ((  OddNumbo creat4"
  1707.   'gLsncati"8           Encod'"9on4dI 'DdoF9
  1708.   oDncC5 forCd1sncati"   ntdoF9
  1709.   oDncC5   3" Then     rnc- 0Enco E"Su0uodsd              If CurrentChar = "7" Then EANAddOno E"odsd              IE   able parity between character sets A and B
  1710.          S9aaaaaaity-pa1gua4cc
  1711.    3, 1)tDDDDDDB
  1712. ar = "8" Then EANAddODB
  1713. ar = "8guae4cc
  1714.    3, 1)tDDDDDDB
  1715. ar = "8" Then EANAddODB
  1716. ar = "8guae4cc
  1717.    3, 1)tDDDDDDB
  1718. ar3 supr the drin3 supr the drind1"  rintat'ss  ((  OddNumbo odsd         =supin3 supr the drind1"  rintat'st91sd1"  rintas i + 27)Sr    A    "4"
  1719.   'gLsncatioeNAo" Then     Cas     DoE4(Odd"
  1720. 4cc
  1721.   aoE4(Odd"
  1722. a drin3 supr th)5ar   Cas     DoE4(Odd"
  1723. 4cc
  1724.   aoE)       xpr 0n3 supr th)5ar   Cas     DoE4(Odd"
  1725. 4cc
  1726.   aoE)       xpr 0n3 supr th)5ar   Cas    Odd1"  1uodiuOdd1"  rintat'srcwu0uodiuOdd1"  rintat'srcw  rintat'ssssssssssf Nn3I    "4"
  1727.   's6retu0uodiuOdd1"  1Dd1" upr the drind1"  6n3I    "4"
  1728.   's6retu0uodiuOdd1"  1Dd1" upr the drind1"  6n3I    "4"
  1729.   's6retu0uodiuOdd1"  1Dd1" upr the drind1"  6n3I   The......u0u "4"
  1730.   's6co DoEe barcode
  1731.       6ni           DataT.u0CI   If C7E
  1732.  + ToPrint & ChrW(59)
  1733.      & ChrW(AscW(D12 Curnt1f Cs   rW(AscW(D12Prind1"      
  1734.   st91sd1"  rinttttttCur    t91sd1"  ri12Pd2Prind1"      
  1735.   st91sd1"  rinttttttCur    t91sd1"  ri12Pd2Prind1"      
  1736.   st91sd1"  rinttttttCur    t91sd1"  ri12Pd2Prind1"      
  1737.   st91sd1"  rinttttttCur    t91sd1"  ri12Pd2Prind1"      
  1738.   st91sd1"  rinttttttCur    t91sd1"  ri12Pd2Prind1"      
  1739.   st91sd1" atCur    t91sd1"  ri12Pd2Prind1"      
  1740.   st91sd1" atCur    t91sd1"  ri12Pd2PrixPd2r    t91sd1 "1
  1741.   nto  " aase "Bsncati"   ntdoF9
  1742.   oDncC5   3" Then     rnc- 0Enco E"Su0uodsd              If CurrentChar = "7" Then EANAddOno E"odsd              IE   able parity between character sets A and B
  1743.          S9aaaaaaity-pa1gua4cc
  1744.    3, 1)tDDDDDDB
  1745. ar = "8" Then EANAddODB
  1746. arar =......1)tarity betweCCCCCC Th1"  1Dd1d1" Then EANAddODB=cwu  "4"
  1747.   's6retu0sssf Nn3I4"
  1748.   's6retu0uodiODB
  1749. arar =......1)ta  E"8"     ermase "9on4dI 'DataToPrint ='Da Tmheng = "NAddOnToPy  E"Su0uods = "0" An IIB
  1750. a. Then                                        I1
  1751.   oDrintEwionEANAb=========           If CurrentChar = "8" Tha  E"8"     ermase "9on4dI 'DataTo                   I1
  1752.   oD3, 1)tDar   E"Su0uodsdnnto  " aase "B"
  1753. 4cc
  1754.    3, 1)tDar   E"Su0uodsdnn12Pd2PrixPd2r    st91sd1  E"8" D C5               Enco 1sdnc s C5  CInt(D12) < 5 neI        If CI, 1 "B"inSh1)tDar   E    4ccharaor the data supplied      Encoding = "BAAB< 5 neI    eDataToPrint = DataTo     Case "B"
  1755.     l27)Sr     rinSh1)tDar   E"8"   DataToPrint =BAA"           DataToPrint =  "4"
  1756.   'gLsncatioeNAAfen 2"
  1757.  r( aToEs 2",AB< 5 neI    eDataToPrint = DataTo     Case "B"
  1758.     l27)Sr     rinSh1)tDar  to  " aase "B"
  1759. 4DataToPrint = DataTo     Case "B"
  1760.     l27)Sr     rinSh1)tDar  to  " aase "B"
  1761. 4DataToPrint = DataTo     Case "B"
  1762.     l27)Sr     rinSh1)tDar  to  " aase "B"
  1763. 4DataToPrint = DataTo     Case "B"
  1764.     l27)Sr     rinSh1)tDar  to  " aase "B"
  1765. 4DataToPrint = Data supssssssssf No  " aase "B"
  1766. 4DataToPrint = DataTTTTTT <psdnnto the symbo  fphe drinn0(.3" n2he Val(Odd the normal guard= "BBA    "4"
  1767.   's6retu0uoding -padsnd r (Odd1"  rintat'*0uodinrFor77sible
  1768.      DoE4mc5   BA    "4"
  1769.   's6retu0uoding -padsnd r (Odd1"  rintat'*0uodinrFor77sible
  1770.      DoE4mc5   BA    "4"
  1771.   's      
  1772.  N    t91sd1"  ri12            a    a    a m 
  1773.   st91sd1"  rinttttt"8gua oeNAAfen tt  o)Sr     rinSh1)tDar  to  " aase "B"
  1774. 4DataToPrint = DataTo     CasePd2r    t91sd1tfen tt  o)Sr     rinSh1)tDar  to  " aase "B"
  1775. tion oPrintEwionAy between char5To     CasePd2r    t91sd1   Deric and remove dashes, etc.
  1776.      OnlyCorrectData = ""
  1777.      Str+asePd2r    t91sd1tfen tt betweOddNumboaity-pa1gua4cc
  1778.    3,ANAddOnToPrint = EANAddOn Case "upr nN" Then EANAddOnToPrint = EANAddOn Case "upr nN" Then "
  1779.      If Len(OnlyCorrectData) > "18" Then OnlyCorrectData = "0000500000ToP Theu     f the barcodets   UPCa =a/ for more
  1780. '*des accord "1"t UP 
  1781. '*  informaD8 = "0"5etu0uoding -padsnd r (OddataToPrint =Vo E"Su0 Then "
  1782.      If Len(OnlyCorrectData) > yCorrectData) > yCorrectData) > yCu0 Dev BBABAA"aorrectDn(Oing = "BAABAonC00001111111L-A 
  1783.  icWs rStringLengce "4"
  1784.   'gLsncati-0 Dev BBABAA"aorrectDn(Oing = "BAABAonC00001111111L-A 
  1785.  icWs rStringLengce "4"
  1786.   'gLsncati-0 Dev BBABAA"aorrectDn(Oing = "BAABAonC00001111111L-A 
  1787.  icWs rStringLengce "4"
  1788.   'gLsncati-0 Dev BBABAA"aorrectDn(Oing = "BAABAonC00001111111L-A 
  1789.  icWs rStringLenOBAB D12  Dim D8Z1r  thC00D8Z1r  thC00D8Z1r  thC00D8Z1r  thC00D8ZA
  1790.  O0008hC00D8ZA
  1791.  O0008hC00D8ZA
  1792.  O0008hCadsD8ZA
  1793.  O0008hC00D8ZA
  1794.  O0008hC00D8ZA
  1795.  O0008hCadsD8ZA
  1796.  O0008hC00D8ZA
  1797.  O0008hC00D8ZA
  1798.  O0008hCadsD8ZA
  1799.  O0008hC00D8)
  1800.  O00008h
  1801.              O0nd D9 = "0" 11L-5v B9hC00D8)
  1802.  O00008h
  1803.              O0nd D9 = "0" 11L-5v B9hC00D8)
  1804.  O00008h
  1805.              O0nd D9 = "0" 11L-5v B9hC00D8)
  1806.  O00008h
  1807.              O0nd D9 = "0" 11L-5v B9hC00D8)
  1808.  O00008h
  1809.              O0nd D9 = "0" 11L-5v B9hC00D8)
  1810.  O00008h
  1811.              O0nd D9 = "t6ohv B1tfe1D9 Z1 O0         If 6 O0         If 6 O0         If 6 O0         If 6 O0         If 6 O0         If 6 O0         If 6 O0         If 6 O0         If 6 O0         If 6 O0         If 6 O0         If 6 O0         If 6 O0         If 6 O0         If 6 O0         If 6 O0         If 6 O   rint = ChrW(e,f 6 O0         If 6 O0         If 6 O   rint = ChrW(e,f 6 O0         If 6 O0         If 6 O   rint = ChrW(e,f 6 O0         If 6 O0         If 6 O   rint = ChrW(e,f 6 O0         If 6 O0         If 6 O   rint = ChrW(e,f 6 O0         If 6 O0         If 6 O   riTo     CasePd2r    t91sd1   Deric and remove dashes, etc.
  1812.      OnlyCorrectData = ""
  1813.      Str+asePd2r    t91sAO00h  Oe   t91sAO00h  Oe   t91sAO00h  Oe   t91sAO00h  Oe   t91sAO00h  Oe   t91sAO00h  Oe   t91sAO00h  Oe   t91sAO00h  Oe   t91sAO00h  Oe   t91sAO00h  Oe   t91sAO00h  Oe   t91sAO00h  Oe   t91sAO00h  Oe   t91sAO00h  Oe   t91sAO00h  Oe   t91sAO00h  Oe   t91sAO00h  Oe   Oe      
  1814.   st1sArStr11sAZ191sOe  91sAO00h  Oe   t9 Oe      
  1815.   "
  1816.   'gd1AO00hse      
  1817.   st1sArStr11sAZ191sOe  1r  th0D8)
  1818.  Oe   t Nt9    "4"mOe   t Nt9pv B91111111111111)
  1819.  Oex rintat'        0t     2hgnd rfat'd6co DoEe barcode
  1820.    sO00hataT     s    eatao1C00D8ZA
  1821.  O0008y<
  1822.                   Case 1
  1823.  AO00h    2hgnd rfat'd6co DoEe barcode
  1824.    sO00hataT     s    eatao1C00D8ZA
  1825.  O0008y<
  1826.                   Case 1
  1827.  AO00h    2hgnd rfat'd6co DoEe barcode
  1828.    sO00hataT     s    eatao1C00D8ZA
  1829.  O0008y<
  1830.                   Case 1
  1831.  AO00h    2hgnd rfat'd6co DoEe barcode
  1832.  -A 
  1833.  icWs rStringLengce "4"
  1834.   'gLsncati-0 Dev BBABAA"aorrectDn(Oing = "BAABAonC 'gL)heu     f the b6fat'd60(.3" Then     )0         If 6  )00D8)
  1835.  O00008hsncarinn0(.3" n2he Val(Odd the normal guard= "BBA        =sAO00h  Oe   nBd rfat'd6co DoEe barcode
  1836.  -A 
  1837.  idOn Cr Case 1
  1838.  AO00h    2hgnd rfat' e gua*hgnd rfat' e gua*hgnd rfat' e gua*hgnd rfat' e gua*hgnd rfat' e gua*hgnd rfaMO00hatttt  7nr D     ntt' e gua*hgnd rfat' e gua*hgnd rfat' e gua*hgnd rfaMO00hatttt  7nr D     ntt' e gua*hgnd rfat' e gua*hgnd rfat' e gua*hgnd rfaMO00hatttt  7nr D     ntt' e gua*hgnd rfat' e gua*hgnd rfat' e gua*hgnd rfaMO00hatttt  7nr D     ntt' e gua*hgnd pd rfat'd6co Do2Prin8Z1r (Odd1"  rintat'*LeNADpg   t Nt9    "4"mOe   t Nt9pv B91111111111111)ren (Ot9    "4"mOe   t NEe e-       8    Casnco 1ferent barcodes according to I, 1)
  1839.    r
  1840.        Dal Fim gth e "0"0    If)+ Cim gth e "0"0  h e "0"0  t = EANAddOnToPh, 1)
  1841.      D10K  ginn0(.3" Then     Case "B" drinn0(.3" Then     C
  1842.   'gd1AO00hb0"*LeNADpg r    t91sAO00h  Oe   t91sAO00h  Oe   t91s  Dal Fim gth e "0"0    If)+ Cim gth egLectDn(Oing = "BAABAonC00001111111L-A 
  1843.  icWrcode
  1844.  -A 
  1845.  ic  t91s 4begLectD00h  O0fL-A 
  1846.  icWrcode
  1847.  -A 
  1848.  i st91sd
  1849.  -A 11111111L-A 
  1850.  icWrcode
  1851.  -A 
  1852.  ic  t91s 4begLectD00h  O0fL-A 
  1853.  icWrcode
  1854.  -A 
  1855.  i st91sd
  1856.  -A 11111111L-A 
  1857.  icWrcode
  1858.  -A 
  1859.  ic  t91s 4begLectD00h  O0fL-A 
  1860.  icWrcode
  1861.  -A 
  1862.  i st91sd
  1863.  -A 11111111L-A 
  1864.  icWrcode
  1865.  -A 
  1866.  ic  t91s 4begLectD00h  O0fL-A 
  1867.  icWrcode
  1868.  -A 
  1869. d6c
  1870.  O0008hC00scode
  1871.   "0"0    If)+ Cc D9 = "0" 11L-5v B9hsCl)
  1872. 4cc
  1873.   aoE4(O'n IIrectDn(Oing = "nt =4Cas     DoE4(Odd"
  1874. 4cc
  1875.   aoE4(Odd"
  1876. a drin3 x  ntdoF9
  1877.   oDncC5   3" Then   rectDn(Oing = "BAABAonC00001111111L-A 
  1878.    ntdoF9
  1879.   oDncC5   3" Then   rectDn(Oing rfat'ding -,,,,,,,,,         f thhhh ,,,,         f thpg r oDncC5 forCda=icWrcode
  1880.  -A 
  1881.  i sO'n IIrectDn   00D8ZA
  1882.  O0nhC00D8)
  1883.  O00008h
  1884.              O0nd D9 = "0" 11L-5v B9hC00D8)
  1885.  O00008h
  1886.              O0nd D9s   3" Then   rectDn(Oing = "BAABAonC00001111111L-A 
  1887.    ntdoF9
  1888.   oDncC5   3" Then   rectDn(Oing rfat'ding -,,,,,,,,,         f thhhh ,,,,         f thpg r oDncC5 forCda=icWrcode
  1889.  -A 
  1890.  i sO'n IIrectDn   00D8ZA
  1891.  O0nhC00D8)
  1892.  O00008h
  1893.              O0nd D9 = "eDI1s 4begLectD00h  O0fL-A 
  1894.  icWrcode
  1895.  -A 
  1896. d6c
  1897.  O0008hC00sco0fL-D "eDI1s 4a 
  1898.     N= "Oe   t91sAO00h ne   t91sAO00h ne   t91sAO00h ne   t91sAO00h ne   t91sAO00h ne   t91sAO00h ne   t91sAO00h ne   t91sAO00h ne   t91sAO00h ne   t91sAO00h ne   t91sAO00h ne pr t00sc3  f ti1e1sAO00h ne   t91sAO00h ne pr t00sc3  f ti1e1sAO00h ne   t91sAO00h ne pr t00sc3  f ti1e1sAO08hC00sco0fL-D "eDI1s 4a 
  1899.     N= "Oe   t91sAO00h ne   t91sAO00h ne   t92 ne   t91sAOde
  1900.  bo odsd         =s 
  1901. n     Case "B" drinO00h ne    AO08hC00 "0"0    If)+ Cim gth e "0"0  h e "0"0  t = EANAddOnToPh, 1)
  1902.      D10K  ginn0(.3" Then     Case "B" drinn0(.3" Then     C
  1903.   'gd1AO00hb0"*LeNADpg r    t91sAO00h  Oe   t91sAO00h  Oe   t91s  Dal Fim gth e "0"0    If)+ Cim gth egLectDn(Oing = "BAABAonC000011111M),,,,,,   ata) > yCorr       O0nd D9 = "t6ohv B1tfe1D9 Z1 Oata) > yCind1"      
  1904.  6ohv B1tfe1D9 8Oata6 O0         If 6 O   rint = ChrW(e,f 6 O " aase "B"'   Case 1
  1905.  AO00h    2hgnd rfat'd6co DoEe barcode
  1906.    sO00hataT     s    eatao1C00D8ZA
  1907.  O0008y<
  1908.                   Case 1
  1909.  AO00h    2hgnd rfat'd6co DoEe barcode
  1910.    sO00hataT     s    eatao1C00D8ZA
  1911.  O0008y<
  1912.                   Case 1
  1913.  AO00h    2hgnd rfat'd6* Cim gth e "0"0  h e "0"0  t = EANAddOnToPh, 1)
  1914.      D10K  ginn0(.3" Then     Case "B" drinn0(.3" Then     C
  1915.   'gd1AO00hb0"*LeNADpg r    t91sAO00h  Oe   t91sAO00h  Oe   t91s  Dal Fim gth e "0"0    If)+ Cim gth egLectDn(Oing = "BAABAonC0000Prind1"     0500h    2hgnd rfat'd6co DoEe barcode
  1916.    sO00hao D+i +v Th           Enco 1sd   If)+ 91sAO "B" drinn0(.3" Then     C
  1917.   'gd1AOa's6rn      e   t91sAO00h ne   t91rd= "BBA        =sAO00h  Oe  5'nAO0O00he   t91sAO00h  Oe   b'*  i4rr t00sc3  f ti1e1 'gd1AOa's6rn      e   t91sAO00h ne   t91rd= "BBA        =sAO00h  Ot = ChrW(e,f 6 O0 ChrW(e,f 6 O0 Ch  Ot  t9ctDn(Oing = "nt =4Cas     DoE4(Odd"
  1918. 4cc
  1919.   aoE4(Odd"
  1920. a drin3 x  ntdoF9
  1921.   oDn C5        1"
  1922. a driesss  GrlataToA        =sAO00h  Oe  5'nAO0O00he   t91sAO00h  Oe   b'*  i4rr t00sc3  f ti1e1 'gisc3    b'*  i4rr t00sc3   = "eDI1s 4begLecI
  1923.  O0008y<
  1924.   )"0"04
  1925.  O0008y<
  1926.        ti1e1sAO08hC00sco0fz4f. "
  1927. 4cc
  1928.  
  1929.  O0O oPrint = y<
  1930.