怎么样快速获得图片的大小

[ningweidong]

我想用image显示图片的缩略图。
如果我把strech属性设为true。可以显示缩略图，但是完全是拉伸的。
我想先获得图片的大小，再动态修改image的大小。
Dim objpic, iWidth, iHeight
Set objpic = LoadPicture("F:\photo\S1055561.JPG")
iWidth = Round(objpic.Width / 26.4583)
iHeight = Round(objpic.Height / 26.4583)

Picture1.Picture = LoadPicture("F:\photo\S1055561.JPG")
MsgBox "高" & Picture1.Picture.Height & "宽" & Picture1.Picture.Width
这两种方法可以获得图片的大小，但是很慢啊。有没有快一点的方法？

[threenewbee]

参考：http://download.csdn.net/source/2317047

[hfCoder]

不懂，up

[东方之珠]

[Quote=引用 14 楼 laviewpbt 的回复:]
这些你只要找一下这些格式的文件头的说明文件，不都是很容易的一件事情吗

EMF的

'typedef struct tagENHMETAHEADER
'{
' DWORD iType; // Record type EMR_HEADER.
' DWORD Size; // Record size in bytes. This may be greater
' // than the……
[/Quote]
真祥细啊，非常感谢！
我上午在这个地方（http://topic.csdn.net/t/20031229/19/2615541.html）找了一个WMF的资料，感觉还是有点复杂。

[赵4老师]

[Quote=引用 8 楼 zhao4zhong1 的回复:]
Shell("alchemy.exe -x F:\photo\S1055561.JPG >c:\imginfo.txt",vbHide)
'然后读文件c:\imginfo.txt的内容
Image Alchemy (v1.11) - Copyright (c) 1990-98, Handmade Software, Inc.
Reading JPEG file F:\photo\S10555……
[/Quote]
试问谁能写得比我这个方法支持的格式多？

[东方之珠]

直接用API读取。比如：位图文件的高和宽在文件开头，定义一个结构可以读取。

[hfCoder]

不懂，up

[laviewpbt]

每一个中图像文件都有一个地方保存了图像的大小的，你需要找到这个位置并读取相关参数就OK了
至于先用LoadPicture读取在来得到高度那是自杀。

Public Type ImageSize
Width As Long
Height As Long
End Type

Public Function GetImageSize(sFileName As String) As ImageSize
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)
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)
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)

End If
Close iFN

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

[嗷嗷叫的老马]

我也支持读文件头

不过文件格式太多啦.........

[赵4老师]

Shell("alchemy.exe -x F:\photo\S1055561.JPG >c:\imginfo.txt",vbHide)
'然后读文件c:\imginfo.txt的内容
Image Alchemy (v1.11) - Copyright (c) 1990-98, Handmade Software, Inc.
Reading JPEG file F:\photo\S1055561.JPG
File Name: F:\photo\S1055561.JPG
Width x Height: 2008 x 1280
Number of Colours: True Colour (24 bits)
Dots per inch: 600 x 600
Image size (inches): 3.35 x 2.13
Raw size: 7710720 Actual size: 159466 (Compression ratio: 48.4:1)

[东方之珠]

Option Explicit

Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long

'定义位图结构
Private Type BITMAP
    bmType As Long
    bmWidth As Long
    bmHeight As Long
    bmWidthBytes As Long
    bmPlanes As Integer
    bmBitsPixel As Integer
    bmBits As Long
End Type

'定义位图大小
Private Type PicInfo
    PicWidth As Long
    picHeight As Long
End Type

Private Function GetPictureInfo(lsPicName As String) As PicInfo
    Dim hBitmap As Long
    Dim res As Long
    Dim bmp As BITMAP
    res = GetObject(LoadPicture(lsPicName).Handle, Len(bmp), bmp) '取得BITMAP的结构
    GetPictureInfo.PicWidth = bmp.bmWidth
    GetPictureInfo.picHeight = bmp.bmHeight
