Barcode Printing

[dxk240(Legacy Member)]

Hi,

I am trying to print the barcode from VB and I am having some problems. If I print the form by calling PrintForm method, then I am not able to scan the barcode because of print quality. If I use the Printer object and manually code everything it gets more complicated because I want to print checkboxes and I also have to worry about word wrapping.

Any suggestions will be helpful

[dxk240(Legacy Member)]

I resolved this issue. Below is the code that made it work. You are free to use it in your applications. If you have any questions or comments about the code you can reply to this post and I will try to answer them. Simply call PrintBarcode from your printing routine and pass a string that you want to generate a barcode for. In order to generate a barcode you would need to purchase Morovia Barcode Fonts and copy and paste Code39, SpecialChar functions from the source code into your VB project. Hope this helps



Public Sub PrintBarcode(ByVal MSR As String)
' =========================================================================================
' Programmer: Dragan Knezevic
' Date: July 19 2004
' Description: Prints the contents of labels, textboxes (with word wrapping),
' checkboxes(caption only), DTPicker and generates a barcode for the
' passed parameter.
'
' Parameters Passed: MSR: A string for which a barcode needs to be generated.
' Value Returned: None
' Called by: PrintFrm or your own sub
' Calls: FormatStringAndPrint
'
' Last Revised: n/a
' Changes made: n/a
' =========================================================================================

Dim ctl As Control

Printer.PrintQuality = vbPRPQHigh
Printer.Orientation = vbPRORLandscape 'or vbPRORPortrait
Printer.FontName = "MS Sans Serif" 'or any other font used for controls
Printer.FontSize = 8
Printer.ScaleMode = 1 'twips

For Each ctl In frmPrintBarCode.Controls 'or your form name
If TypeOf ctl Is SSResizer Then GoTo Res'or any other controls that are invisible at run-time (Timer)
'should not be printed

Printer.CurrentX = ctl.Left
Printer.CurrentY = ctl.Top

'add other controls here if you want to print their caption

If TypeOf ctl Is Label Or TypeOf ctl Is CommandButton Or TypeOf ctl Is CheckBox Or TypeOf ctl Is Frame Then
Printer.Print ctl.Caption

ElseIf TypeOf ctl Is TextBox Then 'add other controls here if you want to print their text
'this wraps the text inside a textbox so it fits nicely
'carriage return/line feed characters are removed prior to formatting
FormatStringAndPrint Replace(ctl.Text, vbCrLf, " "), ctl.Left, ctl.Width

'this draws a line around the edges of the textbox
Printer.Line (ctl.Left - 50, ctl.Top - 50)-(ctl.Left + ctl.Width + 50, ctl.Top + ctl.Height + 50), , B

ElseIf TypeOf ctl Is DTPicker Then 'date picker control
Printer.Print ctl.Value
Printer.Line (ctl.Left - 25, ctl.Top - 25)-(ctl.Left + ctl.Width + 25, ctl.Top + ctl.Height + 25), , B
End If

Res:
Next

'after we printed the contents of individual controls we are ready to generate the barcode
Printer.FontName = "MRV Code39M"
Printer.FontSize = 12

Printer.CurrentX = 12700 'X position of the barcode in twips
Printer.CurrentY = 10930 'Y position of the barcode in twips
Printer.Print Code39(MSR) 'Code39 function is available for users that bought Morovia Barcode Fonts
Printer.EndDoc

End Sub

Public Sub FormatStringAndPrint(sInput As String, TempX As Long, tempWidth As Long)
' =========================================================================================
' Programmer: Dragan Knezevic
' Date: July 20 2004
' Description: Formats each texbox before printing a barcode so that the text
' wraps inside the control
'
' Parameters Passed: sInput: text inside of the control free of carriage returns.
' TempX : current x position of the control
' tempWidth: width of the control.
'
' Value Returned: None
' Called by: PrintBarcode
' Calls: Nothing
'
' Last Revised: n/a
' Changes made: n/a
' =========================================================================================

Dim sTemp As String
Dim bSpace As Boolean

Do
If Printer.TextWidth(sInput$) <= tempWidth Then
sTemp$ = Trim(sInput$): Exit Do
End If

Do
sTemp$ = sTemp$ & Left(sInput$, 1)
sInput$ = Right(sInput$, Len(sInput$) - 1)
Debug.Print sTemp
Debug.Print Printer.TextWidth(sTemp)
Loop While Printer.TextWidth(sTemp$) < tempWidth - 100

