Наши проекты:
Журнал · Discuz!ML · Wiki · DRKB · Помощь проекту |
||
ПРАВИЛА | FAQ | Помощь | Поиск | Участники | Календарь | Избранное | RSS |
[3.139.104.214] |
|
Сообщ.
#1
,
|
|
|
Киньте на форму ListBox и Picture1. Затем добавьте этот код
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 |