End Function

Private Sub Command1_Click()
    Debug.Print "图片宽度：" & GetPictureInfo("c:\player2.JPG").PicWidth, "图片高度：" & GetPictureInfo("c:\player2.JPG").picHeight
End Sub
 

[打死不掉牙]

在网上搜的，好像挺快的，直接读信息的

Option Explicit
Private Type ImageSize
    Width As Long
    Height As Long
End Type


Private Function GetImageSize(sFileName As String) As ImageSize
    On Error Resume Next
    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 文件
        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)
        End If
        'GIF 文件
        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)
        End If
        'JPEG 文件
        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)
        End If
        'BMP 文件
        If bTemp(0) = &H42 And bTemp(1) = &H4D Then
            Get #iFN, 19, bWlsb
            Get #iFN, 20, bWmsb
            Get #iFN, 23, bHlsb
            Get #iFN, 24, bHmsb
            GetImageSize.Width = CombineBytes(bWlsb, bWmsb)
            GetImageSize.Height = CombineBytes(bHlsb, bHmsb)
        End If
    Close iFN
End Function

Private Function CombineBytes(lsb As Byte, msb As Byte) As Long
    CombineBytes = CLng(lsb + (msb * 256)) '把十六进制数换成十进制
End Function

Private Sub Command1_Click()
    Dim size As ImageSize
    size = GetImageSize("F:\photo\S1055561.JPG")
    MsgBox "width=" & size.Width & " height=" & size.Height
End Sub

[laviewpbt]

chenjl1031 的代码说的不好听点就是脱了裤子放屁。


还有那个代码可能存在资源泄漏，LoadPicture(lsPicName)所加载的对象没有被释放，
在一个问题时GetObject 在有些情况下得不到正确的值。

[东方之珠]

[Quote=引用 11 楼 laviewpbt 的回复:]
chenjl1031 的代码说的不好听点就是脱了裤子放屁。


还有那个代码可能存在资源泄漏，LoadPicture(lsPicName)所加载的对象没有被释放，
在一个问题时GetObject 在有些情况下得不到正确的值。
[/Quote]
我试过了,LoadPicture这样用也慢了.还是直接读取二进制文件快。如果你那个代码能多支持几种格式就好了，比如：WMF，TIFF等。

[ningweidong]

[Quote=引用 6 楼 laviewpbt 的回复:]
每一个中图像文件都有一个地方保存了图像的大小的，你需要找到这个位置并读取相关参数就OK了
至于先用LoadPicture读取在来得到高度那是自杀。

Public Type ImageSize
Width As Long
Height As Long
End Type

Public Function GetImageSize(sFileName As String) As……
[/Quote]
你的函数有时候会读失败

[laviewpbt]

这些你只要找一下这些格式的文件头的说明文件，不都是很容易的一件事情吗

EMF的

'typedef struct tagENHMETAHEADER
'{
' DWORD iType; // Record type EMR_HEADER.
' DWORD Size; // Record size in bytes. This may be greater
' // than the sizeof(ENHMETAHEADER).
' RECTL rclBounds; // Inclusive-inclusive bounds in device units.
' RECTL rclFrame; // Inclusive-inclusive Picture Frame of
' // metafile in .01 mm units.
' DWORD dSignature; // Signature. Must be ENHMETA_SIGNATURE.
'
' DWORD nVersion; // Version number.
' DWORD nBytes; // Size of the metafile in bytes.
' DWORD nRecords; // Number of records in the metafile.
' WORD nHandles; // Number of handles in the handle table.
' // Handle index zero is reserved.
' WORD sReserved; // Reserved. Must be zero.
' DWORD nDescription; // Number of chars in the unicode description string.
' // This is 0 if there is no description string.
'
' DWORD offDescription; // Offset to the metafile description record.
' // This is 0 if there is no description string.
' DWORD nPalEntries; // Number of entries in the metafile palette.
' SIZEL szlDevice; // Size of the reference device in pixels.
' SIZEL szlMillimeters; // Size of the reference device in millimeters.
'} ENHMETAHEADER;



