关于打印条形码的问题

[qjzrd]

我想用vb做一个，打印出二维条码的程序，不知到哪位有原代码，谢谢

[wwqna]

VB应用程序中打印条形码的两种方法
（作者：四川　李佑民　2000年05月12日 12:28）

Private Sub Command1_Click()

　　Dim strOut As String

　　StrOut = “这是直接发送到打印机端口的字符串”

　　‘ 打开打印机端口，其中的”LPT1:”可能需要根据你的打印机设置而改变

　　Open “LPT1:” For Binary Access Write As #1

　　‘ 发送给打印机，注意语句的最后一个参数必须是变量

　　　　Put #1, ,strOut

　　　　‘ 关闭打印机端口

　　　　Close #1

End Sub

　　各种打印机打印条形码的指令可能不同，比如将上面的变量 strOut赋值为：

　　strOut = Chr(28) & “P” & Chr(5) & Chr(2) & Chr(3) & Chr(3) & Chr(6) & “012345”

　　将在 AR2400 打印机上打印出内容为”012345”的 CODE39 格式的条形码。具体的打印控制指令请参考打印机手册。

　　用这种方法的缺点：一是过份依赖打印机本身，而有条形码打印功能的打印机通常要比普通打印机昂贵，这会使构造应用系统不够经济；二是所有的打印输出都必须你自己处理，比如打印定位就很浪费时间。



二、利用画图方式输出到普通打印机

　　条形码的编码规则不外乎是通过线条和线条间间隙的宽窄不同来表示二进制的１和０，只要我们了解了条形码的编码规则，完全可以用画图的方式在普通打印机上得到可以接受的效果。下面我们就使用最普遍的CODE39码进行讨论。

　　CODE39码的编码规则是：

１、 每五条线表示一个字符；

２、 粗线表示１，细线表示０；

３、 线条间的间隙宽的表示１，窄的表示０；

４、 五条线加上它们之间的四条间隙就是九位二进制编码，而且这九位中必定有三位是1，所以称为39码；

５、 条形码的首尾各一个＊标识开始和结束

　　在我们的程序中，给常用的字符都进行编码，解读时先取线条粗细，再取间隙宽窄，如：



　　上图中的字符＊就可以解读为 001101000，字符３解读为 110000100

　　下面就是我们给出的子过程：

' 将字符串 strBarCode 对应的条形码输出到缺省打印机

Private Sub PrintBarCode( _

　　ByVal strBarCode As String, _

　　Optional ByVal intXPos As Integer = 0, _

　　Optional ByVal intYPos As Integer = 0, _

　　Optional ByVal intPrintHeight As Integer = 10, _

　　Optional ByVal bolPrintText As Boolean = True _

)

' 参数说明:

' strBarCode　　　　- 要打印的条形码字符串

' intXPos, intYPos - 打印条形码的左上角坐标(缺省为(0,0)，坐标刻度为:毫米)

' intHeight　　　　 - 打印高度(缺省为一厘米,坐标刻度为:毫米)

' bolPrintText　　 - 是否打印人工识别字符(缺省为true)



' "0"-"9","A-Z","-","%","$"和"*" 的条码编码格式,总共 40 个字符

Static strBarTable(39) As String

' 初始化条码编码格式表

　　strBarTable(0) = "001100100"　　 ' 0

　　strBarTable(1) = "100010100"　　 ' 1

　　strBarTable(2) = "010010100"　　 ' 2

　　strBarTable(3) = "110000100"　　 ' 3

　　strBarTable(4) = "001010100"　　 ' 4

　　strBarTable(5) = "101000100"　　 ' 5

　　strBarTable(6) = "011000100"　　 ' 6

　　strBarTable(7) = "000110100"　　 ' 7

　　strBarTable(8) = "100100100"　　 ' 8

　　strBarTable(9) = "010100100"　　 ' 9

　　strBarTable(10) = "100010010"　　' A

　　strBarTable(11) = "010010010"　　' B

　　strBarTable(12) = "110000010"　　' C

　　strBarTable(13) = "001010010"　　' D

　　strBarTable(14) = "101000010"　　' E

　　strBarTable(15) = "011000010"　　' F

　　strBarTable(16) = "000110010"　　' G

　　strBarTable(17) = "100100010"　　' H

[wwqna]

　　strBarTable(18) = "010100010"　　' I

　　strBarTable(19) = "001100010"　　' J

　　strBarTable(20) = "100010001"　　' K

　　strBarTable(21) = "010010001"　　' L

　　strBarTable(22) = "110000001"　　' M

　　strBarTable(23) = "001010001"　　' N

