Hej
Det är så att jag har stött på ett litet problem, och jag har ett program som plockar ut iconen från en exe fil, men problemet är att jag får inte med det som ska vara genomskinligt, utan den färgen blir grå

Jag skickar med koden:

<code>
Private Function ExtractIcon(FileName As String, AddtoImageList As ImageList, PictureBox As PictureBox, PixelsXY As Integer) As Long
Dim SmallIcon As Long
Dim NewImage As ListImage
Dim IconIndex As Integer

If PixelsXY = 16 Then
SmallIcon = SHGetFileInfo(FileName, 0&, FileInfo, Len(FileInfo), Flags Or SHGFI_SMALLICON)
Else
SmallIcon = SHGetFileInfo(FileName, 0&, FileInfo, Len(FileInfo), Flags Or SHGFI_LARGEICON)
End If

If SmallIcon <> 0 Then
With PictureBox
.Height = 20 * PixelsXY
.Width = 20 * PixelsXY
.ScaleHeight = 20 * PixelsXY
.ScaleWidth = 20 * PixelsXY
.Picture = LoadPicture("")
.AutoRedraw = True
'.BackColor = Nothing <------ Fungerar inte!

SmallIcon = ImageList_Draw(SmallIcon, FileInfo.iIcon, PictureBox.hDC, 0, 0, ILD_TRANSPARENT)
.Refresh
End With

IconIndex = AddtoImageList.ListImages.Count + 1
Set NewImage = AddtoImageList.ListImages.Add(IconIndex, , PictureBox.Image)
ExtractIcon = IconIndex
End If
End Function
</code>

som ni ser i koden så fungerar det inte att sätta backcolor till nothing, och om man tar bort det helt så blir bakrunden grå.......
någon som har ett tips?

Det finns en funktion som heter OleCreatePictureIndirect. Den omvandlar ett handtag för en icon till en stdpicture.

Har skrivit om din funktion attanvända OleCreatePictureIndirect. Samt att retunerar ListImage istället för ett index:
<code>
Option Explicit

Private Type PictDesc
cbSizeofStruct As Long
picType As Long
hImage As Long
xExt As Long
yExt As Long
End Type

Private Type Guid
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(0 To 7) As Byte
End Type

Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (lpPictDesc As PictDesc, riid As Guid, ByVal fPictureOwnsHandle As Long, ipic As IPicture) As Long

Private Function ExtractIcon(FileName As String, AddtoImageList As ImageList, PixelsXY As Integer) As ListImage
Dim hIcon As Long
Dim oNewPic As Picture
Dim tPicConv As PictDesc
Dim IGuid As Guid

If PixelsXY = 16 Then
hIcon = SHGetFileInfo(FileName, 0&, FileInfo, Len(FileInfo), Flags Or SHGFI_SMALLICON)
Else
hIcon = SHGetFileInfo(FileName, 0&, FileInfo, Len(FileInfo), Flags Or SHGFI_LARGEICON)
End If

If hIcon Then
tPicConv.cbSizeofStruct = Len(tPicConv)
tPicConv.picType = vbPicTypeIcon
tPicConv.hImage = hIcon

' Fill in magic IPicture GUID {7BF80980-BF32-101A-8BBB-00AA00300CAB}
IGuid.Data1 = &H7BF80980
IGuid.Data2 = &HBF32
IGuid.Data3 = &H101A
IGuid.Data4(0) = &H8B
IGuid.Data4(1) = &HBB
IGuid.Data4(2) = &H0
IGuid.Data4(3) = &HAA
IGuid.Data4(4) = &H0
IGuid.Data4(5) = &H30
IGuid.Data4(6) = &HC
IGuid.Data4(7) = &HAB

OleCreatePictureIndirect tPicConv, IGuid, True, oNewPic

Set ExtractIcon = AddtoImageList.ListImages.Add(, , oNewPic)
End If
End Function
</code>

okey tack

Nu känner jag mig lite dum, men hur ska jag göra för att
fixa in iconen i en Image?

för att jag har försökt att hämta svaret från ExtractIcon
men jag får bara upp ett felmeddelande hela tiden, och det kvittar hur jag än
gör.

