大家帮我看看我编的一个条形码程序!!!
这个程序的画的条和空怎么不对,就是画矩形筐在循环的时候宽度发生变化呀!
请高手指点!!!
Private Sub Command1_Click()
Dim n As Integer
Dim dbase As Database
Dim rs1 As Recordset, rs2 As Recordset
Dim cha As String, ch As String
Set dbase = OpenDatabase( "\条形码\code.mdb ")
Set rs1 = dbase.OpenRecordset( "select * from zifu ")
Set rs2 = dbase.OpenRecordset( "select * from leftAorB ")
ch = Mid(Text1.Text, 1, 1)
'Data1.Refresh
rs2.FindFirst " qzzfu= ' " & ch & " ' "
'strsql2 = "select qzzfu from leftAorB where qzzfu= " & ch & " "
pic.Cls
n = 1
Dim y1 As Double, y2 As Double, x As Double
x = 0.33
y1 = 24.5
y2 = 22.85
'If Mid(Text1.Text, 13, 1) = Val(checkcode(Text1.Text)) Then
' MsgBox "你输入的条形码是正确的 。请按确定键画条形码。 "
'ElseIf Mid(Text1.Text, 13, 1) <> Val(checkcode(Text1.Text)) Then
' MsgBox "你输入的条形码数字有错误，请核对重新输入。 "
' Text1.Text = " "
' Exit Sub
'End If
pic.CurrentX = 0
pic.CurrentY = 30
pic.Line -Step(x * 9, y1), RGB(255, 255, 255), BF
'画前面九个空白模块，将坐标x移动9个0.33单位,
For i = 1 To 3
n = n * (-1)
If i Mod 2 = 1 Then
pic.Line -Step(x, y1 * n), , BF
Else: pic.Line -Step(x, y1 * n), RGB(255, 255, 255), BF
End If
Next i
'画起始间隔的三个模块101
pic.CurrentX = 13 * x
pic.CurrentY = 30
n = -1
For j = 2 To 7
'Data1.Refresh
cha = Mid(Text1.Text, j, 1)
rs1.FindFirst "szfu= ' " & cha & " ' "
If rs2.Fields(j - 1) = "A " Then
sqltext = rs1.Fields(1)
For i = 1 To 7
n = -1 * n
If Mid(sqltext, i, 1) = "1 " Then
pic.Line -Step(x, y2 * n), , BF
ElseIf Mid(sqltext, i, 1) = "0 " Then
pic.Line -Step(x, y2 * n), RGB(255, 255, 255), BF
End If
Next i
End If
If rs2.Fields(j - 1) = "B " Then
sqltext = rs1.Fields(2)
For i = 1 To 7
n = -1 * n
If Mid(sqltext, i, 1) = "1 " Then
pic.Line -Step(x, y2 * n), , BF
ElseIf Mid(sqltext, i, 1) = "0 " Then
pic.Line -Step(x, y2 * n), RGB(255, 255, 255), BF
End If
Next i
End If
Next j
' 画左边的六个数字的模块
pic.CurrentX = 55 * x
pic.CurrentY = 30
n = -1
For k = 1 To 5
n = n * (-1)
If k Mod 2 = 1 Then
pic.Line -Step(x, y1 * n), RGB(255, 255, 255), BF
Else: pic.Line -Step(x, y1 * n), , BF
End If
Next k
'画中间间隔符，五个模块
pic.CurrentX = 60 * x
pic.CurrentY = 30
n = -1
For m = 8 To 13
cha = Mid(Text1.Text, m, 1)
'Data1.Refresh
rs1.FindFirst "szfu= ' " & cha & " ' "
sqltext = rs1.Fields(3)
For i = 1 To 7
n = -1 * n
If Mid(sqltext, i, 1) = "1 " Then
pic.Line -Step(x, y2 * n), , BF
Else
pic.Line -Step(x, y2 * n), RGB(255, 255, 255), BF
End If
Next i
Next m
' 画右边的六个数字的模块
pic.CurrentX = 102 * x
pic.CurrentY = 30
n = -1
For i = 1 To 3
n = n * (-1)
If i Mod 2 = 1 Then
pic.Line -Step(x, y1 * n), , BF
Else: pic.Line -Step(x, y1 * n), RGB(255, 255, 255), BF
End If
Next i
'画终此间隔的三个模块101
End Sub
Public Function checkcode(ch As String)
Dim m As Integer, js As Integer, os As Integer
js = 0
os = 0
Dim a() As Integer
m = Len(ch)
ReDim a(m)
For i = 1 To m Step 1
a(i) = Val(Mid(ch, i, 1))
Next i
For i = 1 To m
If i Mod 2 = 1 Then
js = js + a(i)
Else: os = os + a(i)
End If
Next i
checkcode = 10 - (js + os * 3) Mod 10
If checkcode = 10 Then
checkcode = 0
End If
End Function
code.mdb 表zifu
szfuleftAleftBrightC
0000110101001111110010
1001100101100111100110
2001001100110111101100
3011110101000011000010
4010001100111011011100
5011000101110011001110
6010111100001011010000
7011101100100011000100
8011011100010011001000
9000101100101111110100
表leftAorB
qzzfuleft1left2left3left4left5left6
0AAAAAA
1AABABB
2AABBAB
4ABAABB
5ABBAAB
6ABBBAA
7ABABAB
8ABABBA
9ABBABA
[解决办法]
有些乱，明天再看。
你为什么不用专用的软件生成条形码？现在主要的128码和39码，以及国标码都由专用软件生成的，你要得到什么码，非要自己去编？
[解决办法]
请指出哪句有问题,方便大家看和解决问题