　　strBarTable(24) = "101000001"　　' O

　　strBarTable(25) = "011000001"　　' P

　　strBarTable(26) = "000110001"　　' Q

　　strBarTable(27) = "100100001"　　' R

　　strBarTable(28) = "010100001"　　' S

　　strBarTable(29) = "001100001"　　' T

　　strBarTable(30) = "100011000"　　' U

　　strBarTable(31) = "010011000"　　' V

　　strBarTable(32) = "110001000"　　' W

　　strBarTable(33) = "001011000"　　' X

　　strBarTable(34) = "101001000"　　' Y

　　strBarTable(35) = "011001000"　　' Z

　　strBarTable(36) = "000111000"　　' -

　　strBarTable(37) = "100101000"　　' %

　　strBarTable(38) = "010101000"　　' $

　　strBarTable(39) = "001101000"　　' *



　　If strBarCode = "" Then Exit Sub ' 不打印空串



　　' 保存打印机 ScaleMode

　　Dim intOldScaleMode As ScaleModeConstants

　　intOldScaleMode = Printer.ScaleMode

　　' 保存打印机 DrawWidth

　　Dim intOldDrawWidth As Integer

　　intOldDrawWidth = Printer.DrawWidth

　　' 保存打印机 Font

　　Dim fntOldFont As StdFont

　　Set fntOldFont = Printer.Font

　　

　　Printer.ScaleMode = vbTwips ' 设置打印用的坐标刻度为缇(twip=1)

　　Printer.DrawWidth = 1　　 ' 线宽为 1

　　Printer.FontName = "宋体" ' 打印在条码下方字符的字体和大小

　　Printer.FontSize = 10

　　

　　Dim strBC As String　　　　 ' 要打印的条码字符串

　　strBC = Ucase(strBarCode)

　　' 将以毫米表示的 X 坐标转换为以缇表示

　　Dim x As Integer

　　x = Printer.ScaleX(intXPos, vbMillimeters, vbTwips)

　　' 将以毫米表示的 Y 坐标转换为以缇表示

　　Dim y As Integer

　　y = Printer.ScaleY(intYPos, vbMillimeters, vbTwips)

　　' 将以毫米表示的高度转换为以缇表示

　　Dim intHeight As Integer

　　intHeight = Printer.ScaleY(intPrintHeight, vbMillimeters, vbTwips)

　　

　　' 是否在条形码下方打印人工识别字符

　　If bolPrintText = True Then

　　　　' 条码打印高度要减去下面的字符显示高度

　　　　intHeight = intHeight - Printer.TextHeight(strBC)

　　End If

　　

　　Const intWidthCU As Integer = 30 ' 粗线和宽间隙宽度

　　Const intWidthXI As Integer = 10 ' 细线和窄间隙宽度

　　Dim intIndex As Integer　　　　　　' 当前处理的字符串索引

　　Dim i As Integer, j As Integer, k As Integer　　' 循环控制变量



　　' 添加起始字符

　　If Left(strBC, 1) <> "*" Then

　　　　strBC = "*" & strBC

　　End If

　　' 添加结束字符

　　If Right(strBC, 1) <> "*" Then

　　　　strBC = strBC & "*"

　　End If

　　

　　' 循环处理每个要显示的条码字符

　　For i = 1 To Len(strBC)

　　　　' 确定当前字符在 strBarTable 中的索引

　　　　Select Case Mid(strBC, i, 1)

　　　　Case "*"

　　　　　　intIndex = 39

　　　　Case "$"

　　　　　　intIndex = 38

　　　　Case "%"

　　　　　　intIndex = 37

　　　　Case "-"

　　　　　　intIndex = 36

　　　　Case "0" To "9"

　　　　　　intIndex = CInt(Mid(strBC, i, 1))

　　　　Case "A" To "Z"

　　　　　　intIndex = Asc(Mid(strBC, i, 1)) - Asc("A") + 10

　　　　Case Else

　　　　　　MsgBox "要打印的条形码字符串中包含无效字符！当前版本只支持字符 '0'-'9','A'-'Z','-','%','$'和'*'"

　　　　End Select

　　　　

　　　　' 是否在条形码下方打印人工识别字符

　　　　If bolPrintText = True Then

　　　　　　Printer.CurrentX = x

　　　　　　Printer.CurrentY = y + intHeight

　　　　　　Printer.Print Mid(strBC, i, 1)

　　　　End If

[wwqna]

　　　　For j = 1 To 5

　　　　　　' 画细线

　　　　　　If Mid(strBarTable(intIndex), j, 1) = "0" Then

　　　　　　　　For k = 0 To intWidthXI - 1

