Solved

ExtractAssociatedIcon and 48x48 Icons

Posted on 2004-10-07
9
923 Views
Last Modified: 2008-01-09
Hi all

Is there any way to extract the 48x48 icon?

I have a function like this now (pseudo code)

hIcon=ExtractAssociatedIcon (filename,blabla)
DrawIcon(Picture.Hdc,hIcon)
ListView1.Add Picture1.Picture

With kind regards


Ramses
0
Comment
Question by:x_terminat_or_3
  • 5
  • 2
  • 2
9 Comments
 
LVL 2

Author Comment

by:x_terminat_or_3
ID: 12251432
I mean 48x48
0
 
LVL 13

Expert Comment

by:imarshad
ID: 12253482
Do you want the icon to be resized to 48 x 48 or want to extract icons that are 48 x 48?

Imran
0
 
LVL 2

Author Comment

by:x_terminat_or_3
ID: 12253503
I want to extract the icons that are 48x48
0
 
LVL 13

Expert Comment

by:imarshad
ID: 12253592
Sorry I was thinking that you require something like this.....
http://www.mentalis.org/apilist/DrawIconEx.shtml

Imran
0
How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

 
LVL 2

Author Comment

by:x_terminat_or_3
ID: 12253629
This, I already tested before posting this question.  The extracted icon is 32x32 and not 48x48




Ramses (x_terminat_or_3)
0
 
LVL 17

Accepted Solution

by:
zzzzzooc earned 500 total points
ID: 12256341
Ok... this is a little lengthy (fun fun!) but I'm not sure of any other alternatives. Most of the API functions automatically decide which icon to "load" based on your display settings so I figured you'll need to load the raw icon itself. I wasn't sure how to go about finding which icon-group was for the associated module (don't have much experience with icons) so I checked a few modules and it seems the first one is the default so.. the below gets the icon of your choosing (by size) from that first group. It seems to work alright also. :) As for files that have associated icons in a different module (such as Text Files having their icon in Notepad), you'll need to find the associated application and get it's icon instead.  This isn't the greatest method but... it's something. :)



Form1:
-----------------
Option Explicit

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 Const DI_MASK = &H1
Private Const DI_IMAGE = &H2
Private Const DI_NORMAL = DI_MASK Or DI_IMAGE
Private Sub Command1_Click()
    Dim strModule As String, lngIcoHandle As Long
    strModule = "C:\Program Files\flashfxp\flashfxp.exe"
    lngIcoHandle = GetAssociatedIconBySize(strModule, 48)
    If lngIcoHandle <> 0 Then
        Picture1.AutoRedraw = True
        Call DrawIconEx(Picture1.hdc, 0, 0, lngIcoHandle, 0, 0, 0, 0, DI_NORMAL)
        Call DestroyIcon(lngIcoHandle)
        Picture1.Refresh
    End If
End Sub




Module1:
------------------
Option Explicit

Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long
Private Declare Function LoadLibraryEx Lib "kernel32" Alias "LoadLibraryExA" (ByVal lpLibFileName As String, ByVal hFile As Long, ByVal dwFlags As Long) As Long
Private Declare Function SizeofResource Lib "kernel32" (ByVal hInstance As Long, ByVal hResInfo As Long) As Long
Private Declare Function CreateIconFromResource Lib "user32" (presbits As Byte, ByVal dwResSize As Long, ByVal fIcon As Long, ByVal dwVer As Long) As Long
Private Declare Function FindResourceByID Lib "kernel32" Alias "FindResourceA" (ByVal hInstance As Long, ByVal lpName As Long, ByVal lpType As Long) As Long
Private Declare Function FindResourceByName Lib "kernel32" Alias "FindResourceA" (ByVal hInstance As Long, ByVal lpName As String, ByVal lpType As Long) As Long
Private Declare Function LoadResource Lib "kernel32" (ByVal hInstance As Long, ByVal hResInfo As Long) As Long
Private Declare Function LockResource Lib "kernel32" (ByVal hResData As Long) As Long
Private Declare Function CreateIconFromResourceEx Lib "user32" (presbits As Byte, ByVal dwResSize As Long, ByVal fIcon As Long, ByVal dwVer As Long, ByVal cxDesired As Long, ByVal cyDesired As Long, ByVal uFlags As Long) As Long
Private Declare Function LookupIconIdFromDirectoryEx Lib "user32.dll" (presbits As Byte, ByVal fIcon As Boolean, ByVal cxDesired As Long, ByVal cyDesired As Long, ByVal Flags As Long) As Long
Private Declare Function EnumResourceNames Lib "kernel32" Alias "EnumResourceNamesA" (ByVal HModule As Long, ByVal lpType As Long, ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Private Declare Function ExtractAssociatedIconEx Lib "shell32.dll" Alias "ExtractAssociatedIconExA" (ByVal hInst As Long, ByVal lpIconPath As String, lpiIconIndex As Long, lpiIconId As Long) As Long
Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As Long) As Long

Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef lpDest As Any, ByRef lpSource As Any, ByVal nCount As Long)

Private Const LOAD_LIBRARY_AS_DATAFILE = &H2
Private Const RT_ICON = 3
Private Const RT_STRING = 6&
Private Const RT_GROUP_ICON = RT_ICON + 11

