Private Declare Function GetObjectAPI 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
Public Sub psize()
Dim bm As BITMAP
Dim picPicture As IPictureDisp
Set picPicture = stdole.LoadPicture("e:\gta.bmp")
Call GetObjectAPI(picPicture, Len(bm), bm)
MsgBox "大小 : " & bm.bmWidth & "×" & bm.bmHeight
End Sub
'*********************************************************************************
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, _
ByVal hdc As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, _
ByVal nIndex As Long) As Long
Sub getpicsize(ByVal picpath As String)
Dim Image1 As OLEObject, d As Long
Application.ScreenUpdating = False
d = GetDC(0)
Set Image1 = ActiveSheet.OLEObjects.Add(ClassType:="Forms.Image.1")
Image1.Object.AutoSize = True
Image1.Object.BorderStyle = 0
Image1.Object.Picture = LoadPicture(picpath)
MsgBox Image1.Width * GetDeviceCaps(d, 88) / 72 & "*" & Image1.Height * GetDeviceCaps(d, 90) / 72
ReleaseDC 0, d
Image1.Delete
Application.ScreenUpdating = True
End Sub
Sub Macro1()
getpicsize "e:\001.gif"
End Sub