　　　　　　　　　　Printer.Line (x + k, y)-Step(0, intHeight)

　　　　　　　　Next k

　　　　　　　　x = x + intWidthXI

　　　　　　' 画宽线

　　　　　　Else

　　　　　　　　For k = 0 To intWidthCU - 1

　　　　　　　　　　Printer.Line (x + k, y)-Step(0, intHeight)

　　　　　　　　Next k

　　　　　　　　x = x + intWidthCU

　　　　　　End If



　　　　　　' 每个字符条码之间为窄间隙

　　　　　　If j = 5 Then

　　　　　　　　x = x + intWidthXI * 3

　　　　　　　　Exit For

　　　　　　End If

　　　　　　

　　　　　　' 窄间隙

　　　　　　If Mid(strBarTable(intIndex), j + 5, 1) = "0" Then

　　　　　　　　x = x + intWidthXI * 3

　　　　　　' 宽间隙

　　　　　　Else

　　　　　　　　x = x + intWidthCU * 2

　　　　　　End If

　　　　Next j

　　Next i



　　' 恢复打印机 ScaleMode

　　Printer.ScaleMode = intOldScaleMode

　　' 恢复打印机 DrawWidth

　　Printer.DrawWidth = intOldDrawWidth

　　' 恢复打印机 Font

　　Set Printer.Font = fntOldFont

End Sub



　　最理想的情况是将它做成一个控件，在控件中提供一个打印方法，该方法实现与上

　　那个过程大致相同，只是不能在控件中直接使用VB的Printer对象，否则VB会将你在控件中的打印输出处理为一个单独的页面，而是应该将Printer.hDc传给它，通过调用那些需要指定 HDC 的Windows API函数实现与容器的打印输出在一个页面上，比如我们可以这样定义这个控件的打印方法：

' PrintIt 方法将对应的条形码输出到缺省打印机

Public Sub PrintIt(ByVal PrintDC As Long, _

　　 Optional ByVal intXPos As Integer = 0, _

　　Optional ByVal intYPos As Integer = 0, _

　　 Optional ByVal intPrintHeight As Integer = 10)

　　既然不能使用Printer对象，那么画线和输出文字也不能使用Printer对象的Line和Print方法，在我们的程序中至少要申明以下三个Windows API函数：

‘ 移动画笔的位置

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





'自己都不知道是那弄来的了，所以只好全贴上来了

[qjzrd]

先谢谢这位兄弟的解答，这是一维的code39码。我已经在使用了，我需要
二维的条码打印，大家帮帮忙哦

[lxjlz]

ding

[Kdser_2008]

友情帮顶^_^

[qjzrd]

大哥姐姐门，帮帮小弟呀

[chbz]

我只知道在ACCESS2000里有带一个一维条码的控件，可以直接使用，二维的你可以找找专业条码编辑软件看看，像codesoft，label matrix 等

[qjzrd]

谢谢楼上的，伤心没有高人来帮小弟吗？

[jtkkjtkk]

原来见过朋友用条码字体做的代码，非常方便，速度也快，你看看这种方法吧，工作量会少得多。

[sigporsson]

http://sourceforge.net/projects/winbarcodes/

这里有一个简单的例子，不过是用条码字体实现的，你可以参考一下。

如果全部自己生成图像就麻烦得多了，你至少需要有相关的国标或 ISO 标准。

[qjzrd]

楼上的兄弟，能给我看看吗 ？

我的信箱是[e-mail]

谢谢

[mndsoft]

有个例子已发送给你,不知道能否满足你。

[mndsoft]

再帖一个：

Private Sub Command1_Click()
PrintBarCode "d", 1, 1, "s"
End Sub

Public Sub PrintBarCode(TransNo As String, LineNo As Long, QtyStored As Long, SerialNo As String)
'Note: No spaces is allowed in the double-qoute of barcode printing syntax
'BarCode Printer Model : B-572-QP (Toshiba Tec)

Dim ESC: Dim LF: Dim NUL

ESC = Chr$(&H1B): LF = Chr$(&HA): NUL = Chr$(&H0)

Open "LPT1" For Output As #1
'Set initial setting
Print #1, ESC; "AY;+00,0"; LF; NUL;
Print #1, ESC; "D0980,1280,0940"; LF; NUL;

Print #1, ESC; "C"; LF; NUL;

Print #1, ESC; "XR;0000,0000,1280,0940,A"; LF; NUL;
Print #1, ESC; "AX;+000,+000,+00"; LF; NUL;
Print #1, ESC; "U2;0130"; LF; NUL;

