Конференция VBStreets

**coder** » 12.06.2003 (Чт) 10:41

Как с помощью API вызвать окно (стандартное, WINдовое, древовидное) для выбора папок ?

**boevik** » 12.06.2003 (Чт) 11:42

Вот кусок кода из ActiveX DLL который я изпользую:

Код: Выделить всё: Private Type BrowseInfo hwndOwner As Long pIDLRoot As Long pszDisplayName As String lpszTitle As String ulFlags As Long lpfnCallback As Long lParam As Long iImage As Long End Type Private Enum eBrowseFlag BIF_RETURNONLYFSDIRS = &H1 ' For finding a folder to start document searching BIF_DONTGOBELOWDOMAIN = &H2 ' For starting the Find Computer BIF_STATUSTEXT = &H4 BIF_RETURNFSANCESTORS = &H8 BIF_EDITBOX = &H10 BIF_VALIDATE = &H20 ' insist on valid result (or CANCEL) BIF_BROWSEFORCOMPUTER = &H1000 'Browsing for Computers. BIF_BROWSEFORPRINTER = &H2000 'Browsing for Printers BIF_BROWSEINCLUDEFILES = &H4000 'Browsing for Everything End Enum Private Enum eRootDirectory DESKTOP = &H0 INTERNET = &H1 PROGRAMS = &H2 Controls = &H3 Printers = &H4 PERSONAL = &H5 FAVORITES = &H6 STARTUP = &H7 RECENT = &H8 SENDTO = &H9 BITBUCKET = &HA STARTMENU = &HB DESKTOPDIRECTORY = &H10 DRIVES = &H11 NETWORK = &H12 NETHOOD = &H13 Fonts = &H14 TEMPLATES = &H15 COMMON_STARTMENU = &H16 COMMON_PROGRAMS = &H17 COMMON_STARTUP = &H18 COMMON_DESKTOPDIRECTORY = &H19 APPDATA = &H1A PRINTHOOD = &H1B ALTSTARTUP = &H1D ' DBCS COMMON_ALTSTARTUP = &H1E ' DBCS COMMON_FAVORITES = &H1F INTERNET_CACHE = &H20 COOKIES = &H21 HISTORY = &H22 End Enum Const MAX_PATH = 260 ' message from browser Const BFFM_INITIALIZED = 1 Const BFFM_SELCHANGED = 2 Const BFFM_VALIDATEFAILEDA = 3 'lParam:szPath ret:1(cont),0(EndDialog) ' messages to browser Const WM_USER = &H400 Const BFFM_SETSTATUSTEXTA = (WM_USER + 100) Const BFFM_ENABLEOK = (WM_USER + 101) Const BFFM_SETSELECTIONA = (WM_USER + 102) Const BFFM_SETSELECTIONW = (WM_USER + 103) Const BFFM_SETSTATUSTEXTW = (WM_USER + 104) 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 'call dialog box "Browse for Folder" 'Parameter: hwndOwner - [in] handle of owner window (0 - modales mode, other - modal mode) ' sPrompt - [in] user defined string ' RootDirectory - [in] root directory from which to start browsing ' InitDir - [in] initialization directory ' Flags - [in] Flags specifying the options for the dialog box ' Path - [out] Selected path (full path of folder or file) ' DisplayName - [out] Selected display name 'Return: True - user chooses the OK button in the dialog box ' False - User chooses the Cancel button in the dialog box Public Function BrowseForFolderEx(ByVal hwndOwner As Long, _ ByVal sPrompt As String, _ ByVal RootDirectory As Long, _ ByVal InitDir As String, _ ByVal Flags As Long, _ ByRef Path As String, _ ByRef DisplayName As String) As Boolean On Error GoTo ERROR_BrowseForFolder Dim lngIdList As Long Dim udtBI As BrowseInfo Dim strPath As String BrowseForFolderEx = False mvarInitDir = InitDir 'initialization With udtBI .hwndOwner = hwndOwner .pIDLRoot = RootDirectory .lpszTitle = sPrompt .pszDisplayName = String$(MAX_PATH, 0) .ulFlags = Flags ' .lpfnCallback = GetFunctionAddress(AddressOf CallBackBrowseForFolder) End With 'call to dialog lngIdList = SHBrowseForFolder(udtBI) 'read selected folder If lngIdList > 0 Then BrowseForFolderEx = True DisplayName = GetNormalString(udtBI.pszDisplayName) 'read DisplayName strPath = String$(MAX_PATH, 0) SHGetPathFromIDList lngIdList, strPath CoTaskMemFree lngIdList Path = GetNormalString(strPath) End If EXIT_BrowseForFolder: Exit Function ERROR_BrowseForFolder: Err.Raise Err.Number, Err.Source, Err.Description Resume EXIT_BrowseForFolder End Function