Default Icons

[Mike]

Hi,

I am developing a document management system in MS Access (adp on top
of SQL Server). One thing I would like to do in my listview is show the
default icon associated in Windows with that specific file extension
(e.g. show the excel icon when my file has an xls-extension as Windows
Explorer does).

I found some neat VB-code to extract the default icon from the Windows
Registry (http://www.developerfusion.co.uk/show/2982/) and assign it to
a PictureBox. So, this basically does what I want, except for the fact
that I cannot do this in VBA since it uses a PictureBox's hDC. VBA does
not have a PictureBox and the closest control being an ImageControl has
no hDC.

Did anybody ever try to do the same or know how to tackle this?

Thanks,

Mike

[Stephen Lebans]

Mike I just searched GoogleGroups and back in 2004 I Emailed code to a
poster to convert a handle to an Icon file to a StdPicture object.
Unfortuntately I cannot find the code. I used ExtractIcon to get a handle to
the Icon. Then you use OleCreatePictureIndirect to convert the hIcon to a
StdPicture object.

--

HTH
Stephen Lebans
http://www.lebans.com
Access Code, Tips and Tricks
Please respond only to the newsgroups so everyone can benefit.
"Mike" <mi*************@hotmail.comwrote in message
news:11**********************@m58g2000cwm.googlegr oups.com...

Hi,

I am developing a document management system in MS Access (adp on top
of SQL Server). One thing I would like to do in my listview is show the
default icon associated in Windows with that specific file extension
(e.g. show the excel icon when my file has an xls-extension as Windows
Explorer does).

I found some neat VB-code to extract the default icon from the Windows
Registry (http://www.developerfusion.co.uk/show/2982/) and assign it to
a PictureBox. So, this basically does what I want, except for the fact
that I cannot do this in VBA since it uses a PictureBox's hDC. VBA does
not have a PictureBox and the closest control being an ImageControl has
no hDC.

Did anybody ever try to do the same or know how to tackle this?

Thanks,

Mike

[Mike]

Stephen,

Thanks for the hint. I have been searching a little and came up with
the following.

In a seperate module:

Option Explicit

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

Private Type uPicDesc
Size As Long
Type As Long
hPic As Long
hPal As Long
End Type

Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" _
(PicDesc As uPicDesc, _
RefIID As GUID, _
ByVal fPictureOwnsHandle As Long, _
IPic As IPicture) As Long

Const CF_BITMAP = 2
Const CF_PALETTE = 9
Const IMAGE_BITMAP = 0
Const LR_COPYRETURNORG = &H4
Const PICTYPE_BITMAP = 1
Dim strPictureFile As String

Public Function GetIconFromHandle(ByVal Handle As Long) As StdPicture

Dim IID_IDispatch As GUID
Dim uPicinfo As uPicDesc
Dim IPic As IPicture
Dim hPtr As Long

'Create the interface GUID for the picture
With IID_IDispatch
.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

'Fill uPicInfo with necessary parts.
With uPicinfo
.Size = Len(uPicinfo)
.Type = PICTYPE_BITMAP
.hPic = hPtr
.hPal = 0
End With

'Create the picture object
OleCreatePictureIndirect uPicinfo, IID_IDispatch, True, IPic

Set GetIconFromHandle = IPic

End Function

Public Function GetIcon(strExtension As String) As StdPicture
'Needs additional exception and error handling

Dim strFileType As String
Dim strIconFile As String
Dim lngIconHandle As Long
Dim lngIconNumber As Long

'Search the registry for the file type associated with this extension
(e.g. Word.Document.8)
strFileType = RegValue(HKEY_CLASSES_ROOT, "." & strExtension,
vbNullString)

'Search the registry for the default icon associated with this file
type (e.g. C:\Windows\...\wordicon.exe,1)
strIconFile = RegValue(HKEY_CLASSES_ROOT, strType & "\DefaultIcon",
vbNullString)

'Trim the icon number out of this string (e.g. 1)
lngIcoNumber = Trim(Right(strIconFile, Len(strIconFile) -
InStrRev(strIconFile, ",")))

'Trim the icon file out of this string (e.g.
C:\Windows\...\wordicon.exe)
strIconFile = Trim(Left(strIconFile, Len(strIconFile) -
InStrRev(strIconFile, ",")))

'Get a handle to this icon
lngIconHandle = ExtractIcon(Me.hwnd, strIconFile, lngIconNumber)

'Create a picture from this handle and return it
Set GetIcon = GetIconFromHandle(lngIconHandle)

End Function

In my form, I currently have the following to add a file from a textbox
(txtFile) to an imagelist (lstMain) and show the file in a listview
lvwDocuments:

Private Sub cmdLoadFile_Click()

Dim strTemp As String

strTemp = Right(Me.txtFile, Len(Me.txtFile) - InStrRev(Me.txtFile,
"."))

Me.lstMain.ListImages.Add , strTemp, GetIcon(strTemp)
Me.lvwDocuments.ListItems.Add , , Me.txtFile, strTemp

End Sub

What I currently receive in the listview, is a black icon. So,
something is going wrong, but I do not understand where. Would you have
a clue?

Thanks,

Mike

[Stephen Lebans]

PICTYPE_ICON = 3

--

HTH
Stephen Lebans
http://www.lebans.com
Access Code, Tips and Tricks
Please respond only to the newsgroups so everyone can benefit.
"Mike" <mi*************@hotmail.comwrote in message
news:11*********************@m58g2000cwm.googlegro ups.com...

Stephen,

Thanks for the hint. I have been searching a little and came up with
the following.

In a seperate module:

Option Explicit

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

Private Type uPicDesc
Size As Long
Type As Long
hPic As Long
hPal As Long
End Type

Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" _
(PicDesc As uPicDesc, _
RefIID As GUID, _
ByVal fPictureOwnsHandle As Long, _
IPic As IPicture) As Long

Const CF_BITMAP = 2
Const CF_PALETTE = 9
Const IMAGE_BITMAP = 0
Const LR_COPYRETURNORG = &H4
Const PICTYPE_BITMAP = 1
Dim strPictureFile As String

Public Function GetIconFromHandle(ByVal Handle As Long) As StdPicture

Dim IID_IDispatch As GUID
Dim uPicinfo As uPicDesc
Dim IPic As IPicture
Dim hPtr As Long

'Create the interface GUID for the picture
With IID_IDispatch
.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

'Fill uPicInfo with necessary parts.
With uPicinfo
.Size = Len(uPicinfo)
.Type = PICTYPE_BITMAP
.hPic = hPtr
.hPal = 0
End With

'Create the picture object
OleCreatePictureIndirect uPicinfo, IID_IDispatch, True, IPic

Set GetIconFromHandle = IPic

End Function

Public Function GetIcon(strExtension As String) As StdPicture
'Needs additional exception and error handling

Dim strFileType As String
Dim strIconFile As String
Dim lngIconHandle As Long
Dim lngIconNumber As Long

'Search the registry for the file type associated with this extension
(e.g. Word.Document.8)
strFileType = RegValue(HKEY_CLASSES_ROOT, "." & strExtension,
vbNullString)

'Search the registry for the default icon associated with this file
type (e.g. C:\Windows\...\wordicon.exe,1)
strIconFile = RegValue(HKEY_CLASSES_ROOT, strType & "\DefaultIcon",
vbNullString)

'Trim the icon number out of this string (e.g. 1)
lngIcoNumber = Trim(Right(strIconFile, Len(strIconFile) -
InStrRev(strIconFile, ",")))

'Trim the icon file out of this string (e.g.
C:\Windows\...\wordicon.exe)
strIconFile = Trim(Left(strIconFile, Len(strIconFile) -
InStrRev(strIconFile, ",")))

