CISA FotoGallery

Statistiche

Tot. visite contenuti : 927984
Home Articoli tecnici API Icona associata a File in ImageControl

Icona associata a File in ImageControl

Questo Demo sfrutta principalmente le API grafiche OLE per convertire l'Handle dell'icona associata ad un File in una struttura dati compatibile con la proprietà Picture del nostro Controllo Immagine.

la proprietà Picture dell'oggetto Immagine è un'istanza della classe IPictureDisp membro di stdOle.

Library stdole
C:\WINNT\system32\stdole2.tlb

Da HICON a Picture

Un oggetto IPictureDisp è creato dalla funzione OleCreatePictureIndirect la cui invocazione deve essere preceduta da una chiamata a OleInitialize e seguita da un OleUninitialize. In altre parole bisogna accertarsi di chiamare la funzione solo dopo che è stata eseguita OleInitialize (basta una volta).

La funzione che dovrà risiedere in un Modulo Standard sarà richiamabile così:

Call SetIcon (Me!imgFileControl, "C:\File.Exe")

Ovviamente con le adeguate modifiche sarà possibile estrarre i file ICO indicizzati direttamente dalle DLL.

CODICE

Option Compare Database
Option Explicit

'***********************************************************************
' Questo codice è una personale e cortese concessione di
' Serge Gavrilov
'***********************************************************************
Const GWL_HINSTANCE = (-6)

Private Declare Function ExtractIcon Lib "shell32.dll" _
        Alias "ExtractIconA" _
        (ByVal hInst As Long, _
         ByVal lpszExeFileName As String, _
         ByVal nIconIndex As Long) As Long

Private Declare Function
GetWindowLong Lib "user32" _
         Alias "GetWindowLongA" _
         (ByVal hWnd As Long, ByVal nIndex As Long) As Long
  

Private Declare Function
ExtractAssociatedIcon Lib "shell32.dll" _
        Alias "ExtractAssociatedIconA" _
        (ByVal hInst As Long, _
         ByVal lpIconPath As String, _
         ByRef lpiIcon As Integer) As Long

Private Declare Function
DestroyIcon Lib "user32" _
        (ByVal hIcon As Long) As Long

' Questa funzione ritorna la Dir temporanea di Sistema
Private Declare Function GetTempPath Lib "kernel32" Alias _
                        "GetTempPathA" (ByVal nBufferLength As Long, _
                        ByVal lpBuffer As String) As Long


Private Type
ICONTYPE
    cbSizeOfStruct As Long
    
picType As Long
    
hIcon As Long
    
dummy1 As Long
    
dummy2 As Long
End Type

Private Type
GUID
    Data1 As Long
    
Data2 As Integer
    
Data3 As Integer
    
BData1 As Byte
    
BData2 As Byte
    
BData3 As Byte
    
BData4 As Byte
    
BData5 As Byte
    
BData6 As Byte
    
BData7 As Byte
    
BData8 As Byte
End Type

Private Declare Function
OleInitialize Lib "OLE32.DLL" ( _
        lp As Any) As Long

Private Declare Function
OleCreatePictureIndirect Lib "olepro32.dll" ( _
        picDesc As ICONTYPE, _
        iid As GUID, _
        ByVal fOwn As Boolean, _
        iPic As IPictureDisp) As Long

Private Declare Sub
OleUninitialize Lib "OLE32.DLL" ()

Private Const PICTYPE_ICON = 3

Private Function GetIcoPicture(hIcon As Long) As IPictureDisp
    Dim picDesc As ICONTYPE
    Dim iid As GUID
    Dim pic As IPictureDisp
    Dim hIconLarge As Long
    
    
' Set PICTDESC to convert HICONs.
    
picDesc.cbSizeOfStruct = Len(picDesc)
    picDesc.picType = PICTYPE_ICON
    picDesc.hIcon = hIcon
    ' Fill in magic IPicture GUID
    '{7BF80980-BF32-101A-8BBB-00AA00300CAB}
    ' IPictureDisp ID is:
    ' 0x7Bf80981,0xBF32,0x101A,0x8B,0xBB,0x00,0xAA,
    ' 0x00,0x30,0x0C,0xAB
    
iid.Data1 = &H7BF80981
    iid.Data2 = &HBF32
    iid.Data3 = &H101A
    iid.BData1 = &H8B
    iid.BData2 = &HBB
    iid.BData3 = &H0
    iid.BData4 = &HAA
    iid.BData5 = &H0
    iid.BData6 = &H30
    iid.BData7 = &HC
    iid.BData8 = &HAB

    ' convert to IPictureDisp
    
OleInitialize ByVal 0&
    OleCreatePictureIndirect picDesc, iid, True, pic
    OleUninitialize
    Set GetIcoPicture = pic
End Function

Public Function
SetIcon(imgCtl As Access.Image, strPath As String) As String
    Dim
hInst As Long
    Dim
hIcon As Long
    
hInst = GetWindowLong(Application.hWndAccessApp, GWL_HINSTANCE)
    hIcon = ExtractAssociatedIcon(hInst, strPath, CLng(0))
    SavePicture GetIcoPicture(hIcon), tempPath & hIcon & ".ico"
    DestroyIcon hIcon
    imgCtl.Picture = tempPath & hIcon & ".ico"
    Kill tempPath & hIcon & ".ico"
End Function

Private Function
tempPath() As String
    Dim
strTemp As String
    
strTemp = String(510, Chr$(0))
    GetTempPath 510, strTemp
    tempPath = Left$(strTemp, InStr(strTemp, Chr$(0)) - 1)
End Function



Alessandro