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 strongm on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

I am looking for a simple method to print 3 of 9 barcode in vb.net

Status
Not open for further replies.

ucsjimj

Programmer
Oct 12, 2002
23
US
I have written several VB 6 programs using Bar codes, but trying to do this with VB.net is a new ball game. With VB 6 I used an activex ocx to generate the bar code into a string which can be placed any where on a printer output. I need to generate a simple 3 of 9 BC. I would appreciate any pointers.
 
on the other hand, there are FREE WARE barcode generators out there.

I found this in less than 5 Minutes and (minimally modified) it is less than an hour to do some simple label generation. In VERY brief tests, A scanner did return the encoded label information. Of course, you will also need to work with the scanner and your software to make sure the scanned info is input into the corect field(s) and do the general houskeeping,


Code:
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





MichaelRed


 
Thanks to MichaelRed for something I can really use. Buying an Activex library for this seemed wrong. I appreciate this a lot..
 
Thanks to MichaelRed for something I can really use.

You really don't want to make me mad.
And I can tell you you are very close.

Christiaan Baes
Belgium

If you want to get an answer read this FAQ faq796-2540
There's no such thing as a winnable war - Sting
 
Christiaan, cut me a break, are you saying this code from Michael is bogus?
 
No, I am saying that we gave you a perfect and very simple solution and you show no gratetude whatsoever if you didn't understand what we meant then just say so.

I'm very sure michaelred's solution will work, but if you don't want to learn anything then please stop wasting our time.

Christiaan Baes
Belgium

If you want to get an answer read this FAQ faq796-2540
There's no such thing as a winnable war - Sting
 
Sorry if I hurt your feelings, but to be honest, I got your answer from Google before I posted for help. Thanks just the same..I certainly have no intentions of wasting any one's time..

 
hmmmmmmmmmmmmmmmmmmmmmmmmmmmmmm ... mmmmmmmmmmmmmmmmmm ...


WOW what a storm!!!

I did not mean / intend to set the world on "angry", and franky don't quite undestand the reason for theh furor. (also not really lookning for the expliniation ). But just to explain my own post, I have also been frustrated with the barcode font / encapsulated Active X control / libraries. They seem to want a fortune for what is, in hte end, a simple line drawing procedure. Having found the alternative soloution a while back, it seems like a reasonable concept to share.



MichaelRed


 
Sorry Michaelred, the 3of9 fonts are absolutly free and if you look long enough you can find all the others. they just don't show up in the first 100 google items.

But what I don't appreciate is that he didn't do a search on this site. I just posted the same reply a couple of weeks ago.
I think your solution is a nice one. But the 3of9 font is a much faster solution for what he was trying to do. And it just made me angry that he didn't even try. I came up with something in less then an hour the first time I had to do this using the fonts.

When going to 2d barcodes you need something you wrote. I probably was wrong to get mad, just one of those days I guess and I apologize for it.

Michaelred I still remembered you from my access days.

Christiaan Baes
Belgium

If you want to get an answer read this FAQ faq796-2540
There's no such thing as a winnable war - Sting
 
I think your solution is a nice one. But the 3of9 font is a much faster solution for what he was trying to do

Agreed. Why reinvent the wheel when someone has a polished show ready one they'll give you for free?

just one of those days I guess and I apologize for it.

Someone is jelious of use American slackers taking the day off ;)

And to be fair, "Thanks to MichaelRed for something I can really use." is a rather insulting thing to say.

-Rick

VB.Net Forum forum796 forum855 ASP.NET Forum
[monkey]I believe in killer coding ninja monkeys.[monkey]
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top