Option Explicit

' Written by Rodney Marr (RodMarr@mailcity.com) October 7, 2000

'

' Barcode 128-B 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   http://www.adams1.com/pub/russadam/info.html

' A Free 128-B code generator in Visual Basic by Stefan Karlsson (mrswede@libertysurf.se)

' And the Creator of the code 39 Module

'

'For Notes on how to use this code look at the code for the barcode39 Generator

 

Public Function SetBarData(Ctrl As control, rpt As Report)

   

    On Error GoTo ErrorTrap_SetBarData

   

    'Code 128B 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 128B 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", "[", "\", "]", "^", "_", "`", "a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "I", "m", "n", "o", "p", "q", "r", "s", "t", "u", "v", "w", "x", "y", "z", "{", "|", "}", "~", "DEL", "FNC 3", "FNC 2", "SHIFT", "CODE C", "FNC 4", "CODE A", "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 = "211214" 'Add the Startcode for Start B (characterset B) to the barcode string

    tsum = 104            '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 = Ctrl        'Set handle on control.

 

    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

    'Set up the array to handle the pixels for each type of bar

    Nbar = Array((Nratio(0) * Pix), (Nratio(1) * Pix), (Nratio(2) * Pix), (Nratio(3) * Pix), (Nratio(4) * Pix))

   

    '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_SetBarData:

    Exit Function

 

ErrorTrap_SetBarData:

    MsgBox Error$

    Resume Exit_SetBarData

 

End Function

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