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
'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
Kostyan писал(а):Есть одно замечание. Функция ExtractAssociatedIcon возвращает манипулятор иконки ассоциированной с конкретным файлом (нужно указывать полностью имя файла).
А если напишешь что-нибудь типа ExtractAssociatedIcon(App.hInstance, ".bat", 2), то ничего хорошего не получишь.
а ты попробуй вместо ".bat" написать "*.bat"...
Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 9