[vb6] Unicode Browse For Folder

[LaVolpe]

Attention. This project is no longer being updated. I've included this dialog in my CmdDialogEx class which already had the standard Open/Save file dialogs. Any improvements to this code will be found in that other project.

This is a unicode-compatible "Browse For Folder" dialog implementation. It offers options to customize the dialog beyond simple examples you may have seen. I have moved this to its own thread from the Unicode File Open/Save Dialog thread. It was becoming a bit confusing whether posts were talking about that solution or this solution.

Before I go too far into this, let me link an example from dilettante where CreateObject can be used. If you don't need any special customization, that is a fine solution and very simple to code.

The attached class has lots of methods/properties and nearly all of them are well-commented within the class. Therefore, not going to list them in this thread with few exceptions:

SelectedFolder contains a path/filename and/or PIDL of the item selected by the user.
InitialDirectory will attempt to select that as the folder first displayed/selected by the dialog
PathToPIDL is a convenience function to convert a path to a PIDL
PIDLtoPath is a convenience function to convert a PIDL to a path, if possible
ShowBrowseForFolder is the function that activates the dialog

BrowseForFolderMsgEnum lists common messages that can be sent to dialog via SendMessage
BrowseForFolderCallBackEnum lists common messages received in the dialog callback procedure
BrowseForFolderDialogFlagsEnum lists all the available flags the dialog may support (version limited)

Sample call might look like this:

Dim cb As UnicodeBrowseFolders
Set cb = New UnicodeBrowseFolders
With cb
    .DialogTitle = "Select Folder To Save Report"
    .Flags = BIF_RETURNONLYFSDIRS Or BIF_NEWDIALOGSTYLE
    .InitialDirectory = "C:\blah\blah\blah\Reports"
End With
If cb.ShowBrowseForFolder(Me.hWnd) = True Then
    ' do what you need with the selection
    ' cb.SelectedFolder() returns selected path if a non-virtual path selected
    ' cb.SelectedFolder(True) returns a PIDL whether virtual path selected or not
End If

A note about selecting 2 or more of the Flags property values. OR them together DO NOT add them together. The following returns different results:

(BIF_DONTGOBELOWDOMAIN Or BIF_USENEWUI Or BIF_NEWDIALOGSTYLE) = 82
(BIF_DONTGOBELOWDOMAIN + BIF_USENEWUI + BIF_NEWDIALOGSTYLE) = 146 << wrong

Here's an example of asking for events. The class can self-hook the dialog and send events that it receives to your form if you choose. There are three events that can be sent:
1) Initialized. The dialog's hWnd is provided. You are kinda unlimited to what you can do in this event.
2) SelectionChanged. Event sent whenever the dialog folder selection changes
3) CallBackMsg. Catch-all of other events forwarded from the dialog

Just one note. WantEvents property is ignored if you set the CustomHookProc property which means you are hooking the dialog and the class will not.

 ' you must declare the dialog using: WithEvents
Private WithEvents FolderBrowser As UnicodeBrowseFolders

' setup your dialog
Private Sub ShowBrowser()
    Set FolderBrowser = New UnicodeBrowseFolders
    With FolderBrowser
        .WantEvents = True
        ... set other properties
    End With
    If FolderBrowser.ShowBrowseForFolder(Me.hWnd) = True Then
        ' handle selected folder
    End If
End Sub


' respond/review events, i.e., 
Private Sub FolderBrowser_CallBackMsg(ByVal hWnd As Long, ByVal Message As Long, ByVal lParam As Long, ByVal UserParam As Long, CloseDialog As Boolean)

End Sub

Private Sub FolderBrowser_Initialized(ByVal hWnd As Long, ByVal UserParam As Long)

End Sub

Private Sub FolderBrowser_SelectionChanged(ByVal hWnd As Long, ByVal pPIDL As Long, ByVal UserParam As Long)

End Sub

[LaVolpe]

Here is how you can further customize the dialog. It is only limited by your subclassing skills and imagination:

Strongly recommended that you set your own hook procedure for the dialog. Not recommended that you activate subclassing from within any events that could otherwise be forwarded via the class WantEvents property.

1. Add an Implementation class to your project. This allows you to have the subclass messages sent to any form, usercontrol, class

 ' Name this class: IBrowserSubclasser
Option Explicit

