-
Here's an Example I just put together..
Add a Listbox and Picturebox to a Form..
Code:
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 'Ext.
Dim sName As String 'Name of File Type
Dim sFile As String 'File Used For Default Icon
Dim iIndex As Integer
Dim lRegKey As Long
List1.FontName = "Courier"
iIndex = 1
sType = Space(255)
'Enumerate all Extensions in the CLASSES Hive..
Do While RegEnumKey(HKEY_CLASSES_ROOT, iIndex, ByVal sType, 255) = 0
If Left(sType, 1) <> "." Then Exit Do
'Store Icon Info in an Array Linked by ListIndex
ReDim Preserve aIcons(iIndex - 1)
sType = Left(sType, InStr(sType, Chr(0)) - 1)
'Get this Extensions Name, eg - .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
'Look for a Default Icon for this Type..
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(iIndex - 1) = sFile
End If
End If
End If
List1.AddItem Left(sType & Space(10), 10) & " - " & sName
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
'Get the Icon from the File Stored in the Array for this File Type
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
------------------
Aaron Young
Analyst Programmer
[email protected]
[email protected]
-
How can i load the know file types in the system?
like the box in the windows-explorer options-->File Types (*.txt is Text File, *.zip is WinZip like that)
if any 1 know how to load them with there icons it's be great!
-
Thank you very very much!
realy thank you! :)
