Расширение и иконка

[Demonx]

Как получить иконку 16x16, зная расширение файла?

[Kostyan]

Делается это таким образом:

Код: Выделить всё

Dim hKey As Long, Ext As String, t As String, hSmallIcon As Long, hBigIcon As Long, ExeName As String, nIcon As Long
t = Space$(260)
Ext = "txt" 'Расширение
If RegOpenKeyEx(HKEY_CLASSES_ROOT, "." & Ext, 0, READ_CONTROL, hKey) = 0 Then
   Call RegQueryValueEx(hKey, vbNullString, 0, 1, ByVal t, 260)
   Call RegCloseKey(hKey)
   t = Left$(t, InStr(t, vbNullChar) - 1) & "\DefaultIcon"
   If RegOpenKeyEx(HKEY_CLASSES_ROOT, t, 0, READ_CONTROL, hKey) = 0 Then
      t = Space$(260)
      Call RegQueryValueEx(hKey, vbNullString, 0, 1, ByVal t, 260)
      Call RegCloseKey(hKey)
      t = Left$(t, InStr(t, vbNullChar) - 1)
      If InStr(t, ",") > 0 Then
         ExeName = Left$(t, InStr(t, ",") - 1)
         nIcon = Val(Right$(t, Len(t) - InStr(t, ",")))
         Call ExtractIconEx(ExeName, nIcon, hBigIcon, hSmallIcon, 1)
         Me.Cls
         Call DrawIconEx(Me.hdc, 100, 70, hSmallIcon, 0, 0, 0, 0, 3) 'Рисуем маленькую иконку на форме
         Call DrawIconEx(Me.hdc, 120, 70, hBigIcon, 0, 0, 0, 0, 3) 'Рисуем большую иконку на форме
         Me.Refresh
      End If
   End If
Else
   MsgBox "С этим расширением ничего не ассоциировано", vbCritical, "Ошибка"
End If


Это помести в модуль:

Код: Выделить всё

Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const READ_CONTROL = &H20000

Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
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
Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Declare Function ExtractIconEx Lib "shell32.dll" Alias "ExtractIconExA" (ByVal lpszFile As String, ByVal nIconIndex As Long, phiconLarge As Long, phiconSmall As Long, ByVal nIcons As Long) As Long
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


[Susanin]

А вот примерчик покороче, из API-Guide 3.7:

Код: Выделить всё

'Create a new project, and add this code to Form1
Const DI_MASK = &H1
Const DI_IMAGE = &H2
Const DI_NORMAL = DI_MASK Or DI_IMAGE
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 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 DestroyIcon Lib "user32" (ByVal hIcon As Long) As Long
Private Sub Form_Paint()
    Dim mIcon As Long
    'Extract the associated icon
    mIcon = ExtractAssociatedIcon(App.hInstance, "D:\1Работа\02Мис\База.doн", 2)
    'Draw the icon on the form
    DrawIconEx Me.hdc, 0, 0, mIcon, 0, 0, 0, 0, DI_NORMAL
    'remove the icon from the memory
    DestroyIcon mIcon
End Sub



Susanin

[Kostyan]

Есть одно замечание. Функция ExtractAssociatedIcon возвращает манипулятор иконки ассоциированной с конкретным файлом (нужно указывать полностью имя файла).
А если напишешь что-нибудь типа ExtractAssociatedIcon(App.hInstance, ".bat", 2), то ничего хорошего не получишь.

[Cyrax]

Есть одно замечание. Функция ExtractAssociatedIcon возвращает манипулятор иконки ассоциированной с конкретным файлом (нужно указывать полностью имя файла).
А если напишешь что-нибудь типа ExtractAssociatedIcon(App.hInstance, ".bat", 2), то ничего хорошего не получишь.

а ты попробуй вместо ".bat" написать "*.bat"...

[Kostyan]

а ты попробуй вместо ".bat" написать "*.bat"...

Попробовал, никакого толку (конкретно с *.bat). Так работает только для некоторых расширений, но не для всех.