Public Function WindowProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long, _
                            ByVal uIdSubclass As Long, ByVal dwRefData As Long, _
                            bHandled As Boolean) As Long
    ' dialog subclass messages
    ' bHandled set to True if function return value must be used else forward to default window procedure
End Function

Public Sub CallbackProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long) 
    ' dialog callback messages
End Sub

2. Add a bas module to your project to support subclassing.

Option Explicit

Private Declare Function DefSubclassProc Lib "comctl32.dll" (ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function SetWindowSubclass Lib "comctl32.dll" (ByVal hWnd As Long, ByVal pfnSubclass As Long, ByVal uIdSubclass As Long, ByVal dwRefData As Long) As Long
Private Declare Function RemoveWindowSubclass Lib "comctl32.dll" (ByVal hWnd As Long, ByVal pfnSubclass As Long, ByVal uIdSubclass As Long) As Long
Private Declare Function SendMessageW Lib "user32.dll" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal length As Long)

Public m_BrowserInitFolder As String    ' set this before showing the dialog

Public Function GetBrowserCallBack() As Long
    ' assign this to dialog's CustomHookProc property
    GetBrowserCallBack = pvAddressOf(AddressOf pvBrowseCallbackProc)
End Function

Private Function pvAddressOf(inAddress As Long) As Long ' helper function
    pvAddressOf = inAddress
End Function

Private Sub pvUnsubclassBrowser(hWnd As Long, uIdSubclass As Long) ' helper function
    RemoveWindowSubclass hWnd, AddressOf pvBrowseCallbackProc, uIdSubclass
End Sub

Private Function ObjFromPointer(lParam As Long) As IBrowserSubclasser ' helper function
    Dim o As Object
    CopyMemory o, lParam, 4&
    Set ObjFromPointer = o
    CopyMemory o, 0&, 4&
End Function

Private Function pvBrowseCallbackProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal lp As Long, ByVal lpData As Long) As Long
    Static bInitSel As Boolean
    Select Case uMsg
       Case BFFM_INITIALIZED
            ' http://msdn.microsoft.com/en-us/library/aa452875.aspx
            ' the 3rd parameter of SendMessageW is either zero or non-zero
            '   zero :: 4th param is a PIDL
            '   non-zero :: 4th param is yourDesiredInitialDirectoryPath string
            
            ' you can set your initial folder now...
            If m_BrowserInitFolder = vbNullString Then
                bInitSel = False
            Else
                bInitSel = True
                SendMessageW hWnd, BFFM_SETSELECTIONW, 1&, ByVal StrPtr(m_BrowserInitFolder)
            End If
            
            ' you can set the titlebar with SetWindowText API
            
            ' you can subclass the dialog if you want.
            ' lpData is set as dialog's CustomHookData property like so:
            '   -------------------------------------
            '   :: in form's declaration section that shows the dialog...
            '   Implements IBrowserSubclasser
            '   :: set's dialog property before showing dialog
            '       .CustomHookData = ObjPtr(Me)
            '   :: of course, form needs to review messages sent to it
            If lpData <> 0& Then
                SetWindowSubclass hWnd, AddressOf pvWndProc, lpData, 0&
                ObjFromPointer(lpData).CallbackProc hWnd, uMsg, lp
            End If

        Case BFFM_SELCHANGED
            If bInitSel Then ' tweak to ensure selected item is visible in tree (call selection twice)
                bInitSel = False
                SendMessageW hWnd, BFFM_SETSELECTIONW, 1&, ByVal StrPtr(m_BrowserInitFolder)
            End If
            ' user selected a new folder/path
            ' can set the status text with SendMessageW if desired
            If lpData <> 0& Then ObjFromPointer(lpData).CallbackProc hWnd, uMsg, lp
            
        Case BFFM_VALIDATEFAILED, BFFM_VALIDATEFAILED + 1&
            ' you asked for edit box validation when setting the flags
            ' user typed invalid path in edit control, return 0 to close dialog else return non-zero
            If lpData <> 0& Then ObjFromPointer(lpData).CallbackProc hWnd, uMsg, lp
        
        Case BFFM_IUNKNOWN
            If lpData <> 0& Then ObjFromPointer(lpData).CallbackProc hWnd, uMsg, lp
            
   End Select
   
End Function

