这是打印 CODE39 的条码

来源：互联网发布：数据库分为哪几种方法编辑：程序博客网时间：2024/04/27 14:14

'添加 Command1 Text1 Picture1

Option Explicit
Private Sub Form_Load()
Picture1.ScaleMode = 3
Picture1.AutoRedraw = True
Command1.Caption = "打印"
End Sub

Private Sub MakeBC()
Dim X%, Y%, z%, pos%, Bardata$, Cur$, CurVal&, chksum&, chkchr$, BC$(43)
BC(0) = "000110100" '0
BC(1) = "100100001" '1
BC(2) = "001100001" '2
BC(3) = "101100000" '3
BC(4) = "000110001" '4
BC(5) = "100110000" '5
BC(6) = "001110000" '6
BC(7) = "000100101" '7
BC(8) = "100100100" '8
BC(9) = "001100100" '9
Picture1.Cls
If Text1.Text = "" Then Exit Sub
pos = 20
Bardata = UCase(Text1.Text)
For X = 1 To Len(Bardata)
Cur = Mid(Bardata, X, 1)
CurVal = Val(Cur)
chksum = chksum + CurVal
Next
Picture1.CurrentX = 35 + Len(Bardata) * (5 + 1 * 2)
Picture1.CurrentY = 50
Picture1.Print Bardata;
chksum = chksum Mod 43
chkchr = Mid("0123456789", chksum + 1, 1)
Bardata = Bardata & chkchr
Bardata = "*" & Bardata & "*"
For X = 1 To Len(Bardata)
Cur = Mid(Bardata, X, 1)
CurVal = Val(Cur)
For Y = 1 To 9
If Y Mod 2 = 0 Then
pos = pos + 1 + (2 * Val(Mid(BC(CurVal), Y, 1))) + 1
Else
For z = 1 To 1 + (2 * Val(Mid(BC(CurVal), Y, 1)))
Picture1.Line (pos, 1)-(pos, 58 - 1 * 8)
pos = pos + 1
Next z
End If
Next
pos = pos + 1 + 1
Next
End Sub

Private Sub Text1_Change()
Call MakeBC
End Sub

Private Sub Command1_Click()
Picture1.Picture = Picture1.Image
Printer.PaintPicture Picture1.Picture, 0, 0, Picture1.Width, Picture1.Height
Printer.EndDoc
End Sub