Solved

Custom Icons for Folders

Posted on 2001-09-15
10
439 Views
Last Modified: 2012-06-21
I need to change the "yellow folder" icon to a custom icon from within a VB6 program for user selected folder shortcuts.

The functionality of the PC Magazine utility "Folders" is basically what I need from within a program.

Any pointers really welcome
0
Comment
Question by:roylow
  • 3
  • 3
  • 2
  • +2
10 Comments
 
LVL 16

Expert Comment

by:Richie_Simonetti
ID: 6485421
Ypu need to change the value stored in registry:


HKEY_CLASSES_ROOT\Folder\DefaultIcon]@="C:\\WINDOWS\\SYSTEM\\shell32.dll,3"

That  means take 3rd icon from shell32.dll.
You could change to a path where your custom ico is located.
If you have visual studio, there is a registry tool called
regtool5.dll that you can use to manage registry entries.
Cheers
0
 
LVL 8

Expert Comment

by:glass_cookie
ID: 6486543
Hi!

Here's an example for you over the net:

Download...
http://www.planetsourcecode.com/vb/scripts/ShowZip.asp?lngWId=1&lngCodeId=24197&strZipAccessCode=+fol241979781

Description: Change windows default yellow color icon and set your own custom icon to any folder with this easy code.

That's it!

glass cookie : )
0
 
LVL 8

Accepted Solution

by:
glass_cookie earned 200 total points
ID: 6486546
Here's another file for you over the net:

Download...
http://www.planetsourcecode.com/vb/scripts/ShowZip.asp?lngWId=1&lngCodeId=7863&strZipAccessCode=ODE%5F78635065

Description: Asign an icon to a folder

That's it!

PS. The link for the previous posting is this:
http://www.planetsourcecode.com/vb/scripts/ShowZip.asp?lngWId=1&lngCodeId=24197&strZipAccessCode=+fol241979781

0
 
LVL 49

Expert Comment

by:Ryan Chong
ID: 6487158
<listening..>
0
 
LVL 16

Expert Comment

by:Richie_Simonetti
ID: 6487515
MAYBE glass is right. My post doesn't work.
0
How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

 

Author Comment

by:roylow
ID: 6492099
Thanks Glass
Easy when you know how but who'd have thought making a folder "System" was the key?
0
 

Author Comment

by:roylow
ID: 6492102
Thanks, see previous comment
0
 
LVL 8

Expert Comment

by:glass_cookie
ID: 6492242
Thanks for the points.  Happy programming : )
0
 

Expert Comment

by:MonkeyLin
ID: 6662993
roylow:
I think you could try this to refresh the custom folder icon :
Private Const WM_WININICHANGE = &H1A
Private Const WM_SETTINGCHANGE = WM_WININICHANGE
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg

As Long, ByVal wParam As Long, lParam As Any) As Long
 whwnd = FindWindow("progMan", "program manager")
 SendMessage whwnd, WM_SETTINGCHANGE, 0, 0



0
 

Author Comment

by:roylow
ID: 6663514
I now have the solution to refreshing the folder icon!!

I do it by making a separate .exe (ShowCustomIcon.exe) which I then call using Shell as in dummy = Shell(ShowCustomIcon Myfoldername).

If you don't do this, repeated calls to the same code from within the same program just don't work but the first one does!!!???

Paste the following code into a project (no form) and compile it.

The calls to get the PIDL for DeskTop may not be necessary but the use of the undocumented API
SHSimpleIDListFromPath
certainly is.

Thanks to many people for help see documentation.


'   ************************************************************************
'   Declarations to support the call to SHChangeNotify which informs the system
'   of changes to the Shell, specifically to the folder icon

Declare Sub SHChangeNotify Lib "shell32" _
                        (ByVal wEventId As SHCN_EventIDs, _
                        ByVal uFlags As SHCN_ItemFlags, _
                        ByVal dwItem1 As Long, _
                        ByVal dwItem2 As Long)

'   undocumented API function as described by
' Brad Martinez, http://www.mvps.org
'at http://www.mvps.org/vbnet/code/callback/browsecallback.htm

'solution suggested by Randy Birch
'                       MVP Visual Basic

'                       http://www.mvps.org/vbnet/

Declare Function SHSimpleIDListFromPath Lib _
    "shell32" Alias "#162" _
    (ByVal szPath As String) As Long
   
Public Const MAX_PATH = 260
Public Const SHCONTF_FOLDERS = 32
Public Const SHCONTF_NONFOLDERS = 64
Public Const SHCONTF_INCLUDEHIDDEN = 128

