Tek-Tips is the largest IT community on the Internet today!
Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!
-
Congratulations Chris Miller on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!
Barcodes 1
- Thread starter Gootz11
- Start date
you can concatenate your data into the format you want. what exactly are you trying to accomplish? If you want more help you have to provide more details.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ222-2244
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ222-2244
- Thread starter
- #3
-
1
- #5
The font idea will work ok on most computers but I have had some problems with it. I found the following code works much better. Just creat a new module and past this in it. Then follow the instructions for adding the barcodes to your reports.
Option Compare Database 'Use database order for string comparisons
Option Explicit
'
' mod_BarCode_Generator_Code39
'
' Barcode Generator for Code 3 of 9, Code 39, and Mil-spec Logmars.
'
' version 2.0 (updated for MsAccess 97)
'
' (c) 1993-1999 James Isle Mercanti, Cocoa Beach, FL 32931 USA
' Permission granted for public use and royalty-free distribution.
' No mention of source or credits is required. All rights reserved.
'
' TO USE THIS CODE:
'
' 1 - Create Report with a TextBox control. (example named Barcode)
' Make sure the Visible property is set to "No".
' 2 - Set On-Print property of section to [Event Procedure]
' by clicking on the [...] and selecting "Code Builder"
' 3 - Confirm that the following code matches yours...
'
' Sub Detail1_Print (Cancel As Integer, PrintCount As Integer)
'
' Result = MD_Barcode39(Barcode, Me)
'
' End Sub
'
' 4 - NOTE: The name of the section is "Detail1" for example only!
' Your section might show a different name. Ditto for "Barcode".
'
' 5 - NOTE: To use on sub-forms, the Report name should be hard-coded
' into the function. i.e. Rpt = Reports!MainForm!SubForm.Report.
' The easy method is to just avoid using sub-forms and sub-reports.
'
Function MD_Barcode39(Ctrl As Control, rpt As Report)
On Error GoTo ErrorTrap_BarCode39
Dim Nbar As Single, Wbar As Single, Qbar As Single, Nextbar As Single
Dim CountX As Single, CountY As Single, CountR As Single
Dim Parts As Single, Pix As Single, Color As Long, BarCodePlus As Variant
Dim Stripes As String, BarType As String, Barcode As String
Dim Mx As Single, my As Single, Sx As Single, Sy As Single
Const White = 16777215: Const Black = 0
Const Nratio = 20, Wratio = 55, Qratio = 35
'Get control size and location properties.
Sx = Ctrl.Left: Sy = Ctrl.TOP: Mx = Ctrl.Width: my = Ctrl.Height
'Set handle on control.
Barcode = Ctrl
'Calculate actual and relative pixels values.
Parts = (Len(Barcode) + 2) * ((6 * Nratio) + (3 * Wratio) + (1 * Qratio))
Pix = (Mx / Parts):
Nbar = (20 * Pix): Wbar = (55 * Pix): Qbar = (35 * Pix)
'Initialize bar index and color.
Nextbar = Sx
Color = White
'Pad each end of string with start/stop characters.
BarCodePlus = "*" & UCase(Barcode) & "*"
'Walk through each character of the barcode contents.
For CountX = 1 To Len(BarCodePlus)
'Get Barcode 1/0 string for indexed character.
Stripes = MD_BC39(Mid$(BarCodePlus, CountX, 1))
For CountY = 1 To 9
'For each 1/0, draw a wide/narrow bar.
BarType = Mid$(Stripes, CountY, 1)
'Toggle the color (black/white).
If Color = White Then Color = Black Else Color = White
Select Case BarType
Case "1"
'Draw a wide bar.
rpt.Line (Nextbar, Sy)-Step(Wbar, my), Color, BF
Nextbar = Nextbar + Wbar
Case "0"
'Draw a narrow bar.
rpt.Line (Nextbar, Sy)-Step(Nbar, my), Color, BF
Nextbar = Nextbar + Nbar
End Select
Next CountY
'Toggle the color (black/white).
If Color = White Then Color = Black Else Color = White
'Draw intermediate "quiet" bar.
rpt.Line (Nextbar, Sy)-Step(Qbar, my), Color, BF
Nextbar = Nextbar + Qbar
Next CountX
Exit_BarCode39:
Exit Function
ErrorTrap_BarCode39:
Resume Exit_BarCode39
End Function
Function MD_BC39(CharCode As String) As String
On Error GoTo ErrorTrap_BC39
ReDim BC39(90)
BC39(32) = "011000100" ' space
BC39(36) = "010101000" ' $
BC39(37) = "000101010" ' %
BC39(42) = "010010100" ' * Start/Stop
BC39(43) = "010001010" ' +
BC39(45) = "010000101" ' |
BC39(46) = "110000100" ' .
BC39(47) = "010100010" ' /
BC39(48) = "000110100" ' 0
BC39(49) = "100100001" ' 1
BC39(50) = "001100001" ' 2
BC39(51) = "101100000" ' 3
BC39(52) = "000110001" ' 4
BC39(53) = "100110000" ' 5
BC39(54) = "001110000" ' 6
BC39(55) = "000100101" ' 7
BC39(56) = "100100100" ' 8
BC39(57) = "001100100" ' 9
BC39(65) = "100001001" ' A
BC39(66) = "001001001" ' B
BC39(67) = "101001000" ' C
BC39(68) = "000011001" ' D
BC39(69) = "100011000" ' E
BC39(70) = "001011000" ' F
BC39(71) = "000001101" ' G
BC39(72) = "100001100" ' H
BC39(73) = "001001100" ' I
BC39(74) = "000011100" ' J
BC39(75) = "100000011" ' K
BC39(76) = "001000011" ' L
BC39(77) = "101000010" ' M
BC39(78) = "000010011" ' N
BC39(79) = "100010010" ' O
BC39(80) = "001010010" ' P
BC39(81) = "000000111" ' Q
BC39(82) = "100000110" ' R
BC39(83) = "001000110" ' S
BC39(84) = "000010110" ' T
BC39(85) = "110000001" ' U
BC39(86) = "011000001" ' V
BC39(87) = "111000000" ' W
BC39(88) = "010010001" ' X
BC39(89) = "110010000" ' Y
BC39(90) = "011010000" ' Z
MD_BC39 = BC39(Asc(CharCode))
Exit_BC39:
Exit Function
ErrorTrap_BC39:
MD_BC39 = ""
Resume Exit_BC39
End Function
More great info. on barcoding at:
Option Compare Database 'Use database order for string comparisons
Option Explicit
'
' mod_BarCode_Generator_Code39
'
' Barcode Generator for Code 3 of 9, Code 39, and Mil-spec Logmars.
'
' version 2.0 (updated for MsAccess 97)
'
' (c) 1993-1999 James Isle Mercanti, Cocoa Beach, FL 32931 USA
' Permission granted for public use and royalty-free distribution.
' No mention of source or credits is required. All rights reserved.
'
' TO USE THIS CODE:
'
' 1 - Create Report with a TextBox control. (example named Barcode)
' Make sure the Visible property is set to "No".
' 2 - Set On-Print property of section to [Event Procedure]
' by clicking on the [...] and selecting "Code Builder"
' 3 - Confirm that the following code matches yours...
'
' Sub Detail1_Print (Cancel As Integer, PrintCount As Integer)
'
' Result = MD_Barcode39(Barcode, Me)
'
' End Sub
'
' 4 - NOTE: The name of the section is "Detail1" for example only!
' Your section might show a different name. Ditto for "Barcode".
'
' 5 - NOTE: To use on sub-forms, the Report name should be hard-coded
' into the function. i.e. Rpt = Reports!MainForm!SubForm.Report.
' The easy method is to just avoid using sub-forms and sub-reports.
'
Function MD_Barcode39(Ctrl As Control, rpt As Report)
On Error GoTo ErrorTrap_BarCode39
Dim Nbar As Single, Wbar As Single, Qbar As Single, Nextbar As Single
Dim CountX As Single, CountY As Single, CountR As Single
Dim Parts As Single, Pix As Single, Color As Long, BarCodePlus As Variant
Dim Stripes As String, BarType As String, Barcode As String
Dim Mx As Single, my As Single, Sx As Single, Sy As Single
Const White = 16777215: Const Black = 0
Const Nratio = 20, Wratio = 55, Qratio = 35
'Get control size and location properties.
Sx = Ctrl.Left: Sy = Ctrl.TOP: Mx = Ctrl.Width: my = Ctrl.Height
'Set handle on control.
Barcode = Ctrl
'Calculate actual and relative pixels values.
Parts = (Len(Barcode) + 2) * ((6 * Nratio) + (3 * Wratio) + (1 * Qratio))
Pix = (Mx / Parts):
Nbar = (20 * Pix): Wbar = (55 * Pix): Qbar = (35 * Pix)
'Initialize bar index and color.
Nextbar = Sx
Color = White
'Pad each end of string with start/stop characters.
BarCodePlus = "*" & UCase(Barcode) & "*"
'Walk through each character of the barcode contents.
For CountX = 1 To Len(BarCodePlus)
'Get Barcode 1/0 string for indexed character.
Stripes = MD_BC39(Mid$(BarCodePlus, CountX, 1))
For CountY = 1 To 9
'For each 1/0, draw a wide/narrow bar.
BarType = Mid$(Stripes, CountY, 1)
'Toggle the color (black/white).
If Color = White Then Color = Black Else Color = White
Select Case BarType
Case "1"
'Draw a wide bar.
rpt.Line (Nextbar, Sy)-Step(Wbar, my), Color, BF
Nextbar = Nextbar + Wbar
Case "0"
'Draw a narrow bar.
rpt.Line (Nextbar, Sy)-Step(Nbar, my), Color, BF
Nextbar = Nextbar + Nbar
End Select
Next CountY
'Toggle the color (black/white).
If Color = White Then Color = Black Else Color = White
'Draw intermediate "quiet" bar.
rpt.Line (Nextbar, Sy)-Step(Qbar, my), Color, BF
Nextbar = Nextbar + Qbar
Next CountX
Exit_BarCode39:
Exit Function
ErrorTrap_BarCode39:
Resume Exit_BarCode39
End Function
Function MD_BC39(CharCode As String) As String
On Error GoTo ErrorTrap_BC39
ReDim BC39(90)
BC39(32) = "011000100" ' space
BC39(36) = "010101000" ' $
BC39(37) = "000101010" ' %
BC39(42) = "010010100" ' * Start/Stop
BC39(43) = "010001010" ' +
BC39(45) = "010000101" ' |
BC39(46) = "110000100" ' .
BC39(47) = "010100010" ' /
BC39(48) = "000110100" ' 0
BC39(49) = "100100001" ' 1
BC39(50) = "001100001" ' 2
BC39(51) = "101100000" ' 3
BC39(52) = "000110001" ' 4
BC39(53) = "100110000" ' 5
BC39(54) = "001110000" ' 6
BC39(55) = "000100101" ' 7
BC39(56) = "100100100" ' 8
BC39(57) = "001100100" ' 9
BC39(65) = "100001001" ' A
BC39(66) = "001001001" ' B
BC39(67) = "101001000" ' C
BC39(68) = "000011001" ' D
BC39(69) = "100011000" ' E
BC39(70) = "001011000" ' F
BC39(71) = "000001101" ' G
BC39(72) = "100001100" ' H
BC39(73) = "001001100" ' I
BC39(74) = "000011100" ' J
BC39(75) = "100000011" ' K
BC39(76) = "001000011" ' L
BC39(77) = "101000010" ' M
BC39(78) = "000010011" ' N
BC39(79) = "100010010" ' O
BC39(80) = "001010010" ' P
BC39(81) = "000000111" ' Q
BC39(82) = "100000110" ' R
BC39(83) = "001000110" ' S
BC39(84) = "000010110" ' T
BC39(85) = "110000001" ' U
BC39(86) = "011000001" ' V
BC39(87) = "111000000" ' W
BC39(88) = "010010001" ' X
BC39(89) = "110010000" ' Y
BC39(90) = "011010000" ' Z
MD_BC39 = BC39(Asc(CharCode))
Exit_BC39:
Exit Function
ErrorTrap_BC39:
MD_BC39 = ""
Resume Exit_BC39
End Function
More great info. on barcoding at:
MichaelRed
Programmer
akcam2006,
The module poeted works well, AFAICS. It does "overwrite" the barcode in the textbox, which is not the "norm", at least as far as my limited understanding goes. Perhaps you could 'expand' the directions a bit to help me place the actual barcode symbology in a seperate "control"?
Also, the schema appears to be what I would expect for all of the various instances of bar codint (ISBN, EAN, ... ) with just a different assignment table ("Function MD_BC39"), do you know if this is true and if so where one might get the alternative assignmnet tables?.
MichaelRed
The module poeted works well, AFAICS. It does "overwrite" the barcode in the textbox, which is not the "norm", at least as far as my limited understanding goes. Perhaps you could 'expand' the directions a bit to help me place the actual barcode symbology in a seperate "control"?
Also, the schema appears to be what I would expect for all of the various instances of bar codint (ISBN, EAN, ... ) with just a different assignment table ("Function MD_BC39"), do you know if this is true and if so where one might get the alternative assignmnet tables?.
MichaelRed
MichaelRed,
By setting the Textbox control to "No" you will no longer see the data in the text box. This means you don't need to change the font and only the barcode will show when printed.
1 - Create Report with a TextBox control. (example named Barcode) Make sure the Visible property is set to "No".
The word "barcode" can be replaced with any txtbox.
Sub Detail1_Print (Cancel As Integer, PrintCount As Integer)
'
' Result = MD_Barcode39(Barcode, Me)
'
End Sub
Not sure I understand what you are asking for in the second question but I also have the code for 128A and 128B.
akcam2006
By setting the Textbox control to "No" you will no longer see the data in the text box. This means you don't need to change the font and only the barcode will show when printed.
1 - Create Report with a TextBox control. (example named Barcode) Make sure the Visible property is set to "No".
The word "barcode" can be replaced with any txtbox.
Sub Detail1_Print (Cancel As Integer, PrintCount As Integer)
'
' Result = MD_Barcode39(Barcode, Me)
'
End Sub
Not sure I understand what you are asking for in the second question but I also have the code for 128A and 128B.
akcam2006
MichaelRed
Programmer
Thanks. Quite interesting. I suppose I can achieve the overall effect with one for the value and another for the code.
MichaelRed
MichaelRed
Here is the code for the 128A Barcode... You use it the same way as the 3 of 9 code shown earlier.
Option Explicit
' Written by Rodney Marr (RodMarr@mailcity.com) October 7, 2000
' Modified to 128A by Mike Lightner 12 Apr 2004
'
' Barcode 128-A Generator
'
' Permission granted for public use and royalty-free distribution.
' No mention of source or credits is required.
'
' I got a lot of help from the following people's work
' Russ Adams' BarCode 1 Web Page ' A Free 128-B code generator in Visual Basic by Rodney Marr
' And the Creator of the code 39 Module
'
' TO USE THIS CODE:
'
' 1 - Create Report with a TextBox control. (example named Barcode)
' Make sure the Visible property is set to "No".
' 2 - Set On-Print property of section to [Event Procedure]
' by clicking on the [...] and selecting "Code Builder"
' 3 - Confirm that the following code matches yours...
'
' Sub Detail1_Print (Cancel As Integer, PrintCount As Integer)
'
' Result = SetBarDataA(Barcode, Me)
'
' End Sub
'
' 4 - NOTE: The name of the section is "Detail1" for example only!
' Your section might show a different name. Ditto for "Barcode".
'
' 5 - NOTE: To use on sub-forms, the Report name should be hard-coded
' into the function. i.e. Rpt = Reports!MainForm!SubForm.Report.
' The easy method is to just avoid using sub-forms and sub-reports.
Public Function SetBarDataA(Ctrl As Control, rpt As Report)
On Error GoTo ErrorTrap_SetBarDataA
'Code 128A has 5 main parts to it. The first part is a start character(211214), followed by DataCharcters. The Data
'Characters are followed by a check(or Checksum) Character, and that is followed by a stop Character(2331112)
'The last part of Code 128A is the two quiet sections at the front and back of the barcode. These are 10 dimensions
'Long(I am thinking that is 11 modules long). Each character is 11 modules long, except the stop character which is
'13 modules long
Dim CharNumber As Variant, CharData As Variant, CharBarData As Variant, Nratio As Variant, Nbar As Variant
Dim barcodestr As String, Barcode As String, Barchar As String, Barcolor As Long, Parts As Integer, J As Integer
Dim tsum As Integer, lop As Integer, s As Integer, checksum As Integer, p As Integer, barwidth As Integer
Dim boxh As Single, boxw As Single, boxx As Single, boxy As Single, Pix As Single, Nextbar As Single
Const White = 16777215: Const Black = 0
'This is the Raw data that I threw into an arrays
CharNumber = Array("0", "1", "2", "3", "4", "5", "6", "7", "8", "9", "10", "11", "12", "13", "14", "15", "16,", "17", "18", "19", "20", "21", "22", "23", "24", "25", "26", "27", "28", "29,", "30", "31", "32", "33", "34", "35", "36", "37", "38", "39", "40", "41", "42", "43", "44", "45", "46", "47", "48", "49", "50", "51", "52", "53", "54", "55", "56", "57", "58", "59", "60", "61", "62", "63", "64", "65", "66", "67", "68", "69", "70", "71", "72", "73", "74", "75", "76", "77", "78", "79", "80", "81", "82", "83", "84", "85", "86", "87", "88", "89", "90", "91", "92", "93", "94", "95", "96", "97", "98", "99", "100", "101", "102", "103", "104", "105", "106")
CharData = Array("SP", "!", Chr(34), "#", "$", "%", "&", "'", "(", ")", "*", "+", ",", "-", ".", "/", "0", "1", "2", "3", "4", "5", "6", "7", "8", "9", ":", ";", "<", "=", ">", "?", "@", "A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z", "[", "\", "]", "^", "_", Chr(0), Chr(1), Chr(2), Chr(3), Chr(4), Chr(5), Chr(6), Chr(7), Chr(8), Chr(9), Chr(10), Chr(11), Chr(12), Chr(13), Chr(14), Chr(15), Chr(16), Chr(17), Chr(18), Chr(19), Chr(20), Chr(21), Chr(22), Chr(23), Chr(24), Chr(25), Chr(26), Chr(27), Chr(28), Chr(29), Chr(30), Chr(31), "FNC 3", "FNC 2", "SHIFT", "CODE C", "CODE B", "FNC 4", "FNC 1", "Start A", "Start B", "Start C", "Stop")
CharBarData = Array("212222", "222122", "222221", "121223", "121322", "131222", "122213", "122312", "132212", "221213", "221312", "231212", "112232", "122132", "122231", "113222", "123122", "123221", "223211", "221132", "221231", "213212", "223112", "312131", "311222", "321122", "321221", "312212", "322112", "322211", "212123", "212321", "232121", "111323", "131123", "131321", "112313", "132113", "132311", "211313", "231113", "231311", "112133", "112331", "132131", "113123", "113321", "133121", "313121", "211331", "231131", "213113", "213311", "213131", "311123", "311321", "331121", "312113", "312311", "332111", "314111", "221411", "431111", "111224", "111422", "121124", "121421", "141122", "141221", "112214", "112412", "122114", "122411", "142112", "142211", "241211", "221114", "413111", "241112", "134111", "111242", "121142", "121241", "114212", "124112", "124211", "411212", "421112", "421211", "212141", _
"214121", "412121", "111143", "111341", "131141", "114113", "114311", "411113", "411311", "113141", "114131", "311141", "411131", "211412", "211214", "211232", "2331112")
barcodestr = "211412" 'Add the Startcode for Start A (characterset A) to the barcode string
tsum = 103 'And this is the value for that startcode which will be added with the other character values to find the checksum character
boxx = Ctrl.Left: boxy = Ctrl.TOP: boxw = Ctrl.Width: boxh = Ctrl.Height 'Get control size and location properties.
Barcode = UCase(Ctrl) 'Set handle on control and change all lower case letters to uper case.
Nratio = Array("0", "15", "30", "45", "60") 'Set up the array for the different bar width ratios
Parts = ((11 * (Len(Barcode))) + 35) * Nratio(1) 'This is the formula for the width of the barcode
Pix = (boxw / Parts) 'Here I find out exactly how many Pixels a bar will be
Nbar = Array((Nratio(0) * Pix), (Nratio(1) * Pix), (Nratio(2) * Pix), (Nratio(3) * Pix), (Nratio(4) * Pix)) 'Set up the array to handle the pixels for each type of bar
'Loop through all bardata to count the sum for all characters and add barcode charcter strings the to the barcode string
For lop = 1 To Len(Barcode)
Barchar = Mid(Barcode, lop, 1)
If Barchar = " " Then Barchar = "SP"
For s = 0 To UBound(CharData)
If Barchar = CharData(s) Then
barcodestr = barcodestr & CharBarData(s) 'This is where I added the character strings to each other to make one long string of 1's, 2's, 3's, & 4's
tsum = tsum + (CLng(CharNumber(s)) * lop) 'Here every barcode character's number value is multiplied by its position in the line and added to tsum
'The actual formula for find the the Checksum is "(104 + (1 * CharcterNumber) + (2 * CharcterNumber) + ...)/103" You would Use the Remainder as
'The Checksum Character. In the case of "BarCode 1" the formula would look
'like "(104+(1*34)+(2*65)+(3*82)+(4*35)+(5*79)+(6*68)+(7*69)+(8*0)+(9*17))/103=20 with Remainder of 33" Therefore the checksum would equal 33
Exit For
End If
Next s
Next lop
checksum = tsum - (Int(tsum / 103) * 103) 'Here I use the the totat sum (tsum) to find the checksum
barcodestr = barcodestr & CharBarData(checksum) & "2331112" 'Here I add the checksum then the stop character into the barcode string
'lets do some initialization
Barcolor = Black
Nextbar = boxx + 11 'I added the 20 for the whitespace (or quiet space) at the beginning of the barcode
'Draw the Barcode
For J = 1 To Len(barcodestr)
Barchar = Mid(barcodestr, J, 1) 'Reuse variable barchar to store the character to be drawn
barwidth = CInt(Barchar) 'Change the barcode charcter into an integer so I can use in the array part of the next line
rpt.Line (Nextbar, boxy)-Step(Nbar(barwidth), boxh), Barcolor, BF 'Draw the line
Nextbar = Nextbar + Nbar(barwidth) 'Calculate the next starting point
If Barcolor = White Then Barcolor = Black Else Barcolor = White 'Swap line colors
Next J
Exit_SetBarDataA:
Exit Function
ErrorTrap_SetBarDataA:
MsgBox Error$
Resume Exit_SetBarDataA
End Function
Option Explicit
' Written by Rodney Marr (RodMarr@mailcity.com) October 7, 2000
' Modified to 128A by Mike Lightner 12 Apr 2004
'
' Barcode 128-A Generator
'
' Permission granted for public use and royalty-free distribution.
' No mention of source or credits is required.
'
' I got a lot of help from the following people's work
' Russ Adams' BarCode 1 Web Page ' A Free 128-B code generator in Visual Basic by Rodney Marr
' And the Creator of the code 39 Module
'
' TO USE THIS CODE:
'
' 1 - Create Report with a TextBox control. (example named Barcode)
' Make sure the Visible property is set to "No".
' 2 - Set On-Print property of section to [Event Procedure]
' by clicking on the [...] and selecting "Code Builder"
' 3 - Confirm that the following code matches yours...
'
' Sub Detail1_Print (Cancel As Integer, PrintCount As Integer)
'
' Result = SetBarDataA(Barcode, Me)
'
' End Sub
'
' 4 - NOTE: The name of the section is "Detail1" for example only!
' Your section might show a different name. Ditto for "Barcode".
'
' 5 - NOTE: To use on sub-forms, the Report name should be hard-coded
' into the function. i.e. Rpt = Reports!MainForm!SubForm.Report.
' The easy method is to just avoid using sub-forms and sub-reports.
Public Function SetBarDataA(Ctrl As Control, rpt As Report)
On Error GoTo ErrorTrap_SetBarDataA
'Code 128A has 5 main parts to it. The first part is a start character(211214), followed by DataCharcters. The Data
'Characters are followed by a check(or Checksum) Character, and that is followed by a stop Character(2331112)
'The last part of Code 128A is the two quiet sections at the front and back of the barcode. These are 10 dimensions
'Long(I am thinking that is 11 modules long). Each character is 11 modules long, except the stop character which is
'13 modules long
Dim CharNumber As Variant, CharData As Variant, CharBarData As Variant, Nratio As Variant, Nbar As Variant
Dim barcodestr As String, Barcode As String, Barchar As String, Barcolor As Long, Parts As Integer, J As Integer
Dim tsum As Integer, lop As Integer, s As Integer, checksum As Integer, p As Integer, barwidth As Integer
Dim boxh As Single, boxw As Single, boxx As Single, boxy As Single, Pix As Single, Nextbar As Single
Const White = 16777215: Const Black = 0
'This is the Raw data that I threw into an arrays
CharNumber = Array("0", "1", "2", "3", "4", "5", "6", "7", "8", "9", "10", "11", "12", "13", "14", "15", "16,", "17", "18", "19", "20", "21", "22", "23", "24", "25", "26", "27", "28", "29,", "30", "31", "32", "33", "34", "35", "36", "37", "38", "39", "40", "41", "42", "43", "44", "45", "46", "47", "48", "49", "50", "51", "52", "53", "54", "55", "56", "57", "58", "59", "60", "61", "62", "63", "64", "65", "66", "67", "68", "69", "70", "71", "72", "73", "74", "75", "76", "77", "78", "79", "80", "81", "82", "83", "84", "85", "86", "87", "88", "89", "90", "91", "92", "93", "94", "95", "96", "97", "98", "99", "100", "101", "102", "103", "104", "105", "106")
CharData = Array("SP", "!", Chr(34), "#", "$", "%", "&", "'", "(", ")", "*", "+", ",", "-", ".", "/", "0", "1", "2", "3", "4", "5", "6", "7", "8", "9", ":", ";", "<", "=", ">", "?", "@", "A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z", "[", "\", "]", "^", "_", Chr(0), Chr(1), Chr(2), Chr(3), Chr(4), Chr(5), Chr(6), Chr(7), Chr(8), Chr(9), Chr(10), Chr(11), Chr(12), Chr(13), Chr(14), Chr(15), Chr(16), Chr(17), Chr(18), Chr(19), Chr(20), Chr(21), Chr(22), Chr(23), Chr(24), Chr(25), Chr(26), Chr(27), Chr(28), Chr(29), Chr(30), Chr(31), "FNC 3", "FNC 2", "SHIFT", "CODE C", "CODE B", "FNC 4", "FNC 1", "Start A", "Start B", "Start C", "Stop")
CharBarData = Array("212222", "222122", "222221", "121223", "121322", "131222", "122213", "122312", "132212", "221213", "221312", "231212", "112232", "122132", "122231", "113222", "123122", "123221", "223211", "221132", "221231", "213212", "223112", "312131", "311222", "321122", "321221", "312212", "322112", "322211", "212123", "212321", "232121", "111323", "131123", "131321", "112313", "132113", "132311", "211313", "231113", "231311", "112133", "112331", "132131", "113123", "113321", "133121", "313121", "211331", "231131", "213113", "213311", "213131", "311123", "311321", "331121", "312113", "312311", "332111", "314111", "221411", "431111", "111224", "111422", "121124", "121421", "141122", "141221", "112214", "112412", "122114", "122411", "142112", "142211", "241211", "221114", "413111", "241112", "134111", "111242", "121142", "121241", "114212", "124112", "124211", "411212", "421112", "421211", "212141", _
"214121", "412121", "111143", "111341", "131141", "114113", "114311", "411113", "411311", "113141", "114131", "311141", "411131", "211412", "211214", "211232", "2331112")
barcodestr = "211412" 'Add the Startcode for Start A (characterset A) to the barcode string
tsum = 103 'And this is the value for that startcode which will be added with the other character values to find the checksum character
boxx = Ctrl.Left: boxy = Ctrl.TOP: boxw = Ctrl.Width: boxh = Ctrl.Height 'Get control size and location properties.
Barcode = UCase(Ctrl) 'Set handle on control and change all lower case letters to uper case.
Nratio = Array("0", "15", "30", "45", "60") 'Set up the array for the different bar width ratios
Parts = ((11 * (Len(Barcode))) + 35) * Nratio(1) 'This is the formula for the width of the barcode
Pix = (boxw / Parts) 'Here I find out exactly how many Pixels a bar will be
Nbar = Array((Nratio(0) * Pix), (Nratio(1) * Pix), (Nratio(2) * Pix), (Nratio(3) * Pix), (Nratio(4) * Pix)) 'Set up the array to handle the pixels for each type of bar
'Loop through all bardata to count the sum for all characters and add barcode charcter strings the to the barcode string
For lop = 1 To Len(Barcode)
Barchar = Mid(Barcode, lop, 1)
If Barchar = " " Then Barchar = "SP"
For s = 0 To UBound(CharData)
If Barchar = CharData(s) Then
barcodestr = barcodestr & CharBarData(s) 'This is where I added the character strings to each other to make one long string of 1's, 2's, 3's, & 4's
tsum = tsum + (CLng(CharNumber(s)) * lop) 'Here every barcode character's number value is multiplied by its position in the line and added to tsum
'The actual formula for find the the Checksum is "(104 + (1 * CharcterNumber) + (2 * CharcterNumber) + ...)/103" You would Use the Remainder as
'The Checksum Character. In the case of "BarCode 1" the formula would look
'like "(104+(1*34)+(2*65)+(3*82)+(4*35)+(5*79)+(6*68)+(7*69)+(8*0)+(9*17))/103=20 with Remainder of 33" Therefore the checksum would equal 33
Exit For
End If
Next s
Next lop
checksum = tsum - (Int(tsum / 103) * 103) 'Here I use the the totat sum (tsum) to find the checksum
barcodestr = barcodestr & CharBarData(checksum) & "2331112" 'Here I add the checksum then the stop character into the barcode string
'lets do some initialization
Barcolor = Black
Nextbar = boxx + 11 'I added the 20 for the whitespace (or quiet space) at the beginning of the barcode
'Draw the Barcode
For J = 1 To Len(barcodestr)
Barchar = Mid(barcodestr, J, 1) 'Reuse variable barchar to store the character to be drawn
barwidth = CInt(Barchar) 'Change the barcode charcter into an integer so I can use in the array part of the next line
rpt.Line (Nextbar, boxy)-Step(Nbar(barwidth), boxh), Barcolor, BF 'Draw the line
Nextbar = Nextbar + Nbar(barwidth) 'Calculate the next starting point
If Barcolor = White Then Barcolor = Black Else Barcolor = White 'Swap line colors
Next J
Exit_SetBarDataA:
Exit Function
ErrorTrap_SetBarDataA:
MsgBox Error$
Resume Exit_SetBarDataA
End Function
67peshawar294
Technical User
Info only. You might want to check out Jean-Marie's site. Extremely well done barcode explanation, modules, stand alone VB .exe files and includes fonts.
jim
jim
- Status