Newsgroup: it.comp.lang.visual-basic
Titolo: [?] ExtractIconEx e salvataggio su file

'Il programma che segue
'(estratto da APIGuide di 
www.allapi.net
, cercare ExtractIconEx)
'estrae tante icone quante ce ne stanno in Me.ScaleWidth/32
'prelevandole fra quelle disponibili in Shell32.dll e le
'espone una dopo l'altra sul form.
'
'Ho ripetuto e modificato il ciclo per estrarre anche le
'icone piccole (16x16), passando il secondo puntatore e
'non il primo (come indicato fra le info di APIGuide),
'e visualizzarle appena sotto (32+5). Si vedono e si
'vede anche che sono meno "precise", ovvero alla fonte
'sono presumibilmente 16x16, ma vengono zoomate a 32x32.
'(Risulta evidente sulle prime due, almeno le mie)
'
'Avrei due domande:
'
'-Come faccio ad esporre le icone 16x16 senza che vengano zoomate a 32x32?
'
'-Come faccio a salvare un'icona su file con estensione .ICO in modo che sia
_realmente_ un'icona (anche passando da form e/o picturebox di appoggio,
insomma, della velocità non mi importa nulla)?
'Grazie
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 DrawIcon Lib "user32" (ByVal hdc As Long, ByVal x
As Long, ByVal y As Long, ByVal hIcon As Long) As Long
Private Declare Function DestroyIcon Lib "user32" (ByVal hIcon As Long) As
Long
Private Sub Form_Load()
    'KPD-Team 1998
    'URL: 
http://www.allapi.net/
    'E-Mail: KPD...@Allapi.net
    Me.ScaleMode = vbPixels
End Sub
Private Sub Form_Paint()
    Dim mIcon As Long   'Icona grande
    Dim pIcon As Long   'Icona piccola
    Dim Cnt As Long     'Contatore icone
    'Clear the form
    Me.Cls
'       Icone grandi (32x32)
    'Extract icons from 'shell32.dll' and draw them on the form
    For Cnt = 0 To Me.ScaleWidth / 32
        ExtractIconEx "shell32.dll", Cnt, mIcon, ByVal 0&, 1
        DrawIcon Me.hdc, 32 * Cnt, 0, mIcon
        DestroyIcon mIcon
    Next Cnt
'       Icone piccole (16x16)
    For Cnt = 0 To Me.ScaleWidth / 32
        ExtractIconEx "shell32.dll", Cnt, ByVal 0&, pIcon, 1
        DrawIcon Me.hdc, 32 * Cnt, 32 + 5, pIcon
        DestroyIcon pIcon
    Next Cnt
End Sub
Private Sub Form_Resize()
    Form_Paint
End Sub

 insomma, della velocità non mi importa nulla)?
Non te lo so dire... In bitmap puoi farlo facilmente col SavePicture... In
ICO non credo si possa fare normalmente... Forse con qualche API...
Antonio Mirarchi

 con qualche API...
Ahi! Era la cosa che più mi interessava...

 Grazie. Provo e faccio sapere
Ok, funge. Mi resta il problema di come salvare. :-(

[*Lupo* = 
LupoOrmaiR...@libero.it
 in
news:br6v5n$7r4$
1...@ID-174464.news.uni-berlin.de
] ha scritto:
'Ecco la soluzione finale, anche grazie a un post di Moreno Sirri (
http://makeashorterlink.com/?A27B414C6
 ):
'Funziona tutto tranne che i file creati da icone
'piccole (16x16) non contengono le trasparenze
'Se qualcuno trova la soluzione... Grazie. :-)
'ATTENZIONE: Creare una Cartella C:\ICONE
'Tutto da
    'KPD-Team 1998
    'URL: 
http://www.allapi.net/
    'E-Mail: KPD...@Allapi.net
'Tranne parti identificate da Moreno Sirri <=Start e >=End
Const DI_MASK = &H1
Const DI_IMAGE = &H2
Const DI_NORMAL = DI_MASK Or DI_IMAGE
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 DrawIcon Lib "user32" (ByVal hdc As Long, ByVal x
As Long, ByVal y As Long, ByVal hicon 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 DestroyIcon Lib "user32" (ByVal hicon As Long) As
Long
'---<Moreno Sirri
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
'---Moreno Sirri>
Private Sub Form_Load()
    Me.ScaleMode = vbPixels
End Sub
Private Sub Form_Paint()
    Dim mIcon As Long
    Dim pIcon As Long
    Dim Cnt As Long
    'Dim hlargeicon As Long
    'Dim hsmallicon As Long
    'Dim selhandle As Long
'---<Moreno Sirri
    ' IPicture requires a reference to "Standard OLE Types."
    Dim pic As PicBmp
    Dim IPic As IPicture
    Dim IID_IDispatch As GUID
'---Moreno Sirri>
    'Clear the form
    Me.Cls
'       Icone grandi (32x32)
    'Extract icons from 'shell32.dll' and draw them on the form
    For Cnt = 0 To Me.ScaleWidth / 32
        ExtractIconEx "shell32.dll", Cnt, mIcon, ByVal 0&, 1
        DrawIcon Me.hdc, 32 * Cnt, 0, mIcon
'---<Moreno Sirri
        ' 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.
            .hBmp = mIcon ' Handle to bitmap.
        End With
        ' Create Picture object.
        Call OleCreatePictureIndirect(pic, IID_IDispatch, 1, IPic)
        Call SavePicture(IPic, "C:\ICONE\" & Cnt & "_32x32.ICO")  'Crea un
vero file .ICO
'---Moreno Sirri>
        DestroyIcon mIcon
    Next Cnt
'       Icone piccole (16x16)
    For Cnt = 0 To Me.ScaleWidth / 32
        ExtractIconEx "shell32.dll", Cnt, ByVal 0&, pIcon, 1
        'DrawIcon Me.hdc, 32 * Cnt, 32 + 5, pIcon
        DrawIconEx Me.hdc, 32 * Cnt, 32 + 5, pIcon, 0, 0, 0, 0, DI_NORMAL
'---<Moreno Sirri
        ' 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 = pIcon ' Handle to bitmap.
        End With
        ' Create Picture object.
        Call OleCreatePictureIndirect(pic, IID_IDispatch, 1, IPic)
        Call SavePicture(IPic, "C:\ICONE\" & Cnt & "_16x16.ICO")  'Crea un
vero file .ICO *(ma senza trasparenze)* :-(
'---Moreno Sirri>