Private varResNames() As Variant
Public Function GetAssociatedIconBySize(ByVal strModule As String, ByVal intSize As Integer) As Long
    Dim lngLibH
    Dim lngIcoIDs() As Long, intLoop As Integer
    lngLibH = LoadLibraryEx(strModule, 0, LOAD_LIBRARY_AS_DATAFILE)
    If lngLibH <> 0 Then
        ReDim varResNames(0)
        Call EnumResourceNames(lngLibH, RT_GROUP_ICON, AddressOf EnumResNamesProc, 0)
        If Len(varResNames(intLoop)) > 0 Then
            GetAssociatedIconBySize = GetAssociatedIconHandle(lngLibH, varResNames(intLoop), RT_GROUP_ICON, intSize)
        End If
        Call FreeLibrary(lngLibH)
    End If
End Function
Private Function EnumResNamesProc(ByVal hMod As Long, ByVal lpszType As Long, ByVal lpszName As Long, ByVal lParam As Long) As Long
    'from a project @ vb-accelerator
    Dim strName As String
    Dim lngName As Long
    Dim bytData() As Byte
    Dim lngLen As Long
    If (lpszName And &HFFFF0000) = 0 Then
        lngName = (lpszName And &HFFFF&)
        varResNames(UBound(varResNames)) = lngName
    Else
        lngLen = lstrlen(lpszName)
        If (lngLen > 0) Then
            ReDim bytData(0 To lngLen - 1) As Byte
            Call CopyMemory(bytData(0), ByVal lpszName, lngLen)
            strName = StrConv(bytData, vbUnicode)
        End If
        varResNames(UBound(varResNames)) = strName
    End If
    If Len(varResNames(UBound(varResNames))) > 0 Then
        ReDim Preserve varResNames(UBound(varResNames) + 1)
    End If
    'you can set to 0 to prevent enumerating through all of the resources
    EnumResNamesProc = 1
End Function
Private Function GetAssociatedIconHandle(ByVal lngLibHandle As Long, varNameOrID As Variant, ByVal lngType As Long, Optional intSize As Integer) As Long
    Dim lngResInfo As Long, lngResHandle As Long
    Dim lngResPtr As Long, lngResLen As Long, lngResBuff() As Byte
    Dim lngResID As Long
    If VarType(varNameOrID) = vbLong Then
        lngResInfo = FindResourceByID(lngLibHandle, ByVal CLng(varNameOrID), ByVal lngType)
    Else
        lngResInfo = FindResourceByName(lngLibHandle, ByVal CStr(varNameOrID), ByVal lngType)
    End If
    If lngResInfo <> 0 Then
        lngResHandle = LoadResource(lngLibHandle, lngResInfo)
        If lngResHandle <> 0 Then
            lngResPtr = LockResource(lngResHandle)
            If lngResPtr <> 0 Then
                lngResLen = SizeofResource(lngLibHandle, lngResInfo)
                ReDim lngResBuff(lngResLen - 1)
                Call CopyMemory(ByVal VarPtr(lngResBuff(0)), ByVal lngResPtr, lngResLen)
                If lngType = RT_GROUP_ICON Then
                    lngResID = LookupIconIdFromDirectoryEx(lngResBuff(0), True, intSize, intSize, 0)
                    If lngResID <> 0 Then
                        GetAssociatedIconHandle = GetAssociatedIconHandle(lngLibHandle, lngResID, RT_ICON)
                    End If
                    Exit Function
                End If
                GetAssociatedIconHandle = CreateIconFromResourceEx(lngResBuff(0), lngResLen, True, CLng(&H30000), intSize, intSize, 0)
            End If
        End If
    End If
End Function

0
 
LVL 2

Author Comment

by:x_terminat_or_3
ID: 12256394
You're right zzzzzzzooc!

This shows the 48x48 icon, and not a 32x32 icon blown up to 48x48


Only thing I noticed since starting with icons is that VB crashes a lot.  

Only time that happened before with me, was when I was debuggin a program that uses subclassing and I forgot to turn the subclassing of when debugging.  However, that's not the case here, so any idea what may cause this behaviour?


Regards


Ramses (x_terminat_or_3)
0
 
LVL 17

Expert Comment

by:zzzzzooc
ID: 12256430
>> so any idea what may cause this behaviour?
Depends on what API functions you're using and how. Such as my use of CopyMemory().. if I tried to copy from/to memory I couldn't (for whatever reason), it'd probably throw a "nasty error". It's really hard to narrow it down to anything without a lot of debugging though. Just remember to "clean up".. such as destroying any icons when you're done with them since they won't be released from memory otherwise.

Using this solution, I hope you fully read my prior notes. This might not suit your needs without a lot of tweaking. :)  Anyways, good luck.
0
 
LVL 2

Author Comment

by:x_terminat_or_3
ID: 12256446
I did read your previous notes.

Thing is, I want to offer my users some shortcuts that already exists in a quick launch panel.  So I will have to find a way to read shortcuts, but that's another question...


With kind regards


Ramses
0

Featured Post

How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

Join & Write a Comment

Introduction I needed to skip over some file processing within a For...Next loop in some old production code and wished that VB (classic) had a statement that would drop down to the end of the current iteration, bypassing the statements that were c…
There are many ways to remove duplicate entries in an SQL or Access database. Most make you temporarily insert an ID field, make a temp table and copy data back and forth, and/or are slow. Here is an easy way in VB6 using ADO to remove duplicate row…
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…

708 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

14 Experts available now in Live!

Get 1:1 Help Now