大家帮我看看我编的一个条形码程序!!!

Question

这个程序的画的条和空怎么不对,就是画矩形筐在循环的时候宽度发生变化呀!请高手指点!!!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 = 1Dim 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 = 30pic.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 iNext m
' 画右边的六个数字的模块
pic.CurrentX = 102 * x
pic.CurrentY = 30
n = -1For 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 SubPublic 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 Functioncode.mdb  表zifu
szfu leftA leftB rightC
0 0001101 0100111 1110010
1 0011001 0110011 1100110
2 0010011 0011011 1101100
3 0111101 0100001 1000010
4 0100011 0011101 1011100
5 0110001 0111001 1001110
6 0101111 0000101 1010000
7 0111011 0010001 1000100
8 0110111 0001001 1001000
9 0001011 0010111 1110100
表leftAorB
qzzfu left1 left2 left3 left4 left5 left6
0 A A A A A A
1 A A B A B B
2 A A B B A B
4 A B A A B B
5 A B B A A B
6 A B B B A A
7 A B A B A B
8 A B A B B A
9 A B B A B A

Answer 1

建议：不要考虑通过程序控制条码打印机！反之将需要打印的内容引出到txt文件中，再通过条码打印机自带的程序现实打印功能！

Answer 2

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
Dim y1 As Double, y2 As Double, x As Double
x = 0.33
y1 = 24.5
y2 = 22.85
n = 1
pic.ClsSet dbase = OpenDatabase("\条形码\code.mdb")
Set rs1 = dbase.OpenRecordset("select * from zifu")
Set rs2 = dbase.OpenRecordset("select * from leftAorB")ch = Mid(Text1.Text, 1, 1)
rs2.FindFirst " qzzfu='" & ch & " '"    '读取条码中的第一个字符，并且判断选择条码左边字符读取规则'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 = 10
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.CurrentY = 10
n = -1
For j = 2 To 7
cha = Mid(Text1.Text, j, 1)
rs1.FindFirst "szfu='" & cha & " ' "          '查询条码字符所对应的数据库中的0和1中的记录
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.CurrentY = 10
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.CurrentY = 10
n = -1For m = 8 To 13
cha = Mid(Text1.Text, m, 1)
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.CurrentY = 10
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 SubPublic 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