一个程序问题，高手帮帮忙

zhaoyongshun 2004-05-04 08:11:47

这是一个vb程序用来画字库的，编译不过去报溢出。
高手能帮我看看那错了吗？主要是 Command6 这个自动功能

我在线可以通过 qq找我49229753

Private Sub Command1_Click()
Dim weizhi As Integer
Dim str As String
Dim adat As Integer
Dim hdat As Byte
Dim ldat As Byte
Dim dat(15) As Byte
ls = Left(Text1.Text, 1)
If LenB(ls) = 1 Then
MsgBox "请输入双字节字符！"
Exit Sub
End If
hdat = AscB(LeftB(StrConv(ls, vbFromUnicode), 1))
ldat = AscB(RightB(StrConv(ls, vbFromUnicode), 1))
If hdat < &HA1 Or hdat > &HF7 Or ldat < &HA1 Or ldat > &HFE Then
MsgBox "输入字符不是GB码字符！"
Exit Sub
End If
If Val(Text2.Text) = 10 Then
MsgBox "b图库超出范围"
Exit Sub
End If
Picture1.Cls
Picture1.ForeColor = &HFF&
Picture1.FontSize = 11
Picture1.CurrentX = 1
Picture1.CurrentY = 1
Picture1.Print Left(Text1.Text, 1)
Picture1.ForeColor = &HFFFFFF
Picture1.FontSize = 11
Picture1.CurrentX = 0
Picture1.CurrentY = 0
Picture1.Print Left(Text1.Text, 1)
For y = 0 To 14
For x = 0 To 15
If Picture1.Point(x, y) = 0 Then
dat(x) = &H0
ElseIf Picture1.Point(x, y) = 255 Then
dat(x) = &H1
Else
dat(x) = &H3
End If
Next x
weizhi = (0 + y) * 256
Open App.Path + "\b.bin" For Binary As #1
Put #1, 1032 + 1 + weizhi + Val(Text2.Text) * 24 + Val(Text3.Text) * 6144 + Val(Text6.Text) * 67584, dat
Close #1
Next y
str = Hex(Text3.Text * &H15 + Text2.Text + &HB)
If Len(str) < 2 Then str = "0" + str
Text4.Text = str
adat = AscW(StrConv(ls, vbFromUnicode))
Text5.Text = Hex(adat)
Text7.Text = Hex(&HC0 + Val(Text6.Text))
End Sub

Private Sub Command2_Click()
End
End Sub

Private Sub Command3_Click()
Dim dian(67583) As Byte
Picture2.Cls
Open App.Path + "\b.bin" For Binary As #1
Get #1, Val(Text6.Text) * 67584 + 1, dian
Close #1
For y = 0 To 263
For x = 0 To 255
If dian(x + y * 256) = &H0 Then
Picture2.PSet (x, y), 0
ElseIf dian(x + y * 256) = &H1 Then
Picture2.PSet (x, y), 255
Else
Picture2.PSet (x, y), RGB(255, 255, 255)
End If
Next x
Next y

End Sub

Private Sub Command4_Click()
Dim weizhi As Integer
Dim adat As Integer
Dim str As String
Dim hdat As Byte
Dim ldat As Byte
Dim dat(15) As Byte
ls = Left(Text1.Text, 1)
If LenB(ls) = 1 Then
MsgBox "请输入双字节字符！"
Exit Sub
End If
hdat = AscB(LeftB(StrConv(ls, vbFromUnicode), 1))
ldat = AscB(RightB(StrConv(ls, vbFromUnicode), 1))
If hdat < &HA1 Or hdat > &HF7 Or ldat < &HA1 Or ldat > &HFE Then
MsgBox "输入字符不是GB码字符！"
Exit Sub
End If
Picture1.Cls
Picture1.ForeColor = &HFF&
Picture1.FontSize = 11
Picture1.CurrentX = 1
Picture1.CurrentY = 1
Picture1.Print Left(Text1.Text, 1)
Picture1.ForeColor = &HFFFFFF
Picture1.FontSize = 11
Picture1.CurrentX = 0
Picture1.CurrentY = 0
Picture1.Print Left(Text1.Text, 1)
For y = 0 To 14
For x = 0 To 15
If Picture1.Point(x, y) = 0 Then
dat(x) = &H0
ElseIf Picture1.Point(x, y) = 255 Then
dat(x) = &H1
Else
dat(x) = &H3
End If
Next x
weizhi = (0 + y) * 256
Open App.Path + "\a.bin" For Binary As #1
Put #1, 1024 + 1 + weizhi + Val(Text2.Text) * 24 + Val(Text3.Text) * 6144 + Val(Text6.Text) * 67584, dat
Close #1
Next y
str = Hex(Text3.Text * &H15 + Text2.Text)
If Len(str) < 2 Then str = "0" + str
Text4.Text = str
adat = AscW(StrConv(ls, vbFromUnicode))
Text5.Text = Hex(adat)
Text7.Text = Hex(&HC0 + Val(Text6.Text))
End Sub