'Print barcode parameters
Print #1, ESC; "XB01;0050,0150,3,1,03,03,07,07,02,0,0090,+0000000000,0,00"; LF; NUL; 'PartNo Barcode
Print #1, ESC; "XB02;0810,0150,3,1,03,03,07,07,02,0,0090,+0000000000,0,00"; LF; NUL; 'BatchNo Barcode
Print #1, ESC; "XB03;0050,0645,3,1,03,03,07,07,02,0,0090,+0000000000,0,00"; LF; NUL; 'Transfer Order Barcode
Print #1, ESC; "XB04;0810,0645,3,1,03,03,07,07,02,0,0090,+0000000000,0,00"; LF; NUL; 'DeliveryNo Barcode

'Print label heading parameters
Print #1, ESC; "PC001;0050,0290,05,05,M,+00,00,B"; LF; NUL; 'PartNo
Print #1, ESC; "PC002;0830,0290,05,05,M,+00,00,B"; LF; NUL; 'BatchNo
Print #1, ESC; "PC003;0050,0340,05,05,M,+00,00,B"; LF; NUL; 'Old Part No
Print #1, ESC; "PC004;0050,0390,05,05,M,+00,00,B"; LF; NUL; 'SerialNo
Print #1, ESC; "PC005;0830,0390,05,05,M,+00,00,B"; LF; NUL; 'Qty + UOM
Print #1, ESC; "PC006;0050,0440,05,05,M,+00,00,B"; LF; NUL; 'Description
Print #1, ESC; "PC007;0050,0490,05,05,M,+00,00,B"; LF; NUL; 'Sales Order No
Print #1, ESC; "PC008;0830,0490,05,05,M,+00,00,B"; LF; NUL; 'Sales LineNo
Print #1, ESC; "PC009;0050,0540,05,05,M,+00,00,B"; LF; NUL; 'Cust RefNo
Print #1, ESC; "PC010;0050,0590,05,05,M,+00,00,B"; LF; NUL; 'Cust Part No
Print #1, ESC; "PC011;0130,0800,05,05,M,+00,00,B"; LF; NUL; 'Transfer Order
Print #1, ESC; "PC012;0480,0800,05,05,M,+00,00,B"; LF; NUL; 'Transfer LineNo
Print #1, ESC; "PC013;0780,0800,05,05,M,+00,00,B"; LF; NUL; 'Storage Type
Print #1, ESC; "PC014;1080,0800,05,05,M,+00,00,B"; LF; NUL; 'DeliveryNo
Print #1, ESC; "PC015;0070,0920,05,05,M,+00,00,B"; LF; NUL; 'Footer

'Print label information parameters
Print #1, ESC; "PC016;0290,0290,2,2,G,+00,00,B"; LF; NUL; 'PartNo
Print #1, ESC; "PC017;0950,0290,2,2,G,+00,00,B"; LF; NUL; 'BatchNo
Print #1, ESC; "PC018;0310,0340,2,2,G,+00,00,B"; LF; NUL; 'Old Part No
Print #1, ESC; "PC019;0265,0390,2,2,G,+00,00,B"; LF; NUL; 'SerialNo
Print #1, ESC; "PC020;0940,0390,2,2,G,+00,00,B"; LF; NUL; 'Qty + UOM
Print #1, ESC; "PC021;0290,0440,2,2,G,+00,00,B"; LF; NUL; 'Description
Print #1, ESC; "PC022;0445,0490,2,2,G,+00,00,B"; LF; NUL; 'Sales Order No
Print #1, ESC; "PC023;0940,0490,2,2,G,+00,00,B"; LF; NUL; 'Sales LineNo
Print #1, ESC; "PC024;0270,0540,2,2,G,+00,00,B"; LF; NUL; 'Cust RefNo
Print #1, ESC; "PC025;0350,0590,2,2,G,+00,00,B"; LF; NUL; 'Cust Part No
Print #1, ESC; "PC026;0070,0850,2,2,G,+00,00,B"; LF; NUL; 'Transfer Order
Print #1, ESC; "PC027;0480,0850,2,2,G,+00,00,B"; LF; NUL; 'Transfer LineNo
Print #1, ESC; "PC028;0740,0850,2,2,G,+00,00,B"; LF; NUL; 'Storage Type
Print #1, ESC; "PC029;0980,0850,2,2,G,+00,00,B"; LF; NUL; 'DeliveryNo

