有什么控件和文件管理器的文件夹部分一样呀？

[kiko_l]

我只想要选择文件夹，不选择文件

[rainstormmaster]

在类中封装目录选择对话框

你是否在纳闷,在VB公用对话框中怎么没有目录选择对话框呢,事实上在API查看器中也未声明这个API.本例用到的两个API如下

SHBrowseForFolder

用于浏览文件夹、打印机和网络

SHGetPathFromIDList

用于将项标识符列表转换为文件系统路径

有了这两个API函数,你就可以构造一个目录选择对话框类以代替VB中的目录控件.类clsGetPath的完整代码如下:

Option Explicit
'API声明部分
Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
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

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

Private Const BIF_RETURNONLYFSDIRS = 0
Private Const BIF_DONTGOBELOWDOMAIN = 1
Private Const BIF_STATUSTEXT = 2
Private Const BIF_RETURNFSANCESTORS = 3
Private Const BIF_BROWSEFORCOMPUTER = 4
Private Const BIF_BROWSEFORPRINTER = 5

'变量声明
Private mvarCaption As String
Private mvarhWnd As Long
Private mvarFlags As Integer
Private mvarFolder As Variant

'类的属性
Public Property Let Folder(ByVal vData As Variant)
mvarFolder = vData
End Property

Public Property Set Folder(ByVal vData As Variant)
Set mvarFolder = vData
End Property

Public Property Get Folder() As Variant
If IsObject(mvarFolder) Then
Set Folder = mvarFolder
Else
Folder = mvarFolder
End If
End Property

Public Property Let Flags(ByVal vData As Integer)
mvarFlags = vData
End Property

Public Property Get Flags() As Integer
Flags = mvarFlags
End Property

Public Property Let hwnd(ByVal vData As Long)
mvarhWnd = vData
End Property

Public Property Get hwnd() As Long
hwnd = mvarhWnd
End Property

Public Property Let Caption(ByVal vData As String)
mvarCaption = vData
End Property

Public Property Get Caption() As String
Caption = mvarCaption
End Property

'类的方法
Public Sub GetFolder()
Dim bi As BROWSEINFO
Dim pidl As Long
Dim ret As String

ret = String$(255, Chr$(0))

With bi
.hOwner = hwnd
.ulFlags = Flags
If Caption <> "" Then
.lpszTitle = Caption & Chr$(0)
Else
.lpszTitle = "Select a Folder..." & Chr$(0)
End If
End With

pidl = SHBrowseForFolder(bi)

If SHGetPathFromIDList(ByVal pidl, ByVal ret) Then
Folder = Left$(ret, InStr(ret, Chr$(0)) - 1)
Else
Folder = ""
End If
End Sub

在程序中使用类的代码:

Private Sub cmdBrowse_Click()
Dim c As clsGetPath '声明对象变量
Set c = New clsGetPath
With c
.Caption = "请选择一个文件夹"
.Flags = 0
.hwnd = Me.hwnd
End With
c.GetFolder
txtPath.Text = c.Folder
End Sub

[ybcaa]

学习，学习

[jshyjyw]

学习啊。

[hxy1982]

up!!