Изображения - Размеры в пикселах (API)По материалам: http://www.sql.ru/forum/586161/pikselnyy-razmer-picture#6072686 Проверил на 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! |
|||
L.E. 24.08.2022 |