'Stamp heading to print
Print #1, ESC; "RC001;Part Number:"; LF; NUL; 'PartNo
Print #1, ESC; "RC002;Batch:"; LF; NUL; 'BatchNo
Print #1, ESC; "RC003;Old Part No.:"; LF; NUL; 'Old Part No
Print #1, ESC; "RC004;Serial No.:"; LF; NUL; 'SerialNo
Print #1, ESC; "RC005;Qty.:"; LF; NUL; 'Qty + UOM
Print #1, ESC; "RC006;Description:"; LF; NUL; 'Description
Print #1, ESC; "RC007;MTU Sales Order No.:"; LF; NUL; 'Sales Order No
Print #1, ESC; "RC008;Line:"; LF; NUL; 'Sales LineNo
Print #1, ESC; "RC009;Cust. Ref.:"; LF; NUL; 'Cust RefNo
Print #1, ESC; "RC010;Cust. Part No.:"; LF; NUL; 'Cust Part No
Print #1, ESC; "RC011;TO"; LF; NUL; 'Transfer Order
Print #1, ESC; "RC012;TO LINE"; LF; NUL; 'Transfer LineNo
Print #1, ESC; "RC013;ST"; LF; NUL; 'Storage Type
Print #1, ESC; "RC014;DN"; LF; NUL; 'DeliveryNo
Print #1, ESC; "RC015;Proper storage and preservation of parts prolong shelf life"; LF; NUL; 'Footer

'Stamp data to print
Print #1, ESC; "RB01;" & txtPart & ""; LF; NUL; 'PartNo Barcode
If txtBatch <> "" Then Print #1, ESC; "RB02;" & txtBatch & ""; LF; NUL; 'BatchNo Barcode
Print #1, ESC; "RB03;" & txtTO & ""; LF; NUL; 'Transfer Order Barcode
If txtDO <> "" Then Print #1, ESC; "RB04;" & txtDO & ""; LF; NUL; 'DeliveryNo Barcode

Print #1, ESC; "RC016;" & txtPart & ""; LF; NUL; 'PartNo
If txtBatch <> "" Then Print #1, ESC; "RC017;" & txtBatch & ""; LF; NUL; 'BatchNo
If txtOldPart <> "" Then Print #1, ESC; "RC018;" & txtOldPart & ""; LF; NUL; 'Old Part No
If txtSn <> "0" Then Print #1, ESC; "RC019;" & txtSn & ""; LF; NUL; 'SerialNo
Print #1, ESC; "RC020;" & Form1 & " " & IIf(txtUOM <> "", txtUOM, "") & ""; LF; NUL; 'Qty + UOM
If txtDesc <> "" Then Print #1, ESC; "RC021;" & txtDesc & ""; LF; NUL; 'Description
If txtSO <> "" Then Print #1, ESC; "RC022;" & txtSO & ""; LF; NUL; 'Sales Order No
If txtLine <> "" Then Print #1, ESC; "RC023;" & txtLine & ""; LF; NUL; 'Sales LineNo
If txtCustRef <> "" Then Print #1, ESC; "RC024;" & txtCustRef & ""; LF; NUL; 'Cust RefNo
If txtCustPart <> "" Then Print #1, ESC; "RC025;" & txtCustPart & ""; LF; NUL; 'Cust Part No
Print #1, ESC; "RC026;" & txtTO & ""; LF; NUL; 'Transfer Order
Print #1, ESC; "RC027;" & txtTOLine & ""; LF; NUL; 'Transfer LineNo
If txtST <> "" Then Print #1, ESC; "RC028;" & txtST & ""; LF; NUL; 'Storage Type
If txtDO <> "" Then Print #1, ESC; "RC029;" & txtDO & ""; LF; NUL; 'DeliveryNo

Print #1, ESC; "LC;0050,0755,1280,0755,0,4"; LF; NUL; 'Horizontal Seperator
Print #1, ESC; "LC;0050,0875,1280,0875,0,4"; LF; NUL; 'Horizontal Separator
Print #1, ESC; "LC;0420,0755,0420,0875,0,4"; LF; NUL; 'Vertical Separator
Print #1, ESC; "LC;0710,0755,0710,0875,0,4"; LF; NUL; 'Vertical Separator
Print #1, ESC; "LC;0960,0755,0960,0875,0,4"; LF; NUL; 'Vertical Separator

'Print barcode
Print #1, ESC; "XS;I,0001,0003C3100"; LF; NUL;
Print #1, ESC; "U1;0130"; LF; NUL

Close #1

End Sub

[qjzrd]

谢谢这位大哥，我看看行不

呵呵

[cosio]

给你一个打印条形码的控件!

[qjzrd]

楼上的老大哥，我的信箱是[e-mail]

或者是[e-mail]

这两天没有来。呵呵

谢谢，

[qjzrd]

那位大哥好象没有给我发也，我没有收到