'Get a handle to this icon
lngIconHandle = ExtractIcon(Me.hwnd, strIconFile, lngIconNumber)

'Create a picture from this handle and return it
Set GetIcon = GetIconFromHandle(lngIconHandle)

End Function

In my form, I currently have the following to add a file from a textbox
(txtFile) to an imagelist (lstMain) and show the file in a listview
lvwDocuments:

Private Sub cmdLoadFile_Click()

Dim strTemp As String

strTemp = Right(Me.txtFile, Len(Me.txtFile) - InStrRev(Me.txtFile,
"."))

Me.lstMain.ListImages.Add , strTemp, GetIcon(strTemp)
Me.lvwDocuments.ListItems.Add , , Me.txtFile, strTemp

End Sub

What I currently receive in the listview, is a black icon. So,
something is going wrong, but I do not understand where. Would you have
a clue?

Thanks,

Mike

[Mike]

It gives me invalid picture now when trying to load it into the
imagelist.

On 30 jan, 04:50, "Stephen Lebans" <ForEmailGotoMy.WebSite.-
[e-mail]:

PICTYPE_ICON = 3

[Stephen Lebans]

Have you stepped through your code? What are the values of the variables
invlovled in the function calls that fails?

--

HTH
Stephen Lebans
http://www.lebans.com
Access Code, Tips and Tricks
Please respond only to the newsgroups so everyone can benefit.
"Mike" <mi*************@hotmail.comwrote in message
news:11**********************@j27g2000cwj.googlegr oups.com...

It gives me invalid picture now when trying to load it into the
imagelist.

On 30 jan, 04:50, "Stephen Lebans" <ForEmailGotoMy.WebSite.-
[e-mail]:

>PICTYPE_ICON = 3

[ssteinke]

Mike,

I am dealing with this same issue, have you resolved this? I have
searched hi and low but it seems that nobody has ever posted a
completed solution.

Thanks for your time,

Scott