- Код: Выделить всё
Private Declare Function ExtractAssociatedIcon Lib "shell32.dll" Alias _
"ExtractAssociatedIconA" (ByVal hInst As Long, _
ByVal lpIconPath As String, lpiIcon As Long) As Long
Private Declare Function DrawIcon Lib "user32" (ByVal hDC As Long, _
ByVal X As Long, ByVal Y As Long, ByVal hIcon As Long) As Long
Private Declare Function DestroyIcon Lib "user32" _
(ByVal hIcon As Long) As Long
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
'Разные Функции
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, _
ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, _
ByVal nHeight As Long, ByVal hSrcDC As Long, _
ByVal xSrc As Long, ByVal ySrc As Long, ByVal _
dwRop As Long) As Long
Private Const SRCCOPY = &HCC0020
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal _
hDC As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal _
hDC As Long, ByVal nWidth As Long, ByVal _
nHeight As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, _
ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As _
Long) As Long
Private Sub LoadIcon(IconPath As String, IconOrd As Long, _
PictureObject As PictureBox)
On Error Resume Next
Dim hIcon As Long
PictureObject.Cls 'очистим картинку
hIcon = ExtractAssociatedIcon( _
App.hInstance, IconPath, IconOrd)
DrawIcon PictureObject.hDC, 0&, _
0&, hIcon
DestroyIcon hIcon
End Sub
Одним из преимуществ этого метода является то, что он позволяет загружать иконки формата 32 бита (Windows XP) с тенью (там, где они поддерживаются, естественно
)
Пример по использованию лежит по адресу:
http://amelso.narod.ru/testing/iconextract.zip