闻新而动

不用控件如何调用系统的树型路径对话框
A :       
       
不用控件  调用系统的树型路径对话框（像flashget那种） 

---------------------------------------------------------------  


在窗体中添加 

一个command(command1) 

一个textbox(text1) 

直接把代码拷贝到窗体代码中就好了^_^ 

---------------------------------------- 

Option  Explicit 

 

Private  Type  BROWSEINFO 

        hOwner  As  Long 

        pidlRoot  As  Long 

        pszDisplayName  As  String 

        lpszTitle  As  String 

        ulFlags  As  Long 

        lpfn  As  Long 

        lParam  As  Long 

        iImage  As  Long 

End  Type 

 

Const  BIF_RETURNONLYFSDIRS  =  &H1 

 

Private  pidl  As  Long 

 

Private  Declare  Function  SHGetPathFromIDList  Lib  "shell32.dll"  Alias  "SHGetPathFromIDListA"  (ByVal  pidl  As  Long,  ByVal  pszPath  As  String)  As  Long 

 

Private  Declare  Function  SHBrowseForFolder  Lib  "shell32.dll"  Alias  "SHBrowseForFolderA"  (lpBrowseInfo  As  BROWSEINFO)  As  Long 

 

Private  Sub  Command1_Click() 

Dim  bi  As  BROWSEINFO 

Dim  r  As  Long 

Dim  pidl  As  Long 

Dim  path  As  String 

Dim  pos  As  Integer 

'句柄 

bi.hOwner  =  Me.hWnd 

'展开根目录 

bi.pidlRoot  =  0& 

'列表框标题 

bi.lpszTitle  =  "请选择源文件夹路径：" 

'规定只能选择文件夹，其他无效 

bi.ulFlags  =  BIF_RETURNONLYFSDIRS 

'调用API函数显示列表框 

pidl  =  SHBrowseForFolder(bi) 

'利用API函数获取返回的路径 

path  =  Space$(512) 

r  =  SHGetPathFromIDList(ByVal  pidl&,  ByVal  path) 

 

If  r  Then 

        pos  =  InStr(path,  Chr$(0)) 

        Text1.Text  =  Left(path,  pos  -  1) 

Else 

        Text1.Text  =  "" 

End  If 

End  Sub