Extract Icons From Files
Extract Icons From Files Using this simple sub, you can get icons easily out of files, including DLLs, EXEs and ICOs. It uses the ExtractIconEX API to extract the icon from the file, and create a handle to the icon. It then uses the DrawIcon API to paint the icon on to the destination, and then destroys the handles to the icons to free up resources. Declarations Copy the following code into the declarations section of a module. Private Type PicBmp Size As Long tType As Long hBmp As Long hPal As Long Reserved As Long End Type Private Type GUID Data1 As Long Data2 As Integer Data3 As Integer Data4(7) As Byte End Type Private Declare Function OleCreatePictureIndirect _ Lib "olepro32.dll" (PicDesc As PicBmp, RefIID As GUID, _ ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long Private 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 Private Declare Function DestroyIcon Lib "user32" (ByVal _ hicon As Long) As Long Function Public Function GetIconFromFile(FileName As String, _ IconIndex As Long, UseLargeIcon As Boolean) As Picture 'Parameters: 'FileName - File (EXE or DLL) containing icons 'IconIndex - Index of icon to extract, starting with 0 'UseLargeIcon-True for a large icon, False for a small icon 'Returns: Picture object, containing icon Dim hlargeicon As Long Dim hsmallicon As Long Dim selhandle As Long 'IPicture requires a reference to "Standard OLE Types." Dim pic As PicBmp Dim IPic As IPicture Dim IID_IDispatch As GUID If ExtractIconEx(FileName, IconIndex, hlargeicon, _ hsmallicon, 1) > 0 Then If UseLargeIcon Then selhandle = hlargeicon Else selhandle = hsmallicon End If 'Fill in with IDispatch Interface ID. With IID_IDispatch .Data1 = &H20400 .Data4(0) = &HC0 .Data4(7) = &H46 End With 'Fill Pic with necessary parts. With pic .Size = Len(pic) 'Length of structure. .tType = vbPicTypeIcon 'Type of Picture (bitmap). .hBmp = selhandle 'Handle to bitmap. End With 'Create Picture object. Call OleCreatePictureIndirect(pic, IID_IDispatch, 1, IPic) 'Return the new Picture object. Set GetIconFromFile = IPic DestroyIcon hsmallicon DestroyIcon hlargeicon End If End Function Example Set Picture1.Picture = GetIconFromFile("c:windowsmoricons.dll", _ 0, True) This will paint the MS-DOS icon onto Picture1 in the normal sized icon(ie. 32x32). You can then use the PaintPicture function to rearrange and resize it. Note: You must select Standard OLE Types in the Project|References box