程序运行太慢了,有办法加快吗?

qiuyu2 2002-02-28 08:19:49
Private Sub Command7_Click()

Dim bPicBuf() As Byte
Dim lPicLen As Long
Dim sFileName As String
Dim lTemp As Long
Dim sTempStr As String

Text1.Text = ""
sFileName = List1.List(List1.ListIndex)
lPicLen = FileLen(sFileName)
ReDim bPicBuf(lPicLen)

Open sFileName For Binary Access Read As #1
Get #1, , bPicBuf()
Close #1

For lTemp = LBound(bPicBuf()) To UBound(bPicBuf()) - 1
sTempStr = Hex$(bPicBuf(lTemp))
If (bPicBuf(lTemp) < 16) Then
Text1.Text = Text1.Text + "0" + sTempStr + " "

Else: Text1.Text = Text1.Text + sTempStr + " "
End If

Next
Beep

End Sub

当图片文件256*32(256色)时大概需要40秒,此时lPicLen=10867,
图片189*189点(16位真彩)时程序好像就死在那里了,没有反映,lPicLen=107424
请大家看看上面的程序,是不是text1.text=text1.text+sTempStr+" "
这一句占的时间太长,有办法改进吗?
另外,textbox文本框最大值为32k,我上面的超过了吗?

是不是这是vb的固有缺陷?运行速度慢?
我以前用bc作过类似的程序,好像没有这个情况呀!

我要处理好多图片,一个图片就这样,我还如何做呀?刚开始学vb,大虾们多多帮助,分不够可以再加!
...全文
124 26 打赏 收藏 转发到动态 举报
写回复
用AI写文章
26 条回复
切换为时间正序
请发表友善的回复…
发表回复
zyl910 2002-03-01
  • 打赏
  • 举报
 回复
qiuyu1(秋雨)、qiuyu2 (冬雪)

两个账号？
秋雨 2002-02-28
  • 打赏
  • 举报
 回复
这些我基本上能看懂,就是对函数了语句了等等不了解,还好我刚买的visual basic 中文版参考详解不错,里面都有,了是你要是写错了我就找不到了,哈哈
比如:tStartByte = pBytes(tLoop)
写成: tStartByte = Bytes(tLoop),我还以为Bytes是什么函数呢,查了半天没找到!
KiteGirl 2002-02-28
  • 打赏
  • 举报
 回复
我之前给你的程序的函数有严重错误，因为这个程序没测试。下面是测试过的完成的程序。我写的程序都是分解成函数来写，所以乍一看可能你不习惯。看我这种函数型的程序一般是分解来看。BytesGetByFile的目的是把文件读到数组，而StringGetByBytes是把数组变成你要的字符串。两个函数适当组合起来就是你需要的程序了。我写的程序你看不懂，这对我来说不是一件好事情。因为容易理解的程序才适合大家合作交流。

'这是两个函数的使用方法：
Dim tBytes() As Byte
Dim tFileName As String

tFileName=你指定的文件名

BytesGetByFile tFileName,tBytes() '将tFileName指定的文件读到数组tBytes()里
tString=StringGetByBytes(tBytes()) '将数组tBytes()变成你要的字符串。

'下面是函数（有函数结构说明）：
Function StringGetByBytes(pBytes() As Byte) As String
'把包含文件全部数据的数组转换成字符串。
'定义段：定义用到的变量
Dim tOutStr As String
Dim tLoop As Long
Dim tLoopOn As Long
Dim tLoopEnd As Long
Dim tStartHEX_H As String * 1
Dim tStartHEX_L As String * 1
Dim tStartByte As Byte

'初始化段：准备好后面的工作所用的一切数值。
tLoopOn = LBound(pBytes): tLoopEnd = UBound(pBytes)

'工作段：开始计算
For tLoop = tLoopOn To tLoopEnd
tStartByte = pBytes(tLoop)
tStartHEX_H = Hex(tStartByte \ 16)
tStartHEX_L = Hex(tStartByte Mod 16)
tOutStr = tOutStr & tStartHEX_H & tStartHEX_L & " "
Next

'输出段：把结果输出
StringGetByBytes = tOutStr
End Function

Function BytesGetByFile(pFileName As String, pBytes() As Byte)
'从文件获得全部数据到数组里
Dim tFileNumber As Integer
Dim tFileLen As Long
tFileNumber = FreeFile
Open pFileName For Binary As #tFileNumber
tFileLen = LOF(tFileNumber)
ReDim pBytes(tFileLen)
Get #tFileNumber, 1, pBytes()
Close #tFileNumber
End Function