ICO的
Private Type ICONDIRENTRY
bWidth As Byte ' 图标图片的显示宽度，以像素为单位，最大值为255
bHeight As Byte ' 图标图片的显示高度， 以像素为单位，最大值为255 (times 2)
bColorCount As Byte ' 图标图片的颜色数 (0 if >=8bpp)
bReserved As Byte ' 保留域总是 0
wPlanes As Integer ' 图标图片的位面数,1
wBitCount As Integer ' 标图片的颜色深度
dwBytesInRes As Long ' 图标图片占用的数据量(字节为单位）
dwImageOffset As Long ' 图标图片的开始位置
End Type

Private Type ICONDIR
idReserved As Integer ' 保留域，目前始终为0
idType As Integer ' 定义为资源类型，图标值为 1、光标是2
idCount As Integer ' 表示的是这个文件里包含了几个图标
End Type



PCX的
Private Type PcxPalette
Red As Byte
Green As Byte
Blue As Byte
End Type

Private Type PCXHeader
Manufacturer As Byte '固定为10=ZSoft
version As Byte
'0 = 2.5
'2 = 2.8 with palette
'3 = 2.8 without palette
'4 = Pc paintbrush for windows
'5 = Pc Paintbrush ver 3.0+24位固定为5

Encoding As Byte '1 = .PCX RLE,固定为1
bPP As Byte '1, 2, 4, 8，每像素所需位数
Left As Integer '图像相对于屏幕左上角X坐标（像素为单位）
Top As Integer '图像相对于屏幕左上角Y坐标（像素为单位）
Right As Integer '图像相对于屏幕右下角X坐标（像素为单位）
Bottom As Integer '图像相对于屏幕右下角Y坐标（像素为单位）
HoriResolution As Integer '图像水平分辨率（像素/英寸）
VertResolution As Integer '图像垂直分辨率（像素/英寸）
Palette(0 To 15) As PcxPalette '指明调色板数据，只对16色以下有用
Reserved As Byte '保留，固定为0
Planes As Byte '指定图像色彩平面数，24位真彩色为3个平面
BytesPerLine As Integer '图像宽度（字节），且必须为偶数
PaletteType As Integer '调色板类型，彩色或单色图像为1，灰度图像为2
HScreenSize As Integer '图像的屏幕宽度（像素为单位），0为基准
VScreenSize As Integer '图像的屏幕高度（像素为单位），0为基准
Filter(0 To 53) As Byte '保留域，固定为0
End Type


PSD的

Private Type ResolutionInfo
HoriResolution As Integer 'Horizontal resolution in pixels per inch.
HoriResolutionUnit As Long '1=display horizontal resolution in pixels per inch;2=display horizontal resolution in pixels per cm.
WidthUnit As Integer 'Display width as 1=inches; 2=cm; 3=points; 4=picas; 5=columns.
VertResolution As Integer
VertResolutionUnit As Long
HeightUnit As Integer
End Type

Private Type ThumbNailInfo
Foramt As Long '= 1 (kJpegRGB). Also supports kRawRGB (0).
Width As Long 'Width of thumbnail in pixels.
Height As Long 'Height of thumbnail in pixels.
WidthBytes As Long 'Padded row bytes as (width * bitspixel + 31) / 32 * 4.
Size As Long 'Total size as widthbytes * height * planes
CompressdSize As Long 'compressedsize Size after compression. Used for consistentcy check.
BitPerPixel As Integer '= 24. Bits per pixel.
Planes As Integer '= 1. Number of planes.
Data() As Byte 'JFIF data in RGB format.
End Type

