« 前一篇:爱一个人的感觉
后一篇:升级hotmail »

选择文件夹对话框 @ 3/7/2005

学习类
Visual Studio .NET 中新增了FolderBrowserDialog 组件,但是在VB6.0中还是只能用API来实现打开文件夹了:

以下代码来自http://www.vbaspnew.com/ziyuan/w/api/21.txt,略有改动。

Option Explicit

Private Type BROWSEINFO
  hOwner          As Long    ' 当前窗口的句柄。
  pidlRoot        As Long      ' 从何根路径开始展开文件夹,缺省情况下从“桌面”开始展开。
  pszDisplayName  As String
  lpszTitle        As String      ' 目录树上方的标题,用来给用户一些提示信息。
  ulFlags          As Long        ' 显示标志控制项:比如若赋值为BIF_BROWSEFORCOMPUTER,则只有当用户选择“我的电脑”时“确定”按钮才有效,这里我们需要的是 BIF_RETURNONLYFSDIRS,只有用户选择的是文件夹时“确定”按钮才有效。
  lpfn            As Long
  lParam          As Long
  iImage          As Long
End Type

Const BIF_RETURNONLYFSDIRS = &H1

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
' 此函数返回值是指向项目(ITEM)的一个指针,有了这个数值,再用API函数SHGetPathFromIDList可以获得具体的路径,如果用户按的是“取消”按钮,则返回值为NULL。

Private Sub Form_Load()
  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))
        Me.Caption = Left(path, pos - 1)
  Else: Me.Caption = "C:\"
  End If
End Sub
发布于 3/7/2005 22:07:19 | 评论:0

看帖要回帖...

categories
archives
links
statistics
  • 网志数:1168
  • 评论数:2011