Private Sub Command5_Click()
Dim dian(67583) As Byte
Picture2.Cls
Open App.Path + "\a.bin" For Binary As #1
Get #1, Val(Text6.Text) * 67584 + 1, dian
Close #1
For y = 0 To 263
For x = 0 To 255
If dian(x + y * 256) = &H0 Then
Picture2.PSet (x, y), 0
ElseIf dian(x + y * 256) = &H1 Then
Picture2.PSet (x, y), 255
Else
Picture2.PSet (x, y), RGB(255, 255, 255)
End If
Next x
Next y
End Sub

Private Sub Command6_Click()
Dim fsoTest As New FileSystemObject, file1 As File, ts As TextStream, zi As String, BianMa As Integer
Dim weizhi As Integer
Dim weizhi2 As Integer

Dim hang As Integer
Dim lie As Integer

Dim dat(15) As Byte
Dim SkipMa As Integer
Dim ye As Integer

For ye = 6 To 7

For BianMa = 0 To 105

hang = BianMa \ 21
lie = BianMa - (21 * (BianMa \ 21))

Set file1 = fsoTest.GetFile("C:\testfile.txt")
Set ts = file1.OpenAsTextStream(ForReading)
SkipMa = 5 + (BianMa * 8)
ts.Skip (SkipMa)
zi = ts.Read(1)

If lie <= 10 Then

Picture1.Cls
Picture1.ForeColor = &HFF&
Picture1.FontSize = 11
Picture1.CurrentX = 1
Picture1.CurrentY = 1
Picture1.Print Left(zi, 1)
Picture1.ForeColor = &HFFFFFF
Picture1.FontSize = 11
Picture1.CurrentX = 0
Picture1.CurrentY = 0
Picture1.Print Left(zi, 1)
For y = 0 To 14
For x = 0 To 15
If Picture1.Point(x, y) = 0 Then
dat(x) = &H0
ElseIf Picture1.Point(x, y) = 255 Then
dat(x) = &H1
Else
dat(x) = &H3
End If
Next x
weizhi = (0 + y) * 256
Open App.Path + "\a.bin" For Binary As #1
Put #1, 1024 + 1 + weizhi + (lie * 24) + (hang * 6144) + (ye * 67584), dat
Close #1
Next y

ElseIf lie > 10 Then
lieB = (BianMa - (21 * (BianMa \ 21))) - 11

Picture1.Cls
Picture1.ForeColor = &HFF&
Picture1.FontSize = 11
Picture1.CurrentX = 1
Picture1.CurrentY = 1
Picture1.Print Left(zi, 1)
Picture1.ForeColor = &HFFFFFF
Picture1.FontSize = 11
Picture1.CurrentX = 0
Picture1.CurrentY = 0
Picture1.Print Left(zi, 1)
For y = 0 To 14
For x = 0 To 15
If Picture1.Point(x, y) = 0 Then
dat(x) = &H0
ElseIf Picture1.Point(x, y) = 255 Then
dat(x) = &H1
Else
dat(x) = &H3
End If
Next x
weizhi2 = (0 + y) * 256
Open App.Path + "\b.bin" For Binary As #1
Put #1, 1032 + 1 + weizhi2 + (lieB * 24) + (hang * 6144) + (ye * 67584), dat
Close #1
Next y

End If

Next BianMa

Next ye

ts.Close

End Sub

Private Sub Text1_Change()

End Sub

Private Sub Text2_Change()
If Val(Text2.Text) > 10 Then
VScroll1.Value = 10
Text2.Text = "10"
End If
VScroll1.Value = Val(Text2.Text)
End Sub

Private Sub Text3_Change()
If Val(Text3.Text) > 10 Then
VScroll2.Value = 10
Text3.Text = "10"
End If
VScroll2.Value = Val(Text3.Text)
End Sub

Private Sub Text4_Change()

End Sub

Private Sub Text5_Change()

End Sub

Private Sub Text6_Change()
If Val(Text6.Text) > 15 Then
VScroll3.Value = 15
Text6.Text = "15"
End If
VScroll3.Value = Val(Text6.Text)
End Sub

Private Sub Text7_Change()

End Sub

Private Sub VScroll1_Change()
Text2.Text = Format(VScroll1.Value)
End Sub

Private Sub VScroll2_Change()
Text3.Text = Format(VScroll2.Value)
End Sub

Private Sub VScroll3_Change()
Text6.Text = Format(VScroll3.Value)
End Sub

...全文