Library tutorials & articles
File Extensions: Finding the default Icon
By Phil Couling, published on 26 Nov 2002
Page 7 of 7
- Introduction
- How it's all done
- Declares
- The Registry
- Drawing the Icon
- The Contingency
- The Complete Code
The Complete Code
So all together now:
Option Explicit
'For looking at registry keys
'To: Open key ready to look at
Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA"
(ByVal hKey As Long, ByVal lpSubKey As String, phkResult
As Long) As Long
'To: Look at key
Private Declare Function
RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey
As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As Any, lpcbData As Long) As Long
'To: Close the key when it's finished
with
Private Declare
Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Const HKEY_CLASSES_ROOT = &H80000000
Private Const
KEY_READ = &H20019 'To allow us to READ the registry keys
'For Drawing the icon
'To: Retrieve the icon from the .EXE, .DLL or .ICO
Private Declare
Function ExtractIcon Lib "shell32.dll" Alias "ExtractIconA" (ByVal hInst
As Long, ByVal lpszExeFileName
As String, ByVal nIconIndex
As Long) As Long
'To: Draw the icon into our picture box
Private Declare
Function DrawIcon Lib "user32.dll" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long, ByVal hIcon As Long) As Long
'To: Clean up after our selves (destroy the icon that "ExtractIcon" created)
Private Declare Function
DestroyIcon Lib "user32.dll" (ByVal hIcon As Long) As Long
'For Finding the System folder
Private Declare Function GetSystemDirectory Lib "kernel32.dll" Alias
"GetSystemDirectoryA" (ByVal lpBuffer
As String, ByVal nSize As
Long) As Long
Private Sub GetDefaultIcon(FileName
As String, Picture_hDC As Long )
Dim
TempFileName As String 'Never manipulate an input unless it doubles as an output
Dim
lngError As Long'For receiving error
numbers
Dim lngRegKeyHandle As Long'Stores the "handle" of the registry key that is currently
open
Dim strProgramName As String'Stores the contents of the first registry key
Dim
strDefaultIcon As String'Stores the
contents of the second registry key
Dim
lngStringLength As Long'Sets /
Returns the length of the output string
Dim lngIconNumber
As Long'Stores the icon number within
a file
Dim lngIcon As Long'Stores the "Icon Handle" for the default icon
Dim intN As Integer 'For any temporary numbers
TempFileName = Right(FileName, Len(FileName) - InStrRev(FileName, ".") + 1)
If LCase(TempFileName) = ".exe" Then
strDefaultIcon = Space(260)
lngStringLength = GetSystemDirectory(strDefaultIcon, 260)
strDefaultIcon = Left(strDefaultIcon, lngStringLength) & "\SHELL32.DLL"
lngIconNumber = 2
GoTo Draw_Icon
End If
lngError = RegOpenKey(HKEY_CLASSES_ROOT, TempFileName, lngRegKeyHandle)
If lngError Then GoTo No_Icon 'we do not even have a
valid extension so lets NOT try to find an icon!
lngStringLength = 260
strProgramName = Space$(260) 'Make space for the incoming string
'Get the key
value:
lngError = RegQueryValueEx(lngRegKeyHandle, vbNullString, 0, 0, strProgramName, lngStringLength)
If lngError Then'if
there's an error then BIG TROUBLE so lets use the normal "windows"
icon
lngError = RegCloseKey(lngRegKeyHandle) 'the world may be about to end
(or just an error) but we'll clean up anyway
GoTo No_Icon
End If
lngError = RegCloseKey(lngRegKeyHandle) 'if this generates an
error then we can't do anything about it anyway
strProgramName =
Left(strProgramName, lngStringLength - 1) 'Cut the name down to size
'Use the value of the last key in the name of the next one
(strProgramName)
lngError = RegOpenKey(HKEY_CLASSES_ROOT, strProgramName & "\DefaultIcon", lngRegKeyHandle)
If lngError Then GoTo No_Icon 'there is no icon for this extension so lets NOT try to load what
doesn't exist!
'The rest is just the same as before
lngStringLength = 260
strDefaultIcon = Space$(260)
lngError = RegQueryValueEx(lngRegKeyHandle, vbNullString, 0, 0, strDefaultIcon, lngStringLength)
If lngError Then
lngError =
RegCloseKey(lngRegKeyHandle)
GoTo No_Icon
End
If
lngError = RegCloseKey(lngRegKeyHandle)
strDefaultIcon = Trim$(Left(strDefaultIcon, lngStringLength - 1))
intN =
InStrRev(strDefaultIcon, ",") 'Find the commer
If intN <
1 Then GoTo No_Icon 'We MUST have an icon number and it will be after the ",": NO COMMA NO DEFAULT ICON
lngIconNumber =
Trim$(Right(strDefaultIcon, Len(strDefaultIcon) - intN)) 'What
number is after the comma
strDefaultIcon =
Trim$(Left(strDefaultIcon, intN - 1)) 'We only want what's
before the comma in the file name
Draw_Icon:
lngIcon = ExtractIcon(App.hInstance, strDefaultIcon, lngIconNumber) 'Extract the Icon
If lngIcon = 1
Or lngIcon = 0 Then GoTo No_Icon
'if 1 or 0 then after all that the Icon Could not be retrieved
lngError = DrawIcon(Picture_hDC, 0, 0, lngIcon) 'Draw the icon in the box
'If that was
unsucessful then we can't do anything about it now!
lngError = DestroyIcon(lngIcon)
'Again we can't correct
any errors now
Exit Sub
No_Icon:
'No icon could be found so we use the normal windows icon
'This icon is held in shell32.dll in the
system directory, Icon 0
strDefaultIcon = Space(260)
lngStringLength = GetSystemDirectory(strDefaultIcon, 260)
strDefaultIcon = Left(strDefaultIcon, lngStringLength) & "\SHELL32.DLL"
lngIconNumber = 0
GoTo Draw_Icon
End Sub
Just incase it’s not obvious (I hope i is), here’s how to use this subroutine (remember that picture box etc. that I said you’d need at the beginning) and make sure that “AutoRedraw” is set to True!:
Private Sub Command1_Click()
Picture1.Cls
GetDefaultIcon Text1.Text, Picture1.hDC
End Sub
Simple as that! I hope this has all been helpful.
Software developer, working in Derby, England. Currently I'm mostly developing in C++ with a combination of Borland, Visual Studio and MinGW. Much of my work at the moment is with Databases (Firebi...
Related articles
Related discussion
-
Run-time error '91'
by converter2009 (1 replies)
-
VB6 Runtime error 381 subsript out of range Error
by Uncle (2 replies)
-
passing and reading parameters from using Shell
by jigartoliya (0 replies)
-
Convert C++ code to VB6
by mawcot (4 replies)
-
listbox scrollbar
by Dennijr (10 replies)
Related podcasts
-
Christian Beauclair
14 mai 2008 (�mission #0074) ::.Christian Beauclair: Stratégies de migration VB6 vers .NET Nous discutons avec Christian Beauclair des stratégies de migration VB6 vers .NET. Entre autres, nous discutons comment utiliser le "VB 6 Code Advisor" et le "Interop Forms Toolkit" pour ajouter la puiss...
the icon may be in an exe file or dll file.
this is a veryyyyyyyy long way, and there are ready softwares available for it.
but it is discovered by me, so posting
in folder options, create a dummy file extension
click advanced,
change the icon of that file extension to desired icon; from dll or exe file.
open google talk (sounds funny naa)
now create a file with that extension
using file transfer option, send that file to someone
it is not needed that actual transfer shd take place, u only need to initiate the transfer & then u can abort the transfer.
now go to
%userprofile%\Local Settings\Temp\Google Talk\File Extensions
the icon file is seen there as a png image
open it with mspaint or similar software & save it as 256 color bitmap
change its extension to .ico from .bmp
& u r done
Thanks a lot for the help and the good job you're doing
Yves
I AM AN UNDERGRADUATE STUDYING COMPUTER PRORAMMING. i WILL NEED MORE EXPLANATION ON THIS TOPIC.
tOCHUKWU.
Absolutely brilliant! Works a treat.
THANKS VERY MUCH!!!
Looks like my reply is too large to fit in one post so I've put it here.
Hope this helps
Lovely coding couling! Its helped me alot.
I'm not too hot with API work though and have had trouble incorporating your two lots of code. I'm ultimately trying to display the associated file icons from a directory of scanned files from a database on a Listview (like Explorer), using a 16x16 picture box. 32x32 is no problem (in theoy) but I'm unable to get my head round the 16x16 bit.
Any help VERY much appreciated.
Really Very Nice
In the properties of the picturebox, set "AutoRedraw" to "True"
If you want to draw to other objects, you can either
1.
2. If your object has a “Picture” or “Image” property then you could use:
Object.Picture = Picture1.Image
Or
Object.Image = Picture1.Image
Hope this helps
Hi, this is great code! I just have one question...
When form minimize or is hidden behind another one, the drawn icon just dissapear, how can I make it persistant?? how can I convert it to a Picture Object I could manipulate to assign it to any other control???
Sorry this took a while
Ok, Small Icons:
These will be a little more complex, you will need to use two more windows APIs:
ExtractIconEx (instead of ExtractIconEx)
DrawIconEx (instead of DrawIcon)
These functions do basically the same thing, but they are capable of much more. ExtractIconEx can extract any number of Icons into two arrays (although in the example below I’ve only used two long variables “lngSmall” and “lngLarge”). DrawIconEx will allow you to draw the small icon as a 16 X 16 image instead of 32 X 32. This is just a small example of how to use the two functions, hopefully you can see how to alter the origional code. You will need:
two picture boxes (to receve the images)
an icon (in the code Ive used the path "C:\1.ico")
A command button (the subroutine is "command1_CLick()")
So for some code:
Private Declare Function DestroyIcon Lib "user32.dll" (ByVal hIcon As Long) As Long
Private Declare Function DrawIconEx Lib "user32.dll" (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 Const DINORMAL = &H3 'Draw both the image mask in image data
Private Const DIDEFAULTSIZE = &H8 'Draw the icon at 32 X 32
Private Sub Command1Click()
Dim Retval As Long, lngLarge As Long, lngSmall As Long, hbrush As Long
' \/firstIcon \/Number of icons
Retval = ExtractIconEx("C:\1.ico", 0, lngLarge, lngSmall, 1)
Retval = DrawIconEx(Picture1.hDC, 0, 0, lngLarge, 0, 0, 0, 0, DINORMAL Or DIDEFAULTSIZE)
'note: DIDEFAULTSIZE tells windows to ignore the two parameters after "lngLarge".
Retval = DrawIconEx(Picture2.hDC, 0, 0, lngSmall, 16, 16, 0, 0, DINORMAL)
'"16,16 tells windows to draw the Icon 16 X 16 pixals
' left top Icon width height for drawing animated cursors brush type Flags
'Retval = DrawIconEx(Picture2.hDC, 0, 0, lngSmall, 16, 16, 0, 0, DINORMAL)
Retval = DestroyIcon(lngLarge) 'As in the article
Retval = DestroyIcon(lngSmall)
End Sub
To get ExatractIconEx to retrieve more than one Icon, replace lngLarge and lngSmall with arrays and set the last parameter “nIcons” to the number of icons to extract.
If this isn't clear just say so.
Fantastic tutorial. Especially as I've just started a project, this evening, that'll have file lists and icons - solved quite a head scratcher for me.
But I was wandering, is it a simple matter to use the small versions of the icons, as you get in explorer? If so, could someone tell me where to look for how
Tom.
This thread is for discussions of File Extensions: Finding the default Icon.