There is a trick that allows bitmaps to appear as a icon of themselves. This is because icons are files containg multiple bitmaps. Windows has always been able to use bitmaps as icons though MS screwed up the rendering in XP and transparent show as black.
From
www.mvps.org/serenitymacros/icon.html
Windows treats bitmaps (bmp or Bitmap Image files) as icons. Therefore with a simple registry edit bitmaps will show a picture of themselves as a icon.
VBS File
SetBitmapIcons.vbs tests that Bitmap Image (bmp) files are associated with Picture.Paint because a lot of bitmap editors take the extension and set it to themselves (which is the incorrect way of doing it). If it's not associated with Picture.Paint then it offers to reassociate Bitmap Images to Picture.Paint. The icons cannot be changed if it's not associated with Picture.Paint. You are only prompted to change the association to Picture.Paint if it's not already associated.
It then tests if the icon is already set to display its' own picture. If it is, it offers to restore the Window's default which is Icon 1 in MSPaint, if not it offers to set it to a picture of the bitmap.
The icon cache file is then deleted and it advises that a restart of Windows is necessary. See the note in the file if Windows is not installed in its' default directories or if directories short file name has been changed.
'SetBitmapIcons.vbs
'Displays and/or changes the default association for bitmaps and can change them to use a picture of themselves as the icon.
'
'Serenity Macros
http://www.angelfire.com/biz/serenitymacros
'David Candy (e-mail address removed)
'
'-----------------------------------------------------
'N O T E * * * N O T E * * * N O T E
'Edit strPbrush with the path to MSPaint (in case it's different from the default)
'----------------------------------------------------
'
On Error Resume Next
strPbrush="C:\PROGRA~1\ACCESS~1\MSPAINT.EXE,1"
strTitle="Set Bitmap Icon"
strPbrush="C:\PROGRA~1\ACCESS~1\MSPAINT.EXE,1"
Dim Sh
Set Sh = WScript.CreateObject("WScript.Shell")
ReportErrors "Creating Shell"
Msgbox "Set Bitmap Icons checks the file association for bitmaps, can restore them to the Windows default if they have been changed, and can set the icon to be a picture of the bitmap or set it back to the Windows default icon." & vbCRLF & vbCRLF & "You will be prompted for each action.", vbInformation + vbOKOnly, strTitle
If Sh.RegRead("HKCR\.bmp\") ="Paint.Picture" then
SetIcon
Else
If MsgBox("Bitmaps are associated with " & Sh.RegRead("HKCR\.bmp\") & vbcrlf & vbcrlf & "Would you llike to associate bitmaps back to Paint?",vbQuestion + vbYesNo + vbDefaultButton2, strTitle) =6 then
Sh.RegWrite "HKCR\.bmp\", "Paint.Picture"
SetIcon
Else
Msgbox "Bitmap associations not changed. Cannot set icon for bitmaps unless their associated with Paint.Picture (usually Paint).", vbInformation + vbOKOnly, strTitle
End If
End If
ReportErrors "Main"
VisitSerenity
'---------------------------------------------------------
Sub SetIcon
On Error Resume Next
If Sh.RegRead("HKCR\Paint.Picture\DefaultIcon\") <>"%1" then
If MsgBox("Icons are set to show as Windows default icon." & vbCRLF & vbCRLF & "This will set the default icon for bitmaps to a picture of the bitmap." & vbCRLF & vbCRLF & "Continue?",vbQuestion + vbYesNo + vbDefaultButton2, strTitle) =6 then
Sh.RegWrite "HKCR\Paint.Picture\DefaultIcon\","%1"
Msgbox "Bitmap icons should now be a picture of the bitmap." & vbCRLF & vbCRLF & "You'll need to restart Windows", vbInformation + vbOKOnly, strTitle
FlushIconCache
Else
Msgbox "Bitmap icons were not changed", vbInformation + vbOKOnly, strTitle
End If
Else
If MsgBox("Icons are set to show as a picture of the bitmap." & vbCRLF & vbCRLF & "This will set the default icon for bitmaps to Windows default" & vbCRLF & vbCRLF & "If Windows is not installed on the C drive, MSPaint is not installed, or Program Files\Accessories folder has a non standard short file name then choose No and edit this file with the correct path name." & vbCRLF & vbCRLF & "Continue?",vbQuestion + vbYesNo + vbDefaultButton2, strTitle) =6 then
Sh.RegWrite "HKCR\Paint.Picture\DefaultIcon\",strPbrush
Msgbox "Bitmap icons should now be Windows default icon. " & vbCRLF & vbCRLF & "You'll need to restart Windows", vbInformation + vbOKOnly, strTitle
FlushIconCache
Else
Msgbox "Bitmap icons were not changed", vbInformation + vbOKOnly, strTitle
End If
End If
ReportErrors "SetIcon"
End Sub
'---------------------------------------------------------
Sub FlushIconCache
On Error Resume Next
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
FSO.DeleteFile sh.ExpandEnvironmentStrings("%windir%") & "\ShellIconCache", true
If err.number=53 then err.clear
ReportErrors "FlushIconCache"
End Sub
Sub ReportErrors(strModuleName)
If err.number<>0 then Msgbox "Error occured in " & strModuleName & " module of " & err.number& " - " & err.description & " type" , vbCritical + vbOKOnly, "Something unexpected"
Err.clear
End Sub
Sub VisitSerenity
If MsgBox("This program came from the Serenity Macros Web Site" & vbCRLF & vbCRLF & "Would you like to visit Serenity's Web Site now?", vbQuestion + vbYesNo + vbDefaultButton2, "Visit Serenity Macros") =6 Then
sh.Run "http:\\
www.angelfire.com\biz\serenitymacros"
End If
End Sub
