| 编程中国 | 业界新闻 | 技术文章 | 视频教程 | 下载频道 | 程序源码 | 个人空间 | 编程论坛
全能ASP/PHP/ASP.NET主机,支持月付专业 MSSQL 数据库空间,支持月付专业 MySQL 数据库空间,支持月付学习型 ASP/PHP/ASP.NET 主机 30元/年
高端软件开发 = 年薪十万不是梦赛孚耐:软件保护加密专家身份认证令牌USB KEY 
共有 171 人关注过本帖
标题:[求助]这段代码是用rle算法压缩黑白图像的,求高手进来查看有什么问题???
收藏  订阅  推荐  打印 
wutasd
Rank: 1
等级:新手上路
帖子:1
积分:110
注册:2008-5-19
[求助]这段代码是用rle算法压缩黑白图像的,求高手进来查看有什么问题???

Private Sub Command1_Click()
Dim h, w As Integer
Dim x, y, bi, wi As Long
Dim cl, i As Long
Dim r, g, b As Integer
Dim fName, str As String
fName = App.Path & "\Compact.txt"
Open fName For Output As 1
h = Picture1.ScaleHeight
w = Picture1.ScaleWidth
For y = 0 To h - 1
For x = 0 To w - 1
cl = Picture1.Point(x, y)
If cl = 0 Then
If wi <> 0 Then
Print #1, wi; ";W"
wi = 0
bi = bi + 1
Else
bi = bi + 1
End If
Else
If bi <> 0 Then
Print #1, bi; ";B"
bi = 0
wi = wi + 1
Else
wi = wi + 1
End If
End If
Next x
Next y
If wi <> 0 Then
Print #1, wi; ";W"
w
End If
If bi <> 0 Then
Print #1, bi; ";B"
End If
Close #1
End Sub
搜索更多相关主题的帖子: rle  算法  黑白  图像  
2008-5-19 13:52
关于我们 | 广告合作 | 编程中国 | 清除Cookies | Archiver | WAP | TOP

编程中国 版权所有,并保留所有权利。鲁ICP备08000592号
Powered by Discuz, Processed in 0.045184 second(s), 9 queries.
Copyright©2004-2008, BCCN.NET, All Rights Reserved