www.pudn.com > MapX5Demo.rar > clsDirBrowser.cls, change:2002-09-22,size:1771b


VERSION 1.0 CLASS 
BEGIN 
  MultiUse = -1  'True 
  Persistable = 0  'NotPersistable 
  DataBindingBehavior = 0  'vbNone 
  DataSourceBehavior  = 0  'vbNone 
  MTSTransactionMode  = 0  'NotAnMTSObject 
END 
Attribute VB_Name = "clsDirBrowser" 
Attribute VB_GlobalNameSpace = False 
Attribute VB_Creatable = True 
Attribute VB_PredeclaredId = False 
Attribute VB_Exposed = False 
 
'使用 WIN95 的选择目录对话框 
'声明: 
Private Type BrowseInfo 
  hWndOwner As Long 
  pIDLRoot As Long 
  pszDisplayName As Long 
  lpszTitle As Long 
  ulFlags As Long 
  lpfnCallback As Long 
  lParam As Long 
  iImage As Long 
End Type 
 
Private Const BIF_RETURNONLYFSDIRS = 1 
Private Const MAX_PATH = 260 
 
Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long) 
Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 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 Long 
 
'函数: 
Public Function BrowseForFolder(hWndOwner As Long, sPrompt As String) As String 
Dim iNull As Integer 
Dim lpIDList As Long 
Dim lResult As Long 
Dim sPath As String 
Dim udtBI As BrowseInfo 
  With udtBI 
    .hWndOwner = hWndOwner 
    .lpszTitle = lstrcat(sPrompt, "") 
    .ulFlags = BIF_RETURNONLYFSDIRS 
  End With 
  lpIDList = SHBrowseForFolder(udtBI) 
  If lpIDList Then 
    sPath = String$(MAX_PATH, 0) 
    lResult = SHGetPathFromIDList(lpIDList, sPath) 
    Call CoTaskMemFree(lpIDList) 
    iNull = InStr(sPath, vbNullChar) 
    If iNull Then 
      sPath = Left$(sPath, iNull - 1) 
    End If 
  End If 
  BrowseForFolder = sPath 
End Function