设为首页
加入收藏
繁體中文
首 页客家风情客家影音山歌在线客家商城聊天室留言墙测字算命下载中心IT 技术客家论坛
您当前的位置:客家网 | 天南地北客家人 -> IT 技术-> ASP -> 正文 退出登录 用户管理
栏目导航
· ASP · JSP
· 网络安全 · NET专区
· XML专区 · PHP专区
热门文章
· ASP+JavaScript的完整的..
· [图文] 防范非法用户的侵..
· ASP从数据库中获取文件..
· 网络管理中的常用命令
· [图文] 千年虫二世诞生业..
· [图文] FSO组件操作实例..
· 网络常见木马的手工清除..
· 利用ASP远程获取内容
· [图文] 简单购物车教程
· 一个ASP(VBScript)简..
· asp常用数据库连接方法..
· 网络常见木马的手工清除..
相关文章
· 一个非常精彩的日历程序..
· 一个个人网页自动化生成..
· 一个个人网页自动化生成..
· [图文] 一个个人网页自动..
· 正则表达式例子:在一个..
· 第三节 定义一个类 [3]
· 一个求最大值与最小值的..
· 创建一个ASP通用分页类(..
· 创建一个ASP通用分页类(..
· 一个拷贝整个文件夹(包括..
· 一个不太让人讨厌的自动..
· 断开的数据库连接的一个..
· 一个防止外部数据提交的..
· 一个简单的SQL语句执行器..
· 不用询问关闭一个独立的..
一个取图片尺寸的类,支持jpg,gif,png
作者:佚名  来源:动网  发布时间:2007-8-30 12:58:49  发布人:Admin

减小字体 增大字体

'I have released this source code into the public domain. You may use it
'with no strings attached.
'Just call GetImageSize with a string containing the filename, and
'it will return a user defined type 'ImageSize' (see below)
'Return values of 0 indicate an error of some sort. The error handling
'in this module is limited. There is *NO* error handling on the test
'form. This routine is limited to X or Y sizes of 32767 pixels, but that
'should not be a problem.

'Check back athttp://www.qtm.net/~davidc
'I may add support for more file types.

'supported in this version:
'JPEG
'GIF
'PNG

'This routine does not require any royalty fees for Unisys as it
'does nothing with the compressed part of GIF files. It simply reads
'4 bytes to determine image size.

Option Explicit
Public WImg As Long
Public HImg As Long
Public Type ImageSize
Width As Long
Height As Long
End Type

Public Sub GetImageSize(sFileName As String)
On Error Resume Next 'you'll want to change this
Dim iFN As Integer
Dim bTemp(3) As Byte
Dim lFlen As Long
Dim lPos As Long
Dim bHmsb As Byte
Dim bHlsb As Byte
Dim bWmsb As Byte
Dim bWlsb As Byte
Dim bBuf(7) As Byte
Dim bDone As Byte
Dim iCount As Integer

lFlen = FileLen(sFileName)
iFN = FreeFile
Open sFileName For Binary As iFN
Get #iFN, 1, bTemp()

'PNG file
If bTemp(0) = &H89 And bTemp(1) = &H50 And bTemp(2) = &H4E _
And bTemp(3) = &H47 Then
Get #iFN, 19, bWmsb
Get #iFN, 20, bWlsb
Get #iFN, 23, bHmsb
Get #iFN, 24, bHlsb
'GetImageSize.Width = CombineBytes(bWlsb, bWmsb)
'GetImageSize.Height = CombineBytes(bHlsb, bHmsb)
WImg = CombineBytes(bWlsb, bWmsb)
HImg = CombineBytes(bHlsb, bHmsb)
End If

'GIF file
If bTemp(0) = &H47 And bTemp(1) = &H49 And bTemp(2) = &H46 _
And bTemp(3) = &H38 Then
Get #iFN, 7, bWlsb
Get #iFN, 8, bWmsb
Get #iFN, 9, bHlsb
Get #iFN, 10, bHmsb
'GetImageSize.Width = CombineBytes(bWlsb, bWmsb)
'GetImageSize.Height = CombineBytes(bHlsb, bHmsb)
WImg = CombineBytes(bWlsb, bWmsb)
HImg = CombineBytes(bHlsb, bHmsb)
End If


'JPEG file
If bTemp(0) = &HFF And bTemp(1) = &HD8 And bTemp(2) = &HFF Then
Debug.Print "JPEG"
lPos = 3
Do
Do
Get #iFN, lPos, bBuf(1)
Get #iFN, lPos + 1, bBuf(2)
lPos = lPos + 1
Loop Until (bBuf(1) = &HFF And bBuf(2) <> &HFF) Or lPos > lFlen

For iCount = 0 To 7
Get #iFN, lPos + iCount, bBuf(iCount)
Next iCount
If bBuf(0) >= &HC0 And bBuf(0) <= &HC3 Then
bHmsb = bBuf(4)
bHlsb = bBuf(5)
bWmsb = bBuf(6)
bWlsb = bBuf(7)
bDone = 1
Else
lPos = lPos + (CombineBytes(bBuf(2), bBuf(1))) + 1
End If
Loop While lPos < lFlen And bDone = 0
'GetImageSize.Width = CombineBytes(bWlsb, bWmsb)
'GetImageSize.Height = CombineBytes(bHlsb, bHmsb)
WImg = CombineBytes(bWlsb, bWmsb)
HImg = CombineBytes(bHlsb, bHmsb)
End If
Close iFN

End Sub
Private Function CombineBytes(lsb As Byte, msb As Byte) As Long
CombineBytes = CLng(lsb + (msb * 256))
End Function


[] [返回上一页] [打 印] [收 藏]
上一篇文章:我在桌面上删帖子
∷相关文章评论∷    (评论内容只代表网友观点,与本站立场无关!) [更多评论…]
关于本站 - 网站合作 - 免责声明 - 友情连接 - 网站地图 - 客家论坛
本站部份内容来自网络 如无意中侵犯了您的权利 请及时与我们联系 我们会尽快处理
Copyright © 2006-2008 天南地北客家人
Email:yddlts@126.com  QQ:153161602
站长:大浪淘沙    QQ群:33754730
粤ICP备07019796号