Private Function pvWndProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long, _
                            ByVal uIdSubclass As Long, ByVal dwRefData As Long) As Long
    ' subclass procedure
    Select Case uMsg
    Case 2&             ' WM_DESTROY, self unsubclass
        pvUnsubclassBrowser hWnd, uIdSubclass
        pvWndProc = DefSubclassProc(hWnd, uMsg, wParam, lParam)
        
    Case Else
        Dim bHandled As Boolean
        pvWndProc = ObjFromPointer(uIdSubclass).WindowProc(hWnd, uMsg, wParam, lParam, _
                                                            uIdSubclass, dwRefData, bHandled)
        If bHandled = False Then pvWndProc = DefSubclassProc(hWnd, uMsg, wParam, lParam)
            
    End Select
    
End Function

3. Set up your form, usercontrol, class to recieve subclass messages and show the dialog

 ' in the declarations section
Implements IBrowserSubclasser

Private Sub pvShowBrowseForFolder()
    Dim f As UnicodeBrowseFolders
    Set f = New UnicodeBrowseFolders
    With f
        ' set the two hook-related properties
        .CustomHookProc = GetBrowserCallBack()
        .CustomHookData = ObjPtr(Me)
        ' if wanting to start at a specifc folder, set bas module's public variable
        m_BrowserInitFolder = "C:\Windows\System32"
        ' set other properties, especially the Flags property
    End With
    If f.ShowBrowseForFolder(Me.hWnd) = True Then
        MsgBox f.SelectedFolder
    End If
End Sub

Private Function IBrowserSubclasser_WindowProc(ByVal hWnd As Long, ByVal uMsg As Long, _
                    ByVal wParam As Long, ByVal lParam As Long, _
                    ByVal uIdSubclass As Long, ByVal dwRefData As Long, bHandled As Boolean) As Long
'    Debug.Print "message "; uMsg
End Function

Private Sub IBrowserSubclasser_CallbackProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long) 
    ' dialog callback messages
End Sub

[LaVolpe]

Brought to my attention was the fact that the optional InitialDirectory property, when set, would correctly select the desired folder but the dialog would not scroll to the item in its treeview. This appears to be a Microsoft logic flaw related to one or more Flags property settings. There are at least two solutions:

1) Locate the treeview during the dialog initialize event, then use SendMessage API for TVM_ENSUREVISIBLE.
2) Set the desired folder selection twice: once during initialize and again after it was registered and a selection-change event occurs.

Since solution #2 is far less code, it was chosen and reposted. If any issues are noted regarding this fix, I'll consider going with solution #1 above.

[IliaPreston]

Thanks a lot for all the help and advice, including the recent fixes.
I used this UnicodeBrowseFolders and I guess there is a little problem, but I am not sure.
I may be totally wrong, but I say it anyway. Please correct me if I am wrong:
I have a form named frmMain.
On it, I have a button. When the user clicks that button, a new form named Form1 pops up:

Private Sub cmdLoadForm1_Click()
   Load Form1
End Sub

Then on this new form I have an InkEdit textbox that is supposed to hold a folder path.
When the user double-clicks on that InkEdit, this UnicodeBrowseFolders pops up, so that the user can browse and select a folder.
This works fine.
However, this UnicodeBrowseFolders is modal only as far as Form1 is concerned. When this UnicodeBrowseFolders is on the screen the user cannot navigate to Form1 (until he selects a folder or clicks cancel) and that is the expected behaviour and is fine. The user should not be allowed to navigate to Form1 while UnicodeBrowseFolders is on the screen.
But, the user can easily use Alt+Tab to navigate to frmMain with no problem.
Shouldn't that kind of navigation be also blocked?
Shouldn't this UnicodeBrowseFolders be modal with regards to the entire application (the whole vbp project and all its forms)?
Currently UnicodeBrowseFolders is modal only with regards to Form1 not with regards to the whole application.
Please advise.
Regrads.
Ilia

[LaVolpe]

I see what you are talking about. The class simply wraps the SHBrowseForFolder API function. If the API won't prevent it, you can.

1) Form1.Show vbModal, frmMain. That prevents frmMain from being accessed while Form1 is displayed

2) Before you call the dialog: frmMain.Enabled = False. After the dialog closes: frmMain.Enabled = True

[Taro]

Hi, LaVolpe

Thank you very much for your update.

You are one of the greatest man in my world. Since I stuck with VB6, can't move to .Net. You always be here.