选择目录框的疑惑

Question

一个关于选择目录框的问题
我想在打开此框的时候
可以设置任意一个目录作为默认选择的节点
即它不是选择“我的电脑”而是比如c:\windows\system的一个目录call fl.ChooseFolder(Me.hwnd, "请选择一个作为数据存放的目录:", fbfDrives, fbcFolders)
'--------------------------------------------------------
Public Enum EnumRootFolder
    fbfDeskTop = &H0
    fbfPrograms = &H2
    fbfControls = &H3
    fbfPrinters = &H4
    fbfPersonal = &H5
    fbfFavorites = &H6
    fbfStartup = &H7
    fbfRecent = &H8
    fbfSendTo = &H9
    fbfBitbucket = &HA
    fbfStartMenu = &HB
    fbfDesktopDirectory = 16
    fbfDrives = &H11
    fbfNetWork = &H12
    fbfNetHood = &H13
    fbfFonts = &H14
    fbfTemplates = &H15
End EnumPublic Enum EnumChoose
    fbcFolders = &H1
    fbcComputers = &H1000
    fbcPrinters = &H2000
    fbcEverything = &H4000
End EnumPublic Function ChooseFolder(hWnd As Long, Message As String, RootFolder As EnumRootFolder, ChooseWho As EnumChoose) As String
'选择目录对话框
    On Error GoTo er
    Dim Nullpos As Integer
    Dim lpIDList As Long
    Dim res As Long
    Dim sPath As String
    Dim Binfo As BrowseInfo
    Dim RootID As Long
    Binfo.hWndOwner = hWnd
    Binfo.lpszTitle = lstrcat(Message, "")
    Binfo.ulFlags = ChooseWho
    Binfo.pIDLRoot = RootFolder
    If RootID <> 0 Then Binfo.pIDLRoot = RootID
    lpIDList = SHBrowseForFolder(Binfo)
    If lpIDList <> 0 Then
        sPath = String(260, Chr(0))
        res = SHGetPathFromIDList(lpIDList, sPath)
        Nullpos = InStr(sPath, vbNullChar)
        If Nullpos <> 0 Then
            sPath = Left(sPath, Nullpos - 1)
            ChooseFolder = sPath
        End If
    End If
    Exit Function
er:
    ChooseFolder = ""
End Function

Answer 1

Dim Binfo As BrowseInfo
－－－－－－－－－－－－－－－－－－－－－－－
用户类型未定义
为什么不用CommonDialog????两句就可以了。CommonDialog1.InitDir = "C:\PWIN98\SYSTEM"
CommonDialog1.ShowSave

Answer 2

那就用控件Drive和Dir,一定能达到要求,在工具箱里,最基本的几个控件,为什么不试试!

Answer 3

用以上的API函数不能指定一个目录吗
但我发现有些软件就能达到

Answer 4

没看过你的代码。　　：）
将下列代码复制在一个标准模块中，在程序中调用即可。Option ExplicitPrivate Const BIF_STATUSTEXT = &H4&
Private Const BIF_RETURNONLYFSDIRS = 1
Private Const BIF_DONTGOBELOWDOMAIN = 2
Private Const MAX_PATH = 260Private Const WM_USER = &H400
Private Const BFFM_INITIALIZED = 1
Private Const BFFM_SELCHANGED = 2
Private Const BFFM_SETSTATUSTEXT = (WM_USER + 100)
Private Const BFFM_SETSELECTION = (WM_USER + 102)Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, _
                                     ByVal wParam As Long, ByVal lParam As String) As Long
Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, _
                                     ByVal lpBuffer As String) As LongPrivate Type BrowseInfo
  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 TypePrivate m_CurrentDirectory As String'====================== 选择目录的函数 ========================================================================
'Owner ----------- 调用该函数的窗体
'Title ----------- 显示在目录选择对话框上的标题 (可选)
'StarDir --------- 默认打开的目录 (可选)
Public Function BrowseForFolder(Owner As Form, Optional Title As String, Optional StartDir As String) As String  Dim lpIDList As Long
  Dim szTitle As String
  Dim sBuffer As String
  Dim tBrowseInfo As BrowseInfo
  m_CurrentDirectory = StartDir & vbNullChar  szTitle = Title
  With tBrowseInfo
    .hWndOwner = Owner.hWnd
    .pIDLRoot = 0
    .lpszTitle = IIf(Title <> "", Title, "路径选择：")
    .ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN + BIF_STATUSTEXT
    If StartDir <> "" Then
    .lpfnCallback = GetAddressofFunction(AddressOf BrowseCallbackProc)
    End If
  End With  lpIDList = SHBrowseForFolder(tBrowseInfo)
  If (lpIDList) Then
    sBuffer = Space(MAX_PATH)
    SHGetPathFromIDList lpIDList, sBuffer
    sBuffer = Left(sBuffer, InStr(sBuffer, vbNullChar) - 1)
    BrowseForFolder = sBuffer
  Else
    BrowseForFolder = ""
  End If
  
End Function
 
Private Function BrowseCallbackProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal lp As Long, ByVal pData As Long) As Long
  
  Dim lpIDList As Long
  Dim ret As Long
  Dim sBuffer As String
  
  On Error Resume Next
  
  Select Case uMsg
  
    Case BFFM_INITIALIZED
      Call SendMessage(hWnd, BFFM_SETSELECTION, 1, m_CurrentDirectory)
      
    Case BFFM_SELCHANGED
      sBuffer = Space(MAX_PATH)
      
      ret = SHGetPathFromIDList(lp, sBuffer)
      If ret = 1 Then
        Call SendMessage(hWnd, BFFM_SETSTATUSTEXT, 0, sBuffer)
      End If
      
  End Select
  
  BrowseCallbackProc = 0
  
End FunctionPrivate Function GetAddressofFunction(add As Long) As Long
  GetAddressofFunction = add
End Function