GetImageSize获取图像尺寸（宽*高）

yangyangzhifeng

前几天见论坛上有人需要，批量获取硬盘内图像文件的尺寸（宽*高），
闲得无聊，写了一个获取图像尺寸的函数，在网络上的vb版，算是支持
格式比较全的了，目前支持以下文件格式png,jpg,bmp,gif,psd,tif(tiff),jp2,
其中bmp支持windows版本和IBM版本，tif支持PC版本和Mac版本
支持的文件即使扩展名错误也可正确识别，可输出正确的扩展名。

1. Type ImageSize
   
2.     P_Type As String
   
3.     Width As Long
   
4.     Height As Long
   
5. End Type
   
6. Function BinVal(bin)    '低位在前Intel
   
7.     Dim i
   
8.     Dim ret: ret = 0
   
9.     For i = LenB(bin) To 1 Step -1
   
10.         ret = ret * 256 + AscB(MidB(bin, i, 1))
    
11.     Next
    
12.     BinVal = ret
    
13. End Function
    
14. 
    
15. Function BinVal2(bin)    '高位在前Motorola
    
16.     Dim i
    
17.     Dim ret: ret = 0
    
18.     For i = 1 To LenB(bin)
    
19.         ret = ret * 256 + AscB(MidB(bin, i, 1))
    
20.     Next
    
21.     BinVal2 = ret
    
22. End Function
    
23. 
    
24. Function GetImageSize(fdata) As ImageSize
    
25.     Dim bFlag, fsize, ADOS, n&
    
26.     fsize = CLng(LenB(fdata))    '取得数据尺寸
    
27.     If fsize = 0 Then Exit Function
    
28.     Set ADOS = CreateObject("ADODB.Stream")
    
29.     With ADOS
    
30.         .Type = 1
    
31.         '    .Mode = 3
    
32.         .Open
    
33.         .LoadFromFile fdata
    
34.         .Position = 0
    
35.         '写文本对象读取图像长宽和类型
    
36.         .Position = 0    '重置数据开始位置
    
37.         bFlag = .Read(3)
    
38.         If IsNull(bFlag) Then
    
39.             GetImageSize.P_Type = "unknow"
    
40.             GetImageSize.Width = 0
    
41.             GetImageSize.Height = 0
    
42.             Exit Function
    
43.         End If
    
44.         '取文件类型和长宽
    
45.         Select Case Hex(BinVal(bFlag))
    
46.         Case "4E5089"    'png********************
    
47.             .Read (13)
    
48.             GetImageSize.P_Type = "png"
    
49.             GetImageSize.Width = BinVal2(.Read(4))
    
50.             GetImageSize.Height = BinVal2(.Read(4))
    
51.         Case "464947"    'gif*******************
    
52.             .Read (3)
    
53.             GetImageSize.P_Type = "gif"
    
54.             GetImageSize.Width = BinVal(.Read(2))
    
55.             GetImageSize.Height = BinVal(.Read(2))
    
56.         Case "504238"    'psd*********************
    
57.             .Read (13)
    
58.             GetImageSize.P_Type = "psd"
    
59.             GetImageSize.Height = BinVal2(.Read(2))
    
60.             .Read (2)
    
61.             GetImageSize.Width = BinVal2(.Read(2))
    
62.         Case "FFD8FF"    'jpg**********************
    
63.             Dim p1
    
64.             Do
    
65.                 Do: p1 = BinVal(.Read(1)): Loop While p1 = 255 And Not .EOS
    
66.                 If p1 > 191 And p1 < 196 Then Exit Do Else .Read (BinVal2(.Read(2)) - 2)
    
67.                 Do: p1 = BinVal(.Read(1)): Loop While p1 < 255 And Not .EOS
    
68.             Loop While True
    
69.             .Read (3)
    
70.             GetImageSize.P_Type = "jpg"
    
71.             GetImageSize.Height = BinVal2(.Read(2))
    
72.             GetImageSize.Width = BinVal2(.Read(2))
    
73.         Case "4D4D", "2A4949"  'tif***************
    
74.             If Hex(BinVal(bFlag)) = "2A4949" Then
    
75.                 .Position = 4
    
76.                 .Position = BinVal(.Read(4)) + 2
    
77.                 Do
    
78.                     If BinVal(.Read(2)) = 256 Then Exit Do
    
79.                     .Read (10)
    
80.                 Loop
    
81.                 n = (BinVal(.Read(2)) \ 2) * 2
    
82.                 .Read (4)
    
83.                 GetImageSize.P_Type = "tif"
    