Do
If Right(sTemp$, 1) = Chr(32) Then bSpace = True
If Not bSpace Then
sInput$ = Right(sTemp$, 1) & sInput$
End If
sTemp$ = Left(sTemp$, Len(sTemp$) - 1)
Loop While Not bSpace

bSpace = False

Printer.Print sTemp$: sTemp$ = ""
Printer.CurrentX = TempX
Loop

Printer.Print sTemp$

End Sub

[loquin(Legacy Member)]

Here's the code I've used for this task.

Essentially, I place labels, textboxes, images, pictures & lines in the positions required, and with the fonts required.

Then, I load a new instance of the form, Populate the form objects with the data I need to print, and then call PrintMyForm

Useage:

Dim f as MyFormName

Set f = New MyFormName

Load f

' Populate the form. You don't have to show it if you don't want to.

PrintMyForm f

Printer.EndDoc ' Advance to the next label



'********* Place the following code in a module so it's accessable from anywhere in your app

Public Sub PrintMyForm(theForm As Form)
' Requires that the form be loaded.

Dim obj As Object
For Each obj In theForm
If obj.Visible Then
PrintObject obj
End If
Next obj

End Sub

Public Sub PrintObject(theObj As Object)

' works with lines, pictureboxes, Images, textboxes, and labels.
If TypeOf theObj Is Line Then
PrintLine theObj
End If

If TypeOf theObj Is TextBox Then
PrintTextBox theObj
End If

If TypeOf theObj Is Label Then
PrintLabel theObj
End If

If TypeOf theObj Is PictureBox Then
PrintPicture theObj
End If

If TypeOf theObj Is Image Then
PrintImage theObj
End If

End Sub

Public Sub PrintTextBox(tTextBox As TextBox)
' Handles justification, fonts, etc.
With tTextBox
Printer.ForeColor = .ForeColor
Printer.Font = .Font
Printer.Font.Name = .Font.Name
Printer.Font.Charset = .Font.Charset
Printer.Font.Bold = .Font.Bold
Printer.Font.Italic = .Font.Italic
Printer.Font.Size = .Font.Size
Printer.Font.Strikethrough = .Font.Strikethrough
Printer.Font.Underline = .Font.Underline
Printer.Font.Weight = .Font.Weight
Select Case .Alignment
Case vbCenter
Printer.CurrentX = .Left + (.Width - Printer.TextWidth(.Text)) / 2
Case vbLeftJustify
Printer.CurrentX = .Left
Case vbRightJustify
Printer.CurrentX = .Left + .Width - Printer.TextWidth(.Text)
End Select
Printer.CurrentY = .Top
Printer.Print .Text
End With
End Sub

Public Sub PrintLabel(tLabel As Label)
' Handles justification, fonts, etc.
Dim objFont As Object

Dim sFont As New StdFont
Dim bcFont As New StdFont
Dim N As Integer

sFont.Name = "MS Sans Serif"

With tLabel
Printer.ForeColor = .ForeColor

Set Printer.Font = tLabel.Font
Printer.Font.Name = tLabel.Font.Name

Printer.Font.Charset = .Font.Charset
Printer.Font.Bold = .Font.Bold
Printer.Font.Italic = .Font.Italic
Printer.Font.Size = .Font.Size
Printer.Font.Strikethrough = .Font.Strikethrough
Printer.Font.Underline = .Font.Underline
Printer.Font.Weight = .Font.Weight
Select Case .Alignment
Case vbCenter
Printer.CurrentX = .Left + (.Width - Printer.TextWidth(.Caption)) / 2
Case vbLeftJustify
Printer.CurrentX = .Left
Case vbRightJustify
Printer.CurrentX = .Left + .Width - Printer.TextWidth(.Caption)
End Select
Printer.CurrentY = .Top
Printer.Print .Caption
End With

Printer.Font = sFont
Printer.Font.Name = "MS Sans Serif"
Printer.Font.Size = 10
End Sub

Public Sub PrintPicture(tPicBox As PictureBox)

With tPicBox
Printer.PaintPicture .Image, .Left , .Top , .Width, .Height
End With

End Sub


Public Sub PrintImage(tImgBox As Image)

With tImgBox
Printer.PaintPicture .Picture, .Left, .Top, .Width, .Height
End With

End Sub

Public Sub PrintLine(tLine As Line, Optional DrawWidth As Integer = 10)

With tLine
Printer.DrawWidth = DrawWidth
Printer.Line (.X1, .Y1)-(.X2, .Y2)
End With

End Sub