Private Type PsdHeaderInfo '定义Psd的文件头结构
Signature(0 To 3) As Byte '签名
version As Integer '总是等于1
Reserved(0 To 5) As Byte '保留，必须位0
Channels As Integer '图像中的通道数，可以包含ALPHA通道，有效范围1-24
Height As Long '图像的高度,有效范围1-30000
Width As Long '图像的宽度,有效范围1-30000
Depth As Integer '每个通道所用的位数（1.8.16）
ColorType As Integer '颜色模式，Bitmap=0; Grayscale=1; Indexed=2; RGB=3; CMYK=4; Multichannel=7; Duotone=8; Lab=9
End Type


Private Type PsdColorModeInfo
Length As Long
Palette(767) As Byte
End Type

Private Type PsdImageResourceInfo
Length As Long
OSType(3) As Byte
ID As Integer
SizeOfName As Byte
PascalName() As Byte
Size As Long
Resolution As ResolutionInfo
ThumbNail As ThumbNailInfo
End Type

Private Enum PsdColorModeEnum
PSD_BITMAP = 0 ' Bitmap image
PSD_GRAYSCALE = 1 ' Greyscale image
PSD_INDEXED = 2 ' Indexed image
PSD_RGB = 3 ' RGB image
PSD_CMYK = 4 ' CMYK
PSD_MULTICHANNEL = 7 ' Multichannel image
PSD_DUOTONE = 8 ' Duotone image
PSD_LAB = 9 ' Lab image
End Enum


TGA的



' TGA header follows (18 byte structure)
' Offset + 0 : 1 byte ID Length (max of 255 characters that follow the header; can contain anything)
' Offset + 1 : 1 byte Color Map Type (1=palette included, 0=no palette, other values are reserved)
' Offset + 2 : 1 byte m_Image Type (0,1,2,3,9,10,11,32,33). 0=no img, 1&9=paletted, 2&10=true color, 3&11=Grayscale, 32&33 huffman compressed, 9&10&11 are compressed)
' Offset + 3 : 2 bytes Color Map Index (offset into the palette where 1st palette entry is found)
' Offset + 5 : 2 bytes Number of Map Entries (number of palette entries)
' Offset + 7 : 1 byte Entry bit depth (bit depth of each palette entry: 8,15,16,24,32)
' Offset + 8 : 2 bytes X origin where m_Image should be displayed on screen (rarely used)
' Offset + 10: 2 bytes Y origin where m_Image should be displayed on screen (rarely used)
' Offset + 12: 2 bytes m_Image Width (unsigned)
' Offset + 14: 2 bytes m_Image Height (unsigned)
' Offset + 16: 1 byte Pixel bit depth (any value is valid except zero; this class does 8,15,16,24,32)
' Offset + 17: 1 byte m_Image Descriptor (m_Image orientation & alpha usage)
' Total 18 bytes


WMF相关的信息

Open FileName For Binary As #FileNumber
Put #FileNumber, 1, .Key
Put #FileNumber, 5, .hMF
Put #FileNumber, 7, .Bbox.Left
Put #FileNumber, 9, .Bbox.Top
Put #FileNumber, 11, Host.Width
Put #FileNumber, 13, Host.Height
Put #FileNumber, 15, .Inch
Put #FileNumber, 17, .Reserved
Put #FileNumber, 21, .Checksum
Put #FileNumber, , Data()
Close #FileNumber

[rkdrc]

picture.scalex什么的忘记了，前段时间用过

[lcw0622]

[Quote=引用 16 楼 zhao4zhong1 的回复:]

引用 8 楼 zhao4zhong1 的回复:
Shell("alchemy.exe -x F:\photo\S1055561.JPG >c:\imginfo.txt",vbHide)
'然后读文件c:\imginfo.txt的内容
Image Alchemy (v1.11) - Copyright (c) 1990-98, Handmade Software, Inc.
Reading……
[/Quote]
试问谁能写得比你这个方法运行速度慢？