获得jpg文件的实际尺寸
日期：2011-05-14 浏览次数：21004 次
bask
把它编译成组件就可以用了，还支持png
'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 at http://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
&nb
把它编译成组件就可以用了，还支持png
'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 at http://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
&nb
免责声明： 本文仅代表作者个人观点，与爱易网无关。其原创性以及文中陈述文字和内容未经本站证实，对本文以及其中全部或者部分内容、文字的真实性、完整性、及时性本站不作任何保证或承诺，请读者仅作参考，并请自行核实相关内容。
