'条码相关参数
Public SngLineWidth As Integer, SngSpaceWidth As Integer, SngDetWidth As Integer
为条码打印时线宽,间白宽和码与码之间的宽度,其它参数有参照上面
Public Sub PrintCode(mObjPic As Object, strCode As String, OffsetX As Integer, OffsetY As Integer, blnHaveText As Boolean)
Dim strBC As String, ChrBC As String, BCCode As String, X As Integer, Y As Integer, h As Integer
Dim i As Integer, j As Integer, k As Integer
Static strBarTable(39) As String
X = OffsetX
Y = OffsetY
h = sngBarHeight
' X = mObjPic.ScaleX(OffsetX, vbMillimeters, vbTwips)
' Y = mObjPic.ScaleY(OffsetY, vbMillimeters, vbTwips)
' h = mObjPic.ScaleY(intHeight, vbMillimeters, vbTwips)
strBC = UCase(strCode)
If Left(strBC, 1) <> "*" Then strBC = "*" & strBC
If Right(strBC, 1) <> "*" Then strBC = strBC & "*"
If blnHaveText = True Then h = h - mObjPic.TextHeight(strBC) '条码打印高度要减去下面的字符显示高度
With mObjPic
.ScaleMode = vbTwips
.DrawWidth = 1
.FontName = "宋体"
.FontSize = 8
End With
For i = 0 To Len(strBC) - 1
ChrBC = Mid(strBC, i + 1, 1)
BCCode = strBarTable(GetBarCode(ChrBC))
'当前字符
If blnHaveText = True Then
mObjPic.CurrentX = X
mObjPic.CurrentY = Y + h
mObjPic.Print ChrBC
End If
For j = 0 To Len(BCCode) - 1
'窄
If Mid(BCCode, j + 1, 1) = "0" Then
X = X + SngSpaceWidth
'宽
Else
For k = 0 To SngLineWidth - 1
mObjPic.Line (X + k, Y)-Step(0, h)
Next k
X = X + SngLineWidth
End If
Next
'字间距
X = X + SngDetWidth
Next
Exit Sub
End Sub
Private Function GetBarCode(ChrBC As String) As Integer
Select Case Left(ChrBC, 1)
Case "*": GetBarCode = 39
Case "$": GetBarCode = 38
Case "%": GetBarCode = 37
Case "-": GetBarCode = 36
Case "0" To "9": GetBarCode = CInt(Left(ChrBC, 1))
Case "A" To "Z": GetBarCode = Asc(Left(ChrBC, 1)) - Asc("A") + 10
Case Else: MsgBox "要打印的条形码字符串中包含无效字符!" '当前版本只支持字符 注释:0注释:-注释:9注释:,注释:A注释:-注释:Z注释:,注释:-注释:,注释:%注释:,注释:$注释:和注释:*注释:"
End Select
' TextOut PrintDC, x, y + intHeight, Mid(strBC, i, 1), 1
If TypeName(Pic) = "Printer" Then Printer.Print Mid(strBC, i, 1)
'pic.Print Mid(strBC, i, 1)
End If
For j = 1 To 5
'注释: 画细线
If Mid(strBarTable(intIndex), 2 * j - 1, 1) = "0" Then
For k = 0 To intWidthXI - 1
'MoveToEx PrintDC, x + k, y, papi
'LineTo PrintDC, x + k, y + intHeight + 1
If TypeName(Pic) = "Printer" Then Printer.Line (x + k, y)-Step(0, intHeight)
'pic.Line (x + k, y)-Step(0, intHeight)
Next k
x = x + intWidthXI
'注释: 画宽线
Else
For k = 0 To intWidthCU - 1
'MoveToEx PrintDC, x + k, y, papi
'LineTo PrintDC, x + k, y + intHeight + 1
If TypeName(Pic) = "Printer" Then Printer.Line (x + k, y)-Step(0, intHeight)
'pic.Line (x + k, y)-Step(0, intHeight)
Next k
x = x + intWidthCU
End If
'
'注释: 每个字符条码之间为窄间隙
If j = 5 Then
x = x + intWidthXI
Exit For
End If
'注释: 窄间隙
If Mid(strBarTable(intIndex), 2 * j, 1) = "0" Then
x = x + intWidthXI
'注释: 宽间隙
Else
x = x + intWidthCU
End If
Next j
Next i
'注释: 恢复打印机 ScaleMode
If TypeName(Pic) = "Printer" Then Pic.EndDoc
Pic.ScaleMode = intOldScaleMode
1.VB中有一个barcode控件.
2.打印CODE39的示例
Private Declare Function MoveToEx Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, lpPoint As POINTAPI) As Long
'从画笔的当前位置到(x,y)画一条线
Private Declare Function LineTo Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
'在(x,y)处输出一个字符串
Private Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal lpString As String, ByVal nCount As Long) As Long
'MoveToEx() 函数需要的参数
Private Type POINTAPI
xp As Long
yp As Long
End Type
Dim papi As POINTAPI
Private Sub PrintBarCode(ByVal Pic As Object, ByVal PrintDC As Long, ByVal strBarCode As String, Optional ByVal intXPos As Integer = 0, Optional ByVal intYPos As Integer = 0, Optional ByVal intPrintHeight As Integer = 100, Optional ByVal bolPrintText As Boolean = True)
有许多打印机能够直接打印条形码,但在 VB 中,我们在DOS时代熟悉的LPRINT语句已经不能再使用了,打印操作被Windows的Spool系统完全接管,输出是以“页”为单位,所有的打印输出都被Windows转换为图形发送给打印驱动程序。而要使打印机打印条形码就必须将对应的ESC序列直接发送给它,因此我们就要想办法避开Windows的Spool系统,也就是说再程序中不能使用Printer对象和Printers集合处理打印输出,在VB中要将ESC指令直接发送给打印机至少有三种方法,前两种方法是调用Windows
API 函数:Escape()和SpoolFile(),第三种是最容易的方法:打开打印机端口进行二进制存取,我们主要考虑这种方法。
即使在Windows时代,”LPT1:”和”PRN”仍然是可用的,下面我们先作一个试验:打开一个DOS窗口,在提示符下输入COPY CON
LPT1:回车,然后随便输入一些字符,最后按F6键,打印机就开始工作了,它将打印出你输入的那些字符!下面的代码演示了直接将指令和字符发送给打印机:
Private Declare Function MoveToEx Lib "gdi32" (ByVal hdc As Long, ByVal x As
Long, ByVal y As Long, lpPoint As POINTAPI) As Long
‘ 从画笔的当前位置到(x,y)画一条线
Private Declare Function LineTo Lib "gdi32" (ByVal hdc As Long, ByVal x As Long,
ByVal y As Long) As Long
‘ 在(x,y)处输出一个字符串
Private Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hdc As
Long, ByVal x As Long, ByVal y As Long, ByVal lpString As String, ByVal nCount
As Long) As Long
‘ MoveToEx() 函数需要的参数
Private Type POINTAPI
xp As Long
yp As Long
End Type
Dim papi As POINTAPI
画线操作为(原来的Printer.Line函数):
MoveToEx PrintDC, x + k, y, papi
LineTo PrintDC, x + k, y + intHeight + 1
打印字符为(原来的Printer.Print函数):
TextOut PrintDC, x, y + intHeight, Mid(strBC, i + 1, 1), 1