84.                 GetImageSize.Width = BinVal(.Read(n))
    
85.                 .Read (12 - n)
    
86.                 GetImageSize.Height = BinVal(.Read(n))
    
87.             Else
    
88.                 .Position = 4
    
89.                 .Position = BinVal2(.Read(4)) + 2
    
90.                 Do
    
91.                     If BinVal2(.Read(2)) = 256 Then Exit Do
    
92.                     .Read (10)
    
93.                 Loop
    
94.                 n = (BinVal2(.Read(2)) \ 2) * 2
    
95.                 .Read (4)
    
96.                 GetImageSize.P_Type = "tif"
    
97.                 GetImageSize.Width = BinVal2(.Read(n))
    
98.                 .Read (12 - n)
    
99.                 GetImageSize.Height = BinVal2(.Read(n))
    
100.             End If
     
101.         Case "0" '************jp2********************
     
102.             .Read (1)
     
103.             If Hex(BinVal(.Read(4))) = "2020506A" Then
     
104.                 .Read (4)
     
105.                 Do    '定位图像框
     
106.                     n = BinVal2(.Read(4))
     
107.                     If Hex(BinVal(ADOS.Read(4))) = "6832706A" Then Exit Do
     
108.                     If n = 1 Then
     
109.                         n = BinVal2(.Read(8))
     
110.                         .Read (n - 16)
     
111.                     Else
     
112.                         .Read (n - 8)
     
113.                     End If
     
114.                 Loop
     
115.                 If n = 1 Then .Read (8)
     
116.                 Do    '定位图像头框
     
117.                     n = BinVal2(.Read(4))
     
118.                     If Hex(BinVal(ADOS.Read(4))) = "72646869" Then Exit Do
     
119.                     If n = 1 Then
     
120.                         n = BinVal2(.Read(8))
     
121.                         .Read (n - 16)
     
122.                     Else
     
123.                         .Read (n - 8)
     
124.                     End If
     
125.                 Loop
     
126.                 GetImageSize.P_Type = "jp2"
     
127.                 GetImageSize.Height = BinVal2(.Read(4))
     
128.                 GetImageSize.Width = BinVal2(.Read(4))
     
129.             End If
     
130.         Case Else    'bmp****************************
     
131.             If bFlag(0) = 66 And bFlag(1) = 77 Then
     
132.                 .Read (11)
     
133.                 If BinVal(.Read(4)) = 12 Then n = 2 Else n = 4    '区分Windows和O/S2
     
134.                 GetImageSize.P_Type = "bmp"
     
135.                 GetImageSize.Width = BinVal(.Read(n))
     
136.                 GetImageSize.Height = BinVal(.Read(n))
     
137.             Else
     
138.                 GetImageSize.P_Type = ""
     
139.             End If
     
140.         End Select
     
141.         .Close
     
142.     End With
     
143.     Set ADOS = Nothing
     
144.     Select Case GetImageSize.P_Type
     
145.     Case "png", "jpg", "bmp", "gif", "psd", "tif", "jp2"
     
146.     Case Else
     
147.         GetImageSize.Width = 0
     
148.         GetImageSize.Height = 0
     
149.         GetImageSize.P_Type = "unknow"
     
150.     End Select
     
151. End Function

复制代码

以下是测试代码

1. Sub ttt()
   
2.     Dim st, im As ImageSize
   
3.     st = Application.GetOpenFilename("图片文件 (*.jp*;*.psd;*.tif*;*.png;*.gif;*.bmp), *.jp*;*.psd;*.tif*;*.png;*.gif;*.bmp")
   
4.     im = GetImageSize(st)
   
5.     MsgBox im.P_Type & "文件" & vbCrLf & "宽度：" & im.Width & vbCrLf & "高度：" & im.Height
   
6. End Sub

复制代码

dyzx

希望有个附件参考一下

yangyangzhifeng

dyzx 发表于 2013-11-11 14:26
希望有个附件参考一下

给一个获取指定文件夹及其子文件夹中所有图片 路径*类型*宽*高 的例子
因为用Dos命令搜索文件，所以请不要关闭cmd窗口，完成后会自动关闭
时间都花在搜索文件上了，实际上GetImageSize函数用时很少！
宽高.7z (13.17 KB, 下载次数: 137)

2013-11-11 17:47 上传

点击文件名下载附件

mamama007

高手高手高手高手高手高手高手高手高手高手

zijianleo

太棒了！！非常感谢！！！

煎饼09

Thanks a million!谢楼主分享

loquat