qiuyu2 2002-02-28
  • 打赏
  • 举报
 回复
我......靠......晕........了.........
好厉害呀!
只是不好意思,我看不懂如何加到我的程序中,我慢慢分析分析把.
谢谢你了小仙妹,我马上买单了.
KiteGirl 2002-02-28
  • 打赏
  • 举报
 回复
终于做出来了！如果你只是要看HEX值，这个程序对你有用（完整的Frm文件）。
另外：tFileLen=Len(#tFileNumber)这句我写错了！是tFileLen=LOF(#tFileNumber)

VERSION 5.00
Begin VB.Form Form1
Caption = "Form1"
ClientHeight = 4575
ClientLeft = 60
ClientTop = 345
ClientWidth = 5505
LinkTopic = "Form1"
ScaleHeight = 4575
ScaleWidth = 5505
StartUpPosition = 3 '窗口缺省
Begin VB.VScrollBar VScroll1
Height = 2655
Left = 4680
Max = 100
TabIndex = 5
Top = 1560
Width = 255
End
Begin VB.CommandButton Command4
Caption = ">"
Height = 255
Left = 4680
TabIndex = 4
Top = 1200
Width = 735
End
Begin VB.CommandButton Command3
Caption = "<"
Height = 255
Left = 4680
TabIndex = 3
Top = 840
Width = 735
End
Begin VB.CommandButton Command2
Caption = ">>"
Height = 255
Left = 4680
TabIndex = 2
Top = 480
Width = 735
End
Begin VB.CommandButton Command1
Caption = "<<"
Height = 255
Left = 4680
TabIndex = 1
Top = 120
Width = 735
End
Begin VB.TextBox Text1
Height = 4095
Left = 120
MultiLine = -1 'True
TabIndex = 0
Text = "FormMain.frx":0000
Top = 120
Width = 4455
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Public pubByteLineWidth As Integer '显示列宽
Public pubByteLineMax As Integer '显示行数
Public pubByteLineStart As Long '当前行
Public pubLineMax As Long '最大行数
Dim pubFileBytes() As Byte '文件数组
Dim pubCacheBytes() As Byte '显示区Cache数组

Private Sub Command1_Click()
pubByteLineStart = pubByteLineStart - pubByteLineMax
ViewUpData
End Sub

Private Sub Command2_Click()
pubByteLineStart = pubByteLineStart + pubByteLineMax
ViewUpData
End Sub

Private Sub Command3_Click()
pubByteLineStart = pubByteLineStart - 1
ViewUpData
End Sub

Private Sub Command4_Click()
pubByteLineStart = pubByteLineStart + 1
ViewUpData
End Sub

Private Sub Form_Load()
pubByteLineWidth = 16
pubByteLineMax = 16
pubByteLineStart = 0
CacheBytesReSet pubCacheBytes()
BytesGetByFile "Setup.bmp", pubFileBytes()
CacheBytesGetByBytes pubCacheBytes(), pubFileBytes()
Text1.Text = StringGetByCache(pubCacheBytes())
pubLineMax = UBound(pubFileBytes) \ pubByteLineWidth + 1
'Text1.Text = UBound(pubFileBytes)
End Sub

Function ViewUpData()
If pubByteLineStart > pubLineMax Then
pubByteLineStart = pubLineMax
ElseIf pubByteLineStart < 0 Then
pubByteLineStart = 0
End If
CacheBytesGetByBytes pubCacheBytes(), pubFileBytes()
Text1.Text = StringGetByCache(pubCacheBytes())
VScroll1.Value = pubByteLineStart * 100 \ pubLineMax
End Function

Function StringGetByCache(pCache() As Byte) As String
'将Cache里的数据转换成一页字符
Dim tOutStr As String
Dim tLoop As Long
Dim tLoopOn As Long
Dim tLoopEnd As Long
Dim tByteHEX_H As String * 1
Dim tByteHEX_L As String * 1
Dim tByteStart As Byte
tLoopOn = LBound(pCache)
tLoopEnd = UBound(pCache)
For tLoop = tLoopOn To tLoopEnd
tByteStart = pCache(tLoop)
tByteHEX_H = Hex(tByteStart \ 16)
tByteHEX_L = Hex(tByteStart Mod 16)
tOutStr = tOutStr & tByteHEX_H & tByteHEX_L & " "
If Not CBool((tLoop + 1) Mod pubByteLineWidth) Then tOutStr = tOutStr & Chr(13) & Chr(10)
Next
StringGetByCache = tOutStr
End Function

Function CacheBytesGetByBytes(pCache() As Byte, pBytes() As Byte)
'从数组中提取当前显示区域的数据到Cache
Dim tLoop As Long
Dim tLoopOn As Long
Dim tLoopEnd As Long
Dim tMisreg As Long
Dim tFileLen As Long
Dim tAddress As Long
tMisreg = AddressGetByLine(pubByteLineStart)
tLoopOn = LBound(pCache)
tLoopEnd = UBound(pCache)
tFileLen = UBound(pubFileBytes)
For tLoop = tLoopOn To tLoopEnd
tAddress = tLoop + tMisreg
If tAddress < tFileLen Then
pCache(tLoop) = pBytes(tAddress)
Else
pCache(tLoop) = 0
End If
Next
End Function

Function AddressGetByLine(pLine As Long) As Long
'行号转换成地址
Dim tOutLng As Long
tOutLng = pLine * pubByteLineWidth
AddressGetByLine = tOutLng
End Function

Function CacheBytesReSet(pCacheBytes() As Byte)
'重定义Cache数组
Dim tCacheSize As Long
tCacheSize = CacheSizeGet(pubByteLineWidth, pubByteLineMax) - 1
ReDim pCacheBytes(tCacheSize)
End Function

Function CacheSizeGet(pLineWidth As Integer, pLineMax As Integer) As Long
'根据显示列宽和行数获得Cache数组尺寸
Dim tOutLng As Long
tOutLng = pLineWidth * pLineMax
CacheSizeGet = tOutLng
End Function

Function BytesGetByFile(pFileName As String, pBytes() As Byte)
'从文件获得全部数据到数组里
Dim tFileNumber As Integer
Dim tFileLen As Long
tFileNumber = FreeFile
Open pFileName For Binary As #tFileNumber
tFileLen = LOF(tFileNumber)
ReDim pBytes(tFileLen)
Get #tFileNumber, 1, pBytes()
Close #tFileNumber
End Function

qiuyu2 2002-02-28
  • 打赏
  • 举报
 回复
我改为
tFileLen = Len(pFileName)可以了
还有错误:
tStartByte = Bytes(tLoop)
bytes不是函数呀,系统不认识
qiuyu2 2002-02-28
  • 打赏
  • 举报
 回复
小仙妹,下面的语句错误!我不懂,能看看吗?
tFileLen = Len(#tFileNumber)
qiuyu2 2002-02-28
  • 打赏
  • 举报
 回复
真棒!
910,你的程序比我的块多了!原来17s的图片变为1s.原来72s的还是1s!新程序16s的原来的程序执行了1000s还没有结束!
小仙妹你的程序我马上试
iwzw 2002-02-28
  • 打赏
  • 举报
 回复
up
KiteGirl 2002-02-28
  • 打赏
  • 举报
 回复
上面的程序是把一个ListBox里的文件名指定的文件转换为16进制表示的字符串，并在一个TextBox里显示出来。
KiteGirl 2002-02-28
  • 打赏
  • 举报
 回复
上面的程序是把一个ListBox里的文件名指定的文件转换为16进制表示的字符串，并在一个TextBox里显示出来。
KiteGirl 2002-02-28
  • 打赏
  • 举报
 回复
天啊！又错了！我今天怎么了？？
把BytesGetByFile函数的：
Get #tFileNumber,1,pBytes(tFileLen)
改为：
Get #tFileNumber,1,pBytes()
wgku 2002-02-28
  • 打赏
  • 举报
 回复
!!!大家告诉我上面的程序是做什么用的好吗？？
KiteGirl 2002-02-28
  • 打赏
  • 举报
 回复
太抱歉了！忘了写注释了。
BytesGetByFile函数是把文件读到Byte数组里，这个数组没有返回。
StringGetByBytes是根据你的要求把Byte数组变成你要的字符串返回。
你遇到的HEX值缺0问题我用的是取高低位来解决的，而不是IF语句。我把Byte值整除16得到高位、Mod 16得到低位。
qiuyu2 2002-02-28
  • 打赏
  • 举报
 回复
910的我基本看明白了,主要是把text1.text的操作改为字符串
小仙妹得慢慢看看,好麻烦呀,不是我要的主要是速度,我好好试试
谢谢各位,没问题马上加分
KiteGirl 2002-02-28
  • 打赏
  • 举报
 回复
刚发完就发现有错了，把BytesGetByFile函数的：
Get #1,1,pBytes(tFileLen)
改为：
Get #tFileNumber,1,pBytes(tFileLen)
Bardo 2002-02-28
  • 打赏
  • 举报
 回复
TO： zyl910(910：分儿，我来了！)
Sorry，我未仔细看
KiteGirl 2002-02-28
  • 打赏
  • 举报
 回复
我给你改了改，也就这样了（不过没测试有没有Bug，总的意思还是对的）
Private Sub Command7_Click()
Dim tFileName As String
Dim tBytes() As Byte

ReDim tBytes(0)

tFileName=List1.List(List1.ListIndex)
BytesGetByFile tFileName,tBytes()
Text1.Text=StringGetByBytes(tBytes())

End Sub

Function StringGetByBytes(pBytes() As Byte) As String

Dim tOutStr As String
Dim tLoop As Long
Dim tLoopOn As Long
Dim tLoopEnd As Long
Dim tStartHEX_H As String * 1
Dim tStartHEX_L As String * 1
Dim tStartByte As Byte

tLoopOn=LBound(pBytes):tLoopEnd=UBound(pBytes)

For tLoop=tLoopOn To tLoopEnd
tStartByte=Bytes(tLoop)
tStartHEX_H=Hex(tStartByte \ 16)
tStartHEX_L=Hex(tStartByte Mod 16)
tOutStr = tOutStr & tStartHEX_H & tStartHEX_L
Next

StringGetByBytes=tOutStr

End Function

Function BytesGetByFile(ByVal pFileName As String,pBytes() As Byte)
Dim tFileNumber As Integer
Dim tFileLen As Long

tFileNumber=FreeFile

Open pFileName For Binary As #tFileNumber
tFileLen = Len(#tFileNumber)
ReDim pBytes(tFileLen)
Get #1,1,pBytes(tFileLen)
Close #tFileNumber

End Function
zyl910 2002-02-28
  • 打赏
  • 举报
 回复
回复人： Bardo(巴顿) ( ) 信誉：100 2002-2-28 20:37:53 得分:0

TO： zyl910(910：分儿，我来了！)
你这就不对了
文件操作要比内存操作慢多了


不是已经读取到内存了？！
我只不过
把ta的Text1.Text改成了AllStr，因为这比读取属性快。
For循环中我改掉了取数组大小的函数。
Bardo 2002-02-28
  • 打赏
  • 举报
 回复
TO： zyl910(910：分儿，我来了！)
你这就不对了
文件操作要比内存操作慢多了！
加载更多回复（6）
微信小程序系统教程C#版[3/3阶段]_微信小程序电商系统
微信小程序系统教程[初级阶段]，微信小程序0基础学起，讲解微信小程序开发的基础知识。 微信小程序系统教程共有“微信小程序系统教程[初级阶段]”、“微信小程序系统教程[中级阶段]——核心技术”、“微信小程序...
相见恨晚的Matlab编程小技巧(3)-程序运行太慢了咋解决——合理使用循环语句(1)
相信大家在使用matlab时候经常会收到程序运行太慢的困扰，当程序比较复杂时，常常需要很长时间等待。我有个朋友就是这样，每次debug都要很长时间，等着的时候就想耍会手机，结果耍完一抬头发现程序运行结束了，但...
pyinstaller打包的exe太大而且运行太慢--简单的解决办法
pyinstaller 打包的exe总是太大而且打包好的exe运行起来速度超级慢。 那是因为，你的默认环境里装了很多你不需要的包。 在你当前的环境下，pyinstaller会把你安装的所有库都统一打包进去，造成打包好的exe很大，运行...
Pycharm运行太慢或启动太慢的解决方法
Pycharm运行太慢或启动太慢的解决方法 前言 很多同学在使用Pycharm的时候，都会感觉到刚启动时非常的卡顿，或者运行代码非常的迟钝。相比于VScode可能完全不在一个层级，但是实际上造成这个问题的原因是，Pycharm中...
linux 系统速度慢,Linux运维人员你知道Linux系统运行速度太慢的原因吗?
今天小编要跟大家分享的文章是关于Linux系统运行速度太慢的原因。相信正在从事Linux运维工作的小伙伴都会遇到过Linux系统运行速度过慢的问题，那遇到这种情况时，应该怎么解决呢?我们在搞清楚如何加速Linux计算机...
VB基础类

7,763

社区成员

197,609

社区内容

发帖
与我相关
我的任务
社区描述
VB 基础类
社区管理员
  • VB基础类社区
加入社区
  • 近7日
  • 近30日
  • 至今

加载中

查看更多榜单
社区公告
暂无公告

试试用AI创作助手写篇文章吧

+ 用AI写文章