Presenting a List of Directories to a User using the Windows Shell Browse for

tmtony

标题resenting a List of Directories to a User using the Windows Shell Browse for Folder Dialog

原作者:ATTAC Consulting Group

You can provide Users with a simple Directory dialog rather than using the standard File Open or File Save As dialogs from the common dialog suite which shows both files and directories. To do this you use the Directory dialog built into the Shell OLE container. Here's the code to do it:

In the declarations page of a module, add the following declares (an "_" means line continuation): Type shellBrowseInfo

    hWndOwner      As Long

    pIDLRoot       As Long

    pszDisplayName As Long

    lpszTitle      As String

    ulFlags        As Long

    lpfnCallback   As Long

    lParam         As Long

    iImage         As Long

End Type



Const BIF_RETURNONLYFSDIRS = 1

Const MAX_PATH = 260



Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long)

Declare Function SHBrowseForFolder Lib "shell32" (lpbi As shellBrowseInfo) As Long

Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, _

         ByVal lpBuffer As String) As Long



Then use the following function, supplying it the title you want to use for the dialog, and the handle of the calling form. (use the Me.hwnd property of the form): Public Function GetFolder(dlgTitle As String, Frmhwnd as Long) As String



    Dim intNullChr As Integer

    Dim lngIDList As Long

    Dim lngResult As Long

    Dim strFolder As String

    Dim BI As shellBrowseInfo



    With BI

        .hWndOwner = Frmhwnd

        .lpszTitle = dlgTitle

        .ulFlags = BIF_RETURNONLYFSDIRS

    End With



    lngIDList = SHBrowseForFolder(BI)

    If lngIDList Then

        strFolder = String$(MAX_PATH, 0)

        lngResult = SHGetPathFromIDList(lngIDList, strFolder)

        Call CoTaskMemFree(lngIDList)        'this frees the ole pointer to lngIDlist

        intNullchr = InStr(strFolder, vbNullChar)

        If intNullchr Then

            strFolder = Left$(strFolder, intNullChr - 1)

        End If

    End If



    GetFolder = strFolder



End FunctionThis function will return the path to the folder selected, so long as it is not a system folder such as the printers folder.

爱情插班生

标题:当用户仅需使用到外部文件夹时，我们可以引用系统窗口浏览器显示一列文件夹目录对话框。

原作者:ATTAC咨询组织您可以提供使用者以一个简单的目录对话框，代替使用显示文件和录目的公用对话框组中标准的文件打开、保存对话框。要实现这像样的功能，你可以将这个目录对话框嵌入到shell OLE集中。 所需的代码如下:在模块声明页中, 增加以下声明（“_”表示续行。）





Type shellBrowseInfo

                                hWndOwner                                                As Long

                                pIDLRoot                                                 As Long

                                pszDisplayName As Long

                                lpszTitle                                                As String

                                ulFlags                                                                As Long

                                lpfnCallback                 As Long

                                lParam                                                                 As Long

                                iImage                                                                 As Long

End Type



Const BIF_RETURNONLYFSDIRS = 1

Const MAX_PATH = 260



Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long)

Declare Function SHBrowseForFolder Lib "shell32" (lpbi As shellBrowseInfo) As Long

Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, _

                                                                 ByVal lpBuffer As String) As Long然后使用以下的过程，以提供这个对话框的标题和调用窗体的句柄。（在窗体属性中使用me.hwnd语句）：

Public Function GetFolder(dlgTitle As String, Frmhwnd as Long) As String

                                Dim intNullChr As Integer

                                Dim lngIDList As Long

                                Dim lngResult As Long

                                Dim strFolder As String

                                Dim BI As shellBrowseInfo



                                With BI

                                                                .hWndOwner = Frmhwnd

                                                                .lpszTitle = dlgTitle

                                                                .ulFlags = BIF_RETURNONLYFSDIRS

                                End With



                                lngIDList = SHBrowseForFolder(BI)

                                If lngIDList Then

                                                                strFolder = String$(MAX_PATH, 0)

                                                                lngResult = SHGetPathFromIDList(lngIDList, strFolder)

                                                                Call CoTaskMemFree(lngIDList)                                                                'this frees the ole pointer to lngIDlist

                                                                intNullchr = InStr(strFolder, vbNullChar)

                                                                If intNullchr Then

                                                                                                strFolder = Left$(strFolder, intNullChr - 1)

                                                                End If

                                End If



                                GetFolder = strFolder



End Function这个过程就会返回一个你所选择的路径，只要不是系统路径，如：打印机目录。

[em01][em01][em01][em01]

[此贴子已经被作者于2005-8-18 14:13:37编辑过]