det står
"Wrong number of arguments or invalid property assignment"

vad gör jag för fel?

EDIT:

får även fram nu meddelandet
"Invalid Picture"

Jag har separerat funktionerna.

Denna funktionen tar ett handtag för en bitmap, icon, metafil och retunerar ett stdPicture objekt:
<code>
Private Type PictDesc
cbSizeofStruct As Long
PicType As Long
hImage As Long
xExt As Long
yExt As Long
End Type

Private Type Guid
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(0 To 7) As Byte
End Type

Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (lpPictDesc As PictDesc, riid As Guid, ByVal fPictureOwnsHandle As Long, ipic As IPicture) As Long

Public Function ImageToPicture(Handle As Long, Optional PictureType As PictureTypeConstants = vbPicTypeBitmap) As StdPicture
Dim Guid As Guid
Dim PictDesc As PictDesc
If Handle Then
With PictDesc
.cbSizeofStruct = Len(PictDesc)
.PicType = PictureType
.hImage = Handle
End With

' Fill in magic IPicture GUID {7BF80980-BF32-101A-8BBB-00AA00300CAB}
With Guid
.Data1 = &H7BF80980
.Data2 = &HBF32
.Data3 = &H101A
.Data4(0) = &H8B
.Data4(1) = &HBB
.Data4(2) = &H0
.Data4(3) = &HAA
.Data4(4) = &H0
.Data4(5) = &H30
.Data4(6) = &HC
.Data4(7) = &HAB
End With
OleCreatePictureIndirect PictDesc, Guid, True, ImageToPicture
End If
End Function
</code>

För att hämta ut en icon från en fil som stdPicture:
<code>
Public Const eiErrFailed = vbObjectError + 1
Public Const eiErrNoHandle = vbObjectError + 2

Private Const MAX_PATH As Long = 260

Private Const SHGFI_ICON As Long = &H100

Private Const SHGFI_LARGEICON As Long = &H0
Private Const SHGFI_SMALLICON As Long = &H1

Private Type SHFILEINFO
hIcon As Long ' out: icon
iIcon As Long ' out: icon index
dwAttributes As Long ' out: SFGAO_ flags
szDisplayName As String * MAX_PATH ' out: display name (or path)
szTypeName As String * 80 ' out: type name
End Type

Private Declare Function SHGetFileInfo Lib "shell32.dll" Alias "SHGetFileInfoA" (ByVal pszPath As String, ByVal dwFileAttributes As Long, psfi As SHFILEINFO, ByVal cbFileInfo As Long, ByVal uFlags As Long) As Long

Public Function ExtractIcon(FileName As String, Optional IconSize As Integer = 32) As StdPicture
Dim Flags As Long
Dim FileInfo As SHFILEINFO
If IconSize = 16 Then
Flags = SHGFI_ICON Or SHGFI_SMALLICON
Else
Flags = SHGFI_ICON Or SHGFI_LARGEICON
End If

If SHGetFileInfo(FileName, 0&, FileInfo, Len(FileInfo), Flags) Then
If FileInfo.hIcon Then
Set ExtractIcon = ImageToPicture(FileInfo.hIcon, vbPicTypeIcon)
Else
Err.Raise eiErrNoHandle, "ExtractIcon()", "No icon handle returned"
End If
Else
Err.Raise eiErrFailed, "ExtractIcon()", "SHGetFileInfo() call failed"
End If
End Function
</code>

Här är ett exempel som hämtar iconen från notepad:
<code>
Private Sub Form_Load()
Image1.Picture = ExtractIcon(Environ("SystemRoot") & "\notepad.exe")
End Sub
</code>

Tackar =))

Nu fungerar det fin fint :))

Stort tack!

Koden funkar inte fullt u med med semitransparanta ikoner som finns i Windows XP.

Du har glömt markera inlägget som löst.

nä jag såg att det inte riktigt fungerade med win XP:s iconer, men det gör inte så mycket

Jag klarar mig ändå =)

jo jag såg nu också att jag har glömt att sätta det till löst
men det fixar jag nu =)

Tack åter igen =)