主题:[原创]获取图片尺寸的代码
获取图片尺寸的代码
大家都知道,将图片框有关属性设置为自动大小,这样,打开图片后,图片框的尺寸就是图片的尺寸。如果你不想将图片框有关属性设置为自动大小,那么打开图片后可用API函数GetObject来获取图片尺寸。但是有的图片无法直接用图片框打开(例如 png),或者,我们想在不打开图片的情况下也能获取图片大小,这时,就可使用下面的代码来获取图片的尺寸了,GetImageSize过程的参数w、h就是返回的图片尺寸。注意一点:图片的宽或高均要≤65025像素。
Private Sub GetImageSize(OpenName As String, w As Long, h As Long)
On Error GoTo 100
Dim k As Long, H1 As Byte, H2 As Byte, W1 As Byte, W2 As Byte
Open OpenName For Binary As #1
Get #1, 1, H1
Get #1, , H2
Get #1, , W1
Get #1, , W2
If H1 = 0 And H2 = 0 And W1 = 1 Then 'ico
Get #1, 7, W2
Get #1, , H2
W1 = 0: H1=0
ElseIf H1 = 66 And H2 = 77 Then 'bmp
Get #1, 19, W2
Get #1, 20, W1
Get #1, 23, H2
Get #1, 24, H1
ElseIf H1 = 71 And H2 = 73 And W1 = 70 Then 'gif
Get #1, 7, W2
Get #1, , W1
Get #1, , H2
Get #1, , H1
ElseIf H1 = 255 And H2 = 216 Then 'jpg
k = 3
Do
Get #1, k, H1
Get #1, , H2
Get #1, , W1
Get #1, , W2
k = k + 2 + W2 + W1 * 256
Loop Until H1 = 255 And H2 = 192
Get #1, , H1 '每个样本位数,舍弃
Get #1, , H1
Get #1, , H2
Get #1, , W1
Get #1, , W2
ElseIf H1 = 137 And H2 = 80 And W1 = 78 And W2 = 71 Then 'png
Get #1, 19, W1
Get #1, 20, W2
Get #1, 23, H1
Get #1, 24, H2
ElseIf H1 = 215 And H2 = 205 And W1 = 198 And W2 = 154 Then 'wmf
Dim L As Integer, R As Integer, T As Integer, B As Integer
Get #1, 7, L
Get #1, , T
Get #1, , R
Get #1, , B
L = R - L: T = B - T
W2 = L Mod 256: W1 = L \ 256: H2 = T Mod 256: H1 = T \ 256
ElseIf H1 = 77 And H2 = 77 Or H1 = 73 And H2 = 73 Then 'tif
Dim de As Integer, t1 As Integer, t2 As Long
Get #1, , t2 '获取第一个IFD的偏移量
Get #1, t2 + 1, de '获取第一个IFD中DE的数量
For i = 1 To de
Get #1, , t1 '获取属性的标签编号
If t1 = 256 Then '如果是图像宽
Get #1, , t1 '废弃
Get #1, , t2 '废弃
Get #1, , W2
Get #1, , W1
Get #1, , t1 '废弃
k = k + 1
ElseIf t1 = 257 Then '如果是图像高
Get #1, , t1 '废弃
Get #1, , t2 '废弃
Get #1, , H2
Get #1, , H1
Get #1, , t1 '废弃
k = k + 1
Else '否则这些数据废弃
Get #1, , t1
Get #1, , t2
Get #1, , t2
End If
If k = 2 Then Exit For
Next i
End If
Close #1
w = W1 * 256 + W2: h = H1 * 256 + H2
Exit Sub
100
Close #1
MsgBox "无效图片"
End Sub
大家都知道,将图片框有关属性设置为自动大小,这样,打开图片后,图片框的尺寸就是图片的尺寸。如果你不想将图片框有关属性设置为自动大小,那么打开图片后可用API函数GetObject来获取图片尺寸。但是有的图片无法直接用图片框打开(例如 png),或者,我们想在不打开图片的情况下也能获取图片大小,这时,就可使用下面的代码来获取图片的尺寸了,GetImageSize过程的参数w、h就是返回的图片尺寸。注意一点:图片的宽或高均要≤65025像素。
Private Sub GetImageSize(OpenName As String, w As Long, h As Long)
On Error GoTo 100
Dim k As Long, H1 As Byte, H2 As Byte, W1 As Byte, W2 As Byte
Open OpenName For Binary As #1
Get #1, 1, H1
Get #1, , H2
Get #1, , W1
Get #1, , W2
If H1 = 0 And H2 = 0 And W1 = 1 Then 'ico
Get #1, 7, W2
Get #1, , H2
W1 = 0: H1=0
ElseIf H1 = 66 And H2 = 77 Then 'bmp
Get #1, 19, W2
Get #1, 20, W1
Get #1, 23, H2
Get #1, 24, H1
ElseIf H1 = 71 And H2 = 73 And W1 = 70 Then 'gif
Get #1, 7, W2
Get #1, , W1
Get #1, , H2
Get #1, , H1
ElseIf H1 = 255 And H2 = 216 Then 'jpg
k = 3
Do
Get #1, k, H1
Get #1, , H2
Get #1, , W1
Get #1, , W2
k = k + 2 + W2 + W1 * 256
Loop Until H1 = 255 And H2 = 192
Get #1, , H1 '每个样本位数,舍弃
Get #1, , H1
Get #1, , H2
Get #1, , W1
Get #1, , W2
ElseIf H1 = 137 And H2 = 80 And W1 = 78 And W2 = 71 Then 'png
Get #1, 19, W1
Get #1, 20, W2
Get #1, 23, H1
Get #1, 24, H2
ElseIf H1 = 215 And H2 = 205 And W1 = 198 And W2 = 154 Then 'wmf
Dim L As Integer, R As Integer, T As Integer, B As Integer
Get #1, 7, L
Get #1, , T
Get #1, , R
Get #1, , B
L = R - L: T = B - T
W2 = L Mod 256: W1 = L \ 256: H2 = T Mod 256: H1 = T \ 256
ElseIf H1 = 77 And H2 = 77 Or H1 = 73 And H2 = 73 Then 'tif
Dim de As Integer, t1 As Integer, t2 As Long
Get #1, , t2 '获取第一个IFD的偏移量
Get #1, t2 + 1, de '获取第一个IFD中DE的数量
For i = 1 To de
Get #1, , t1 '获取属性的标签编号
If t1 = 256 Then '如果是图像宽
Get #1, , t1 '废弃
Get #1, , t2 '废弃
Get #1, , W2
Get #1, , W1
Get #1, , t1 '废弃
k = k + 1
ElseIf t1 = 257 Then '如果是图像高
Get #1, , t1 '废弃
Get #1, , t2 '废弃
Get #1, , H2
Get #1, , H1
Get #1, , t1 '废弃
k = k + 1
Else '否则这些数据废弃
Get #1, , t1
Get #1, , t2
Get #1, , t2
End If
If k = 2 Then Exit For
Next i
End If
Close #1
w = W1 * 256 + W2: h = H1 * 256 + H2
Exit Sub
100
Close #1
MsgBox "无效图片"
End Sub