这是一个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 yEnd SubPrivate 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 SubPrivate 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 SubPrivate 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 IntegerDim hang As Integer
Dim lie As IntegerDim dat(15) As Byte
Dim SkipMa As Integer
Dim ye As IntegerFor ye = 6 To 7For BianMa = 0 To 105hang = 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 yElseIf lie > 10 Then
lieB = (BianMa - (21 * (BianMa \ 21))) - 11Picture1.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 IfNext BianMaNext yets.CloseEnd SubPrivate Sub Text1_Change()End SubPrivate Sub Text2_Change()
If Val(Text2.Text) > 10 Then
VScroll1.Value = 10
Text2.Text = "10"
End If
VScroll1.Value = Val(Text2.Text)
End SubPrivate Sub Text3_Change()
If Val(Text3.Text) > 10 Then
VScroll2.Value = 10
Text3.Text = "10"
End If
VScroll2.Value = Val(Text3.Text)
End SubPrivate Sub Text4_Change()End SubPrivate Sub Text5_Change()End SubPrivate Sub Text6_Change()
If Val(Text6.Text) > 15 Then
VScroll3.Value = 15
Text6.Text = "15"
End If
VScroll3.Value = Val(Text6.Text)
End SubPrivate Sub Text7_Change()End SubPrivate Sub VScroll1_Change()
Text2.Text = Format(VScroll1.Value)
End Sub
Private Sub VScroll2_Change()
Text3.Text = Format(VScroll2.Value)
End SubPrivate Sub VScroll3_Change()
Text6.Text = Format(VScroll3.Value)
End Sub