VB打印CODE39条形码源代码

天云上人

Private Sub Command1_Click()
    Picture1.Picture = LoadPicture("")

    Call PrintBarCode1(Text1)
   
    Picture1.Print
   
    'Printer.PaintPicture Picture1.Image, 200, Picture1.Top + 1000

End Sub

Private Sub PrintBarCode1( _
     ByVal strBarCode As String, _
     Optional ByVal intXPos As Integer = 10, _
     Optional ByVal intYPos As Integer = 10, _
     Optional ByVal intPrintHeight As Integer = 5, _
     Optional ByVal bolPrintText As Boolean = False _
)

'注释: 参数说明:

'注释: 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

     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 = Picture1.ScaleMode

'注释:       保存打印机 DrawWidth

     Dim intOldDrawWidth As Integer

     intOldDrawWidth = Picture1.DrawWidth

'注释:       保存打印机 Font

     Dim fntOldFont As StdFont

     Set fntOldFont = Picture1.Font

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

     Picture1.DrawWidth = 1     '注释： 线宽为 1

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

     Picture1.FontSize = 10

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

     strBC = UCase(strBarCode)

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

     Dim x As Integer

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

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

     Dim y As Integer

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

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

     Dim intHeight As Integer

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

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

     If bolPrintText = True Then

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

         intHeight = intHeight - Picture1.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

             Picture1.CurrentX = x

             Picture1.CurrentY = y + intHeight

             Picture1.Print Mid(strBC, i, 1)

         End If

         For j = 1 To 5

'注释:               画细线

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

                 For k = 0 To intWidthXI - 1

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

                 Next k

                 x = x + intWidthXI

'注释:               画宽线

             Else

                 For k = 0 To intWidthCU - 1

                     Picture1.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

     ScaleMode = intOldScaleMode

'注释:       恢复打印机 DrawWidth

     Picture1.DrawWidth = intOldDrawWidth

'注释:       恢复打印机 Font

     Set Picture1.Font = fntOldFont
   

End Sub

原文：http://hi.baidu.com/zzz0058/item/5ceb5108164d6e18ebfe382b