Изображения - Размеры в пикселах

По материалам: http://www.sql.ru/forum/586161/pikselnyy-razmer-picture#6072686
"Бенедикт" - E -Mail: sgorbunkov@yandex.ru

Проверил на JPG = Работает!

'modPictureSizeInPixels

'Размеры изобржения в ПИКСЕЛАХ

'--------------------------------------------------------------------

'http://www.sql.ru/forum/actualthread.aspx?tid=586161#6072686

'"Бенедикт" - E -Mail: sgorbunkov@yandex.ru

'--------------------------------------------------------------------

Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hDC As Long, ByVal nIndex As Long) As Long

Private Const LOGPIXELSX = 88 ' Logical pixels/inch in X

Private Const LOGPIXELSY = 90 ' Logical pixels/inch in Y

Private Declare Function CreateIC Lib "gdi32" Alias "CreateICA" ( _

ByVal lpDriverName As String, ByVal lpDeviceName As String, _

ByVal lpOutput As String, lpInitData As Any) As Long

Private Declare Function DeleteDC Lib "gdi32" (ByVal hDC As Long) As Long

Private Const HimetricPerInch = 2540

Private Sub Test()

Dim hicRef As Long

Dim Pic As StdPicture

Dim W As Long, H As Long

Set Pic = LoadPicture("C:\Test.jpg")

hicRef = CreateIC("DISPLAY", vbNullString, vbNullString, ByVal 0&)

W = Pic.Width * GetDeviceCaps(hicRef, LOGPIXELSX) / HimetricPerInch

H = Pic.Height * GetDeviceCaps(hicRef, LOGPIXELSY) / HimetricPerInch

DeleteDC hicRef

Debug.Print W, H

End Sub

Public Function esPicSizeInPixelsX(ByRef Pic As StdPicture) As Long

Dim hicRef As Long

hicRef = CreateIC("DISPLAY", vbNullString, vbNullString, ByVal 0&)

esPicSizeInPixelsX = Pic.Width * GetDeviceCaps(hicRef, LOGPIXELSX) / HimetricPerInch

DeleteDC hicRef

End Function

Public Function esPicSizeInPixelsY(ByRef Pic As StdPicture) As Long

Dim hicRef As Long

hicRef = CreateIC("DISPLAY", vbNullString, vbNullString, ByVal 0&)

esPicSizeInPixelsY = Pic.Height * GetDeviceCaps(hicRef, LOGPIXELSY) / HimetricPerInch

DeleteDC hicRef

End Function

Achtung!
Требуется ссылка на библиотеку: OLE Automation