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

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
...全文
10 2 点赞 打赏 收藏 举报
写回复
2 条回复
切换为时间正序
当前发帖距今超过3年,不再开放新的回复
发表回复
zhaoyongshun 2004-05-04
我试了
是可以在105处 不溢出了
但 还是在后面的地方溢出
  • 打赏
  • 举报
回复
饮水需思源 2004-05-04
把定义成integer的变量定义成long试试
  • 打赏
  • 举报
回复
相关推荐
发帖
非技术类
加入

724

社区成员

VB 版八卦、闲侃,联络感情地盘,禁广告帖、作业帖
申请成为版主
帖子事件
创建了帖子
2004-05-04 08:11
社区公告
暂无公告