1. Function GetImageSize(ByVal FileName As String, _
   
2.                    ImageSize As ImgDimType, _
   
3.                    Ext As String) As Boolean
   
4.     '参数1：FileName, 输入待检查的图片文件名，支持png/jpg/gif/bmp
   
5.     '参数2：ImageSize, 返回图片的尺寸信息
   
6.     '参数3：Ext，返回图片文件的真实扩展名
   
7.     Dim handle As Integer, isValidImage As Boolean
   
8.     Dim byteArr(255) As Byte, i As Integer
   
9.     isValidImage = False
   
10.     ImageSize.Height = 0
    
11.     ImageSize.Width = 0
    
12.     handle = FreeFile
    
13.     On Error GoTo endFunction
    
14.     Open FileName For Binary Access Read As #handle
    
15.         Get handle, , byteArr     'open file and get 256 byte chunk
    
16.     Close #handle
    
17.     If byteArr(0) = &HFF And byteArr(1) = &HD8 Then   'check for jpg header (SOI): &HFF and &HD8, contained in first 2 bytes
    
18.         isValidImage = True
    
19.     Else
    
20.         GoTo checkGIF
    
21.     End If
    
22.     For i = 0 To 255    'check for SOF marker: &HFF and &HC0 TO &HCF
    
23.         If byteArr(i) = &HFF And byteArr(i + 1) >= &HC0 _
    
24.             And byteArr(i + 1) <= &HCF Then
    
25.             ImageSize.Height = byteArr(i + 5) * 256 + byteArr(i + 6)
    
26.             ImageSize.Width = byteArr(i + 7) * 256 + byteArr(i + 8)
    
27.             Exit For
    
28.         End If
    
29.     Next i
    
30.     Ext = "jpg"
    
31.     GoTo endFunction
    
32. checkGIF:
    
33.     If byteArr(0) = &H47 And byteArr(1) = &H49 And byteArr(2) = &H46 _
    
34.         And byteArr(3) = &H38 Then 'check for GIF header
    
35.         ImageSize.Width = byteArr(7) * 256 + byteArr(6)
    
36.         ImageSize.Height = byteArr(9) * 256 + byteArr(8)
    
37.         isValidImage = True
    
38.     Else
    
39.         GoTo checkBMP
    
40.     End If
    
41.     Ext = "gif"
    
42.     GoTo endFunction
    
43. checkBMP:
    
44.     'check for BMP header
    
45.     If byteArr(0) = 66 And byteArr(1) = 77 Then
    
46.         isValidImage = True
    
47.     Else
    
48.         GoTo checkPNG
    
49.     End If
    
50.     'get record type info
    
51.     If byteArr(14) = 40 Then
    
52.         'get width and height of BMP
    
53.         ImageSize.Width = byteArr(21) * 256 ^ 3 + byteArr(20) * 256 ^ 2 _
    
54.             + byteArr(19) * 256 + byteArr(18)
    
55.         ImageSize.Height = byteArr(25) * 256 ^ 3 + byteArr(24) * 256 ^ 2 _
    
56.             + byteArr(23) * 256 + byteArr(22)
    
57.         'another kind of BMP
    
58.     ElseIf byteArr(17) = 12 Then
    
59.         'get width and height of BMP
    
60.         ImageSize.Width = byteArr(19) * 256 + byteArr(18)
    
61.         ImageSize.Height = byteArr(21) * 256 + byteArr(20)
    
62.     End If
    
63.     'get image type and exit
    
64.     Ext = "bmp"
    
65.     GoTo endFunction
    
66. checkPNG:
    
67.     If byteArr(0) = &H89 And byteArr(1) = &H50 And byteArr(2) = &H4E _
    
68.         And byteArr(3) = &H47 Then 'check for PNG header
    
69.         ImageSize.Width = byteArr(18) * 256 + byteArr(19)
    
70.         ImageSize.Height = byteArr(22) * 256 + byteArr(23)
    
71.         isValidImage = True
    
72.     Else
    
73.         GoTo endFunction
    
74.     End If
    
75.     Ext = "png"
    
76. endFunction:
    
77.     GetImageSize = isValidImage
    
78. End Function

复制代码

sunxh

太棒了！！非常感谢！！！

excel_hero

刚测试了下, 可以获取到子文件夹, 蛮好的, 不过, 可否增加显示这些图片的文件大小呢, 楼主?

yangyangzhifeng

excel_hero 发表于 2019-5-24 10:50
刚测试了下, 可以获取到子文件夹, 蛮好的, 不过, 可否增加显示这些图片的文件大小呢, 楼主?

自己用FileLen函数获取一下就可以了啊