下面是39码的规则，你看看 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 LongEnd 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)'注释: 参数说明: ' '注释: strBarCode -要打印的条形码字符串 ' '注释： intXPos, intYPos - 打印条形码的左上角坐标(缺省为(0,0)，坐标刻度为:毫米) ' '注释： intHeight - 打印高度(缺省为一厘米,坐标刻度为:毫米) ' '注释: bolPrintText -是否打印人工识别字符(缺省为true) ' ' '注释： "0"-"9","A-Z","-","%","$"和"*" 的条码编码格式,总共 40 个字符Static strBarTable(39) As String'注释: 初始化条码编码格式表 strBarTable(0) = "000110100" '注释： 0 strBarTable(1) = "100100001" '注释： 1 strBarTable(2) = "001100001" '注释： 2 strBarTable(3) = "101100000" '注释： 3 strBarTable(4) = "000110001" '注释： 4 strBarTable(5) = "100110000" '注释： 5 strBarTable(6) = "001110000" '注释： 6 strBarTable(7) = "000100101" '注释： 7 strBarTable(8) = "100100100" '注释： 8 strBarTable(9) = "001100100" '注释： 9 strBarTable(10) = "100001001" '注释： A strBarTable(11) = "001001001" '注释： B strBarTable(12) = "101001000" '注释： C strBarTable(13) = "000011001" '注释： D strBarTable(14) = "100011000" '注释： E strBarTable(15) = "001011000" '注释： F strBarTable(16) = "000001101" '注释： G strBarTable(17) = "100001100" '注释： H strBarTable(18) = "001001101" '注释： I strBarTable(19) = "000011100" '注释： J strBarTable(20) = "100000011" '注释： K strBarTable(21) = "001000011" '注释： L strBarTable(22) = "101000010" '注释： M strBarTable(23) = "000010011" '注释： N strBarTable(24) = "100010010" '注释： O strBarTable(25) = "001010010" '注释： P strBarTable(26) = "000000111" '注释： Q strBarTable(27) = "100000110" '注释： R strBarTable(28) = "001000110" '注释： S strBarTable(29) = "000010110" '注释： T strBarTable(30) = "110000001" '注释： U strBarTable(31) = "011000001" '注释： V strBarTable(32) = "111000000" '注释： W strBarTable(33) = "010010001" '注释： X strBarTable(34) = "110010000" '注释： Y strBarTable(35) = "011010000" '注释： Z strBarTable(36) = "010000101" '注释： - strBarTable(37) = "000101010" '注释： % strBarTable(38) = "010101000" '注释： $ strBarTable(39) = "010010100" '注释： * If strBarCode = "" Then Exit Sub '注释： 不打印空串'注释: 保存打印机 ScaleMode Dim intOldScaleMode As ScaleModeConstants intOldScaleMode = Pic.ScaleMode'注释: 保存打印机 DrawWidth Dim intOldDrawWidth As Integer intOldDrawWidth = Pic.DrawWidth'注释: 保存打印机 Font Dim fntOldFont As StdFont Set fntOldFont = Pic.Font Pic.ScaleMode = vbTwips '注释： 设置打印用的坐标刻度为缇(twip=1) Pic.DrawWidth = 1 '注释： 线宽为 1 Pic.FontName = "宋体" '注释： 打印在条码下方字符的字体和大小 Pic.FontSize = 8 Dim strBC As String '注释： 要打印的条码字符串 strBC = UCase(strBarCode) '注释： 将以毫米表示的 X 坐标转换为以缇表示 Dim x As Integer x = Pic.ScaleX(intXPos, vbMillimeters, vbTwips) '注释： 将以毫米表示的 Y 坐标转换为以缇表示 Dim y As Integer y = Pic.ScaleY(intYPos, vbMillimeters, vbTwips)'注释: 将以毫米表示的高度转换为以缇表示 Dim intHeight As Integer intHeight = Pic.ScaleY(intPrintHeight, vbMillimeters, vbTwips) '注释: 是否在条形码下方打印人工识别字符 If bolPrintText = True Then '注释: 条码打印高度要减去下面的字符显示高度 intHeight = intHeight - Pic.TextHeight(strBC) End If Const intWidthCU As Integer = 60 '注释： 粗线和宽间隙宽度 Const intWidthXI As Integer = 20 '注释： 细线和窄间隙宽度 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 ' 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'注释: 恢复打印机 DrawWidth Pic.DrawWidth = intOldDrawWidth'注释: 恢复打印机 Font Set Pic.Font = fntOld
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 LongEnd 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)'注释: 参数说明:
'
'注释: strBarCode -要打印的条形码字符串
'
'注释： intXPos, intYPos - 打印条形码的左上角坐标(缺省为(0,0)，坐标刻度为:毫米)
'
'注释： intHeight - 打印高度(缺省为一厘米,坐标刻度为:毫米)
'
'注释: bolPrintText -是否打印人工识别字符(缺省为true)
'
'
'注释： "0"-"9","A-Z","-","%","$"和"*" 的条码编码格式,总共 40 个字符Static strBarTable(39) As String'注释: 初始化条码编码格式表 strBarTable(0) = "000110100" '注释： 0 strBarTable(1) = "100100001" '注释： 1 strBarTable(2) = "001100001" '注释： 2 strBarTable(3) = "101100000" '注释： 3 strBarTable(4) = "000110001" '注释： 4 strBarTable(5) = "100110000" '注释： 5 strBarTable(6) = "001110000" '注释： 6 strBarTable(7) = "000100101" '注释： 7 strBarTable(8) = "100100100" '注释： 8 strBarTable(9) = "001100100" '注释： 9 strBarTable(10) = "100001001" '注释： A strBarTable(11) = "001001001" '注释： B strBarTable(12) = "101001000" '注释： C strBarTable(13) = "000011001" '注释： D strBarTable(14) = "100011000" '注释： E strBarTable(15) = "001011000" '注释： F strBarTable(16) = "000001101" '注释： G strBarTable(17) = "100001100" '注释： H strBarTable(18) = "001001101" '注释： I strBarTable(19) = "000011100" '注释： J strBarTable(20) = "100000011" '注释： K strBarTable(21) = "001000011" '注释： L strBarTable(22) = "101000010" '注释： M strBarTable(23) = "000010011" '注释： N strBarTable(24) = "100010010" '注释： O strBarTable(25) = "001010010" '注释： P strBarTable(26) = "000000111" '注释： Q strBarTable(27) = "100000110" '注释： R strBarTable(28) = "001000110" '注释： S strBarTable(29) = "000010110" '注释： T strBarTable(30) = "110000001" '注释： U strBarTable(31) = "011000001" '注释： V strBarTable(32) = "111000000" '注释： W strBarTable(33) = "010010001" '注释： X strBarTable(34) = "110010000" '注释： Y strBarTable(35) = "011010000" '注释： Z strBarTable(36) = "010000101" '注释： - strBarTable(37) = "000101010" '注释： % strBarTable(38) = "010101000" '注释： $ strBarTable(39) = "010010100" '注释： * If strBarCode = "" Then Exit Sub '注释： 不打印空串'注释: 保存打印机 ScaleMode Dim intOldScaleMode As ScaleModeConstants intOldScaleMode = Pic.ScaleMode'注释: 保存打印机 DrawWidth Dim intOldDrawWidth As Integer intOldDrawWidth = Pic.DrawWidth'注释: 保存打印机 Font Dim fntOldFont As StdFont Set fntOldFont = Pic.Font Pic.ScaleMode = vbTwips '注释： 设置打印用的坐标刻度为缇(twip=1) Pic.DrawWidth = 1 '注释： 线宽为 1 Pic.FontName = "宋体" '注释： 打印在条码下方字符的字体和大小 Pic.FontSize = 8 Dim strBC As String '注释： 要打印的条码字符串 strBC = UCase(strBarCode) '注释： 将以毫米表示的 X 坐标转换为以缇表示 Dim x As Integer x = Pic.ScaleX(intXPos, vbMillimeters, vbTwips) '注释： 将以毫米表示的 Y 坐标转换为以缇表示 Dim y As Integer y = Pic.ScaleY(intYPos, vbMillimeters, vbTwips)'注释: 将以毫米表示的高度转换为以缇表示 Dim intHeight As Integer intHeight = Pic.ScaleY(intPrintHeight, vbMillimeters, vbTwips)
'注释: 是否在条形码下方打印人工识别字符 If bolPrintText = True Then
'注释: 条码打印高度要减去下面的字符显示高度
intHeight = intHeight - Pic.TextHeight(strBC)
End If Const intWidthCU As Integer = 60 '注释： 粗线和宽间隙宽度 Const intWidthXI As Integer = 20 '注释： 细线和窄间隙宽度 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 ' 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'注释: 恢复打印机 DrawWidth Pic.DrawWidth = intOldDrawWidth'注释: 恢复打印机 Font Set Pic.Font = fntOld