Public Type PIDLSTRUCT

  ' Fully qualified pidl (relative to the desktop folder) of the folder to monitor changes in.
  ' 0 can also be specifed for the desktop folder.
   pidl As Long
  ' Value specifying whether changes in the folder's subfolders trigger a change notification
  '  event (it's actually a Boolean, but we'll go Long because of VB's DWORD struct alignment).
   bWatchSubFolders As Long
 End Type
 Public m_pidlDesktop As Long   ' the desktop's pidl

Public Enum SHCN_EventIDs
 SHCNE_RENAMEITEM = &H1      ' (D) A nonfolder item has been renamed.
 SHCNE_CREATE = &H2                ' (D) A nonfolder item has been created.
 SHCNE_DELETE = &H4                ' (D) A nonfolder item has been deleted.
 SHCNE_MKDIR = &H8                  ' (D) A folder item has been created.
 SHCNE_RMDIR = &H10                ' (D) A folder item has been removed.
 SHCNE_MEDIAINSERTED = &H20     ' (G) Storage media has been inserted into a drive.
 SHCNE_MEDIAREMOVED = &H40      ' (G) Storage media has been removed from a drive.
 SHCNE_DRIVEREMOVED = &H80      ' (G) A drive has been removed.
 SHCNE_DRIVEADD = &H100              ' (G) A drive has been added.
 SHCNE_NETSHARE = &H200             ' A folder on the local computer is being shared via the network.
 SHCNE_NETUNSHARE = &H400        ' A folder on the local computer is no longer being shared via the network.
 SHCNE_ATTRIBUTES = &H800           ' (D) The attributes of an item or folder have changed.
 SHCNE_UPDATEDIR = &H1000          ' (D) The contents of an existing folder have changed, but the folder still exists and has not been renamed.
 SHCNE_UPDATEITEM = &H2000                  ' (D) An existing nonfolder item has changed, but the item still exists and has not been renamed.
 SHCNE_SERVERDISCONNECT = &H4000   ' The computer has disconnected from a server.
 SHCNE_UPDATEIMAGE = &H8000&              ' (G) An image in the system image list has changed.
 SHCNE_DRIVEADDGUI = &H10000               ' (G) A drive has been added and the shell should create a new window for the drive.
 SHCNE_RENAMEFOLDER = &H20000          ' (D) The name of a folder has changed.
 SHCNE_FREESPACE = &H40000                   ' (G) The amount of free space on a drive has changed.

#If (WIN32_IE >= &H400) Then
 ' (G) SHCNE_EXTENDED_EVENT:  the extended event is identified in dwItem1,
 ' packed in LPITEMIDLIST format (same as SHCNF_DWORD packing).
 '
 ' Unlike the standard events, the extended events are ORDINALs, so we
 ' don't run out of bits.  Extended events follow the SHCNEE_* naming
 ' convention.
 '
 ' The dwItem2 parameter varies according to the extended event.
 SHCNE_EXTENDED_EVENT = &H4000000
#End If     ' WIN32_IE >= &H0400

 SHCNE_ASSOCCHANGED = &H8000000       ' (G) A file type association has changed.

 SHCNE_DISKEVENTS = &H2381F                  ' Specifies a combination of all of the disk event identifiers. (D)
 SHCNE_GLOBALEVENTS = &HC0581E0        ' Specifies a combination of all of the global event identifiers. (G)
 SHCNE_ALLEVENTS = &H7FFFFFFF
 SHCNE_INTERRUPT = &H80000000              ' The specified event occurred as a result of a system interrupt.
                                                                           ' It is stripped out before the clients of SHCNNotify_ see it.
End Enum

' Notification flags

' uFlags & SHCNF_TYPE is an ID which indicates what dwItem1 and dwItem2 mean
Public Enum SHCN_ItemFlags
 SHCNF_IDLIST = &H0                ' LPITEMIDLIST
 SHCNF_PATHA = &H1               ' path name
 SHCNF_PRINTERA = &H2         ' printer friendly name
 SHCNF_DWORD = &H3             ' DWORD
 SHCNF_PATHW = &H5              ' path name
 SHCNF_PRINTERW = &H6        ' printer friendly name
 SHCNF_TYPE = &HFF
 ' Flushes the system event buffer. The function does not return until the system is
 ' finished processing the given event.
 SHCNF_FLUSH = &H1000
 ' Flushes the system event buffer. The function returns immediately regardless of
 ' whether the system is finished processing the given event.
 SHCNF_FLUSHNOWAIT = &H2000

#If UNICODE Then
 SHCNF_PATH = SHCNF_PATHW
 SHCNF_PRINTER = SHCNF_PRINTERW
