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
好吧,代码贴出来了