' Отобразим первый значок (значение индекса 0), хранимый в Блокноте

' C:\Windows\notepad.exe на окне Form1. Значок должен ' быть уничтожен при завершении работы программы

Dim hIcon As Long ' Дескриптор к функции, полученный от исполняемого файла

Dim retval As Long ' возвращаемое значение

' Извлекаем первый значок, хранимый в вышеупомянутом исполняемом файле

hIcon = ExtractIcon(App.hInstance, "C:\Windows\notepad.exe", 0)

' Только попытаемся отобразить значок, если мы успешно извлекли его

If hIcon = 0 Then

Debug.Print "Неудача при извлечении значка - выходим из программы"

End

Else

' Отобразим значок в координатах (100, 75) на окне Form1

retval = DrawIcon(Form1.hDC, 100, 75, hIcon)

' Хотя изображение значка все еще видимо, сам значок не используется

' Поэтому мы уничтожаем его, чтобы освободить ресурсы

retval = DestroyIcon(hIcon)

End If

Ответить

Или так:

Получение сведений о зарегистрированных типах файлов в системе

Данный пример позволяет узнать о всех зарегистрированных типов файлов в системе, а также получить рисунок иконки, присущий данному типу файлов

Расположите на форме элемент ListBox и элемент PictureBox. Для более наглядного отображения информации установите свойство .Sorted элемента ListBox как True.

Option Explicit

'Aaron Young http://www.pressenter.com/~ajyoung

Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long

Private Declare Function RegEnumKey Lib "advapi32.dll" Alias "RegEnumKeyA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, ByVal cbName As Long) As Long

Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long

Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long

Private Declare Function DrawIconEx Lib "user32" (ByVal hdc As Long, ByVal xLeft As Long, ByVal yTop As Long, ByVal hIcon As Long, ByVal cxWidth As Long, ByVal cyWidth As Long, ByVal istepIfAniCur As Long, ByVal hbrFlickerFreeDraw As Long, ByVal diFlags As Long) As Long

Private Declare Function ExtractIcon Lib "shell32.dll" Alias "ExtractIconA" (ByVal hInst As Long, ByVal lpszExeFileName As String, ByVal nIconIndex As Long) As Long

Private Const HKEY_CLASSES_ROOT = &H80000000

Private aIcons() As String

Private Sub Form_Load()

Dim sType As String

Dim sName As String

Dim sFile As String

Dim iIndex As Integer

Dim lRegKey As Long

Dim iFoundCount As Integer

iIndex = 1

iFoundCount = 1

sType = Space(255)

'Перечисление всех расширений

Do While RegEnumKey(HKEY_CLASSES_ROOT, iIndex, ByVal sType, 255) = 0

If Left(sType, 1) <> "." Then

Else

'Сохранение информации об иконке

ReDim Preserve aIcons(iIndex - 1)

sType = Left(sType, InStr(sType, Chr(0)) - 1)

'Получить имя расширения, (к примеру - .zip = WinZip)

If RegOpenKey(HKEY_CLASSES_ROOT, ByVal sType, lRegKey) = 0 Then

sName = Space(255)

Call RegQueryValueEx(lRegKey, ByVal "", 0&, 1, ByVal sName, 255)

If InStr(sName, Chr(0)) Then sName = Left(sName, InStr(sName, Chr(0)) - 1)

Call RegCloseKey(lRegKey)

If Len(Trim(sName)) Then

'Поиск иконки по умолчанию для расширения

If RegOpenKey(HKEY_CLASSES_ROOT, sName & "\DefaultIcon\", lRegKey) = 0 Then

sFile = Space(255)

Call RegQueryValueEx(lRegKey, ByVal "", 0&, 1, ByVal sFile, 255)

If InStr(sFile, Chr(0)) Then sFile = Left(sFile, InStr(sFile, Chr(0)) - 1)

Call RegCloseKey(lRegKey)

aIcons(iFoundCount - 1) = sFile

End If

End If

End If

List1.AddItem Left(sType & Space(10), 10) & " - " & sName

iFoundCount = iFoundCount + 1

End If

sType = Space(255)

iIndex = iIndex + 1

Loop

End Sub

Private Sub List1_Click()

Dim sFile As String

Dim iIndex As Integer

Dim lIcon As Long

Picture1.Cls

On Error GoTo IconErr

'Получить иконку для данного типа расширения

sFile = Left$(aIcons(List1.ListIndex), InStr(aIcons(List1.ListIndex), ",") - 1)

iIndex = Val(Mid$(aIcons(List1.ListIndex), InStr(aIcons(List1.ListIndex), ",") + 1))

lIcon = ExtractIcon(App.hInstance, sFile, iIndex)

Call DrawIconEx(Picture1.hdc, 0, 0, lIcon, 32, 32, 0, 0, 3)

IconErr:

End Sub

Ответить

Есть более шустрый способ.

http://www.vbnet.ru/article/showarticle.asp?id=21

пример http://www.vbnet.ru/article/zip/filessamples.zip

Ответить