#Else
 SHCNF_PATH = SHCNF_PATHA
 SHCNF_PRINTER = SHCNF_PRINTERA
#End If

End Enum
' ====================================================================
' SHGetSpecialFolderLocation

' Retrieves the location of a special (system) folder.
' Returns NOERROR if successful or an OLE-defined error result otherwise.
 Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" _
                               (ByVal hwndOwner As Long, _
                               ByVal nFolder As SHSpecialFolderIDs, _
                               pidl As Long) As Long

' Special folder values for SHGetSpecialFolderLocation and
' SHGetSpecialFolderPath (Shell32.dll v4.71)
 Public Enum SHSpecialFolderIDs
   CSIDL_DESKTOP = &H0
   CSIDL_INTERNET = &H1
   CSIDL_PROGRAMS = &H2
   CSIDL_CONTROLS = &H3
   CSIDL_PRINTERS = &H4
   CSIDL_PERSONAL = &H5
   CSIDL_FAVORITES = &H6
   CSIDL_STARTUP = &H7
   CSIDL_RECENT = &H8
   CSIDL_SENDTO = &H9
   CSIDL_BITBUCKET = &HA
   CSIDL_STARTMENU = &HB
   CSIDL_DESKTOPDIRECTORY = &H10
   CSIDL_DRIVES = &H11
   CSIDL_NETWORK = &H12
   CSIDL_NETHOOD = &H13
   CSIDL_FONTS = &H14
   CSIDL_TEMPLATES = &H15
   CSIDL_COMMON_STARTMENU = &H16
   CSIDL_COMMON_PROGRAMS = &H17
   CSIDL_COMMON_STARTUP = &H18
   CSIDL_COMMON_DESKTOPDIRECTORY = &H19
   CSIDL_APPDATA = &H1A
   CSIDL_PRINTHOOD = &H1B
   CSIDL_ALTSTARTUP = &H1D                      ' ' DBCS
   CSIDL_COMMON_ALTSTARTUP = &H1E    ' ' DBCS
   CSIDL_COMMON_FAVORITES = &H1F
   CSIDL_INTERNET_CACHE = &H20
   CSIDL_COOKIES = &H21
   CSIDL_HISTORY = &H22
End Enum
' ====================================================================
' SHGetSpecialFolderLocation

' Retrieves information about an object in the file system, such as a file,
' a folder, a directory, or a drive root.
Public Type SHFILEINFOBYTE   ' sfib
  hIcon As Long
  iIcon As Long
  dwAttributes As Long
  szDisplayName(1 To MAX_PATH) As Byte
  szTypeName(1 To 80) As Byte
End Type
Enum SHGFI_flags
  SHGFI_LARGEICON = &H0             ' sfi.hIcon is large icon
  SHGFI_SMALLICON = &H1             ' sfi.hIcon is small icon
  SHGFI_OPENICON = &H2               ' sfi.hIcon is open icon
  SHGFI_SHELLICONSIZE = &H4      ' sfi.hIcon is shell size (not system size), rtns BOOL
  SHGFI_PIDL = &H8                          ' pszPath is pidl, rtns BOOL
  SHGFI_USEFILEATTRIBUTES = &H10   ' pretent pszPath exists, rtns BOOL
  SHGFI_ICON = &H100                     ' fills sfi.hIcon, rtns BOOL, use DestroyIcon
  SHGFI_DISPLAYNAME = &H200     ' isf.szDisplayName is filled, rtns BOOL
  SHGFI_TYPENAME = &H400           ' isf.szTypeName is filled, rtns BOOL
  SHGFI_ATTRIBUTES = &H800         ' rtns IShellFolder::GetAttributesOf  SFGAO_* flags
  SHGFI_ICONLOCATION = &H1000   ' fills sfi.szDisplayName with filename
                                                             ' containing the icon, rtns BOOL
  SHGFI_EXETYPE = &H2000              ' rtns two ASCII chars of exe type
  SHGFI_SYSICONINDEX = &H4000   ' sfi.iIcon is sys il icon index, rtns hImagelist
  SHGFI_LINKOVERLAY = &H8000     ' add shortcut overlay to sfi.hIcon
  SHGFI_SELECTED = &H10000         ' sfi.hIcon is selected icon
End Enum
Declare Function SHGetFileInfo Lib "shell32" Alias "SHGetFileInfoA" _
                              (ByVal pidl As Any, _
                              ByVal dwFileAttributes As Long, _
                              psfib As SHFILEINFOBYTE, _
                              ByVal cbFileInfo As Long, _
                              ByVal uFlags As SHGFI_flags) As Long

