Option Compare Database
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".
' 1A - (optional) Create a second control e.g. MyCode) with the same control _
source, but with the visible property set to "Yes". This permits _
the "verification" of the barcode to the database.
' 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 Detail_Print (Cancel As Integer, PrintCount As Integer) _
Result = MD_Barcode39(Barcode, Me) _
End Sub
' 4 - NOTE: The name of the section is "Detail" 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 'Narrow Bar width
Dim Wbar As Single 'Wide Bar width
Dim TBar As Single 'Current Bar width (as well as Increment to Next bar)
Dim Qbar As Single 'the "Quiet" Bar
Dim Nextbar As Single 'Position to Start printing the "line" / BAR
Dim Idx As Single 'Index to the Bar Character being printed
Dim Jdx As Single 'Index to the "Char" for the stripe being printed
Dim Parts As Single 'Proportion of width for the individual stripe
Dim Pix As Single
Dim MyClr As Long 'Color to "print"
Dim BarCodePlus As Variant 'BarCode from data , with "end" Characters
Dim Stripes As String
Dim BarType As String 'Not used here.
Dim BarCode As String 'Control "Value"
Const White = vbWhite
Const Black = vbBlack
Const Nratio = 20 'Ratio of the Narrow Bar to the total bar width
Const WRatio = 55 'Ratio of the Wide bar to the total bar width
Const QRatio = 35 'Ration of the Quite bar to the total bar Width
'Set handle on control.
BarCode = Ctrl 'Just a copy of the Ctrl's Value (content)
'Calculate actual and relative pixels values.
Parts = (Len(BarCode) + 2) * ((6 * Nratio) + (3 * WRatio) + (1 * QRatio))
Pix = (Ctrl.Width / Parts):
Nbar = (20 * Pix)
Wbar = (55 * Pix)
Qbar = (35 * Pix)
'Initialize bar index and color.
Nextbar = Ctrl.Left
MyClr = White
'Pad each end of string with start/stop characters.
BarCodePlus = "*" & UCase(BarCode) & "*"
'Walk through each character of the barcode contents.
For Idx = 1 To Len(BarCodePlus)
'Get Barcode 1/0 string for indexed character.
Stripes = MD_BC39(Mid$(BarCodePlus, Idx, 1))
For Jdx = 1 To 9
'For each 1/0, draw a wide/narrow bar.
BarType = Mid$(Stripes, Jdx, 1)
'Toggle the color (black/white).
MyClr = MyClr Xor vbWhite
Select Case BarType
Case "1"
TBar = Wbar 'Draw a wide bar.
Case "0"
TBar = Nbar 'Draw a narrow bar.
End Select
rpt.Line (Nextbar, Ctrl.Top)-Step(Wbar, Ctrl.Height), MyClr, BF
Nextbar = Nextbar + TBar
Next Jdx
'Toggle the color (black/white).
MyClr = MyClr Xor vbWhite
'Draw intermediate "quiet" bar.
rpt.Line (Nextbar, Ctrl.Top)-Step(Qbar, Ctrl.Height), MyClr, BF
Nextbar = Nextbar + Qbar
Next Idx
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