' If pidl is invalid, SHGetFileInfo can very easily blow up when filling the
' szDisplayName and szTypeName string members of the SHFILEINFO'
' struct, so we'll define these members as Byte.

' Frees memory allocated by the shell (pidls)
Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal pv As Long)
Sub Main()
Dim CommandString As String
If Command = "" Then
    MsgBox "No Folder path in the command string, the custom folder cannot be shown", vbCritical, "Folder Manager"
    'CommandString = InputBox("Enter Folder name", "Folder Manager")
    'If CommandString = "" Then End
    End
Else
    'CommandString = InputBox("Call to ChangeFolderIcon with ", "Enter Folder Name", Command)
    CommandString = Command
    'If CommandString = "" Then End
End If
ChangeFolderIcon CommandString
DoEvents
End
End Sub




 Public Function GetPIDLFromFolderID(hOwner As Long, _
                                                             nFolder As SHSpecialFolderIDs) As Long

   Dim pidl As Long
   If SHGetSpecialFolderLocation(hOwner, nFolder, pidl) = NOERROR Then
     GetPIDLFromFolderID = pidl
   End If
 End Function
Function PidlFromPath(sPath As String) As Long
    Dim pidl As Long, f As Long, PathStr As String
    PathStr = sPath
    '   remove trailing backslash
    Do While Right(PathStr, 1) = "\"
        PathStr = Left$(PathStr, Len(PathStr) - 1)
    Loop
    f = SHSimpleIDListFromPath(PathStr)

    If f > 0 Then PidlFromPath = f
End Function
Function PidlFromSpecialFolder( _
                Optional ByVal csidl As SHSpecialFolderIDs = CSIDL_DESKTOP, _
                Optional ByVal hWnd As Long = 0) As Long
    On Error Resume Next
    Dim pidl As Long
   
    SHGetSpecialFolderLocation hWnd, csidl, pidl
    If Err = 0 Then PidlFromSpecialFolder = pidl
End Function



Sub ChangeFolderIcon(ShowFolder As String)
'   Shows the new icon instead of pressing F5
'Dim ps As PIDLSTRUCT
'MsgBox "The system will now re-set the icon for " & vbcrlf & ShowFolder & vbcrlf & "which you have just categorised", vbInformation, SystemTitle$
Dim Finfo As Long, dwFileAttributes As Long, psfib As SHFILEINFOBYTE
Dim cbFileInfo As Long, uFlags As SHGFI_flags, FolderPidl As Long, FPathStr As String
'   ********************************************************************
'   ********************************************************************
'get pidl for desktop folder
Dim DeskTopPidl As Long
DeskTopPidl = PidlFromSpecialFolder
' Get the pidl for the folder.
FPathStr = ShowFolder
'remove trailing backslashes
Do While Right(FPathStr, 1) = "\"
    FPathStr = Left(FPathStr, Len(FPathStr) - 1)
Loop
FolderPidl = PidlFromPath(FPathStr)
'   get the info for this folder
  'SHGetFileInfo(pszPath, 0, SFI, SizeOf(SFI), SHGFI_SYSICONINDEX);

'uFlags = SHGFI_ICONLOCATION
uFlags = SHGFI_SYSICONINDEX
Finfo = SHGetFileInfo(FPathStr, dwFileAttributes, psfib, cbFileInfo, uFlags)
SHChangeNotify SHCNE_ATTRIBUTES, SHCNF_PATH Or SHCNF_FLUSH, FolderPidl, 0
SHChangeNotify SHCNE_UPDATEIMAGE, SHCNF_DWORD, psfib.iIcon, 0
SHChangeNotify SHCNE_ASSOCCHANGED, SHCNF_IDLIST, 0, 0
Call CoTaskMemFree(DeskTopPidl)
Call CoTaskMemFree(FolderPidl)
'DoEvents
End Sub
       
0

Featured Post

Highfive + Dolby Voice = No More Audio Complaints!

Poor audio quality is one of the top reasons people don’t use video conferencing. Get the crispest, clearest audio powered by Dolby Voice in every meeting. Highfive and Dolby Voice deliver the best video conferencing and audio experience for every meeting and every room.

Join & Write a Comment

There are many ways to remove duplicate entries in an SQL or Access database. Most make you temporarily insert an ID field, make a temp table and copy data back and forth, and/or are slow. Here is an easy way in VB6 using ADO to remove duplicate row…
Since upgrading to Office 2013 or higher installing the Smart Indenter addin will fail. This article will explain how to install it so it will work regardless of the Office version installed.
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…

747 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

14 Experts available now in Live!

Get 1:1 Help Now