Otra función del API de Windows que puede darle un
"look" más apropiado a nuestras aplicaciones:
Mostrar el cuadro de diálogo de seleccionar carpetas (o directorios) que usa el propio
Windows.
La función del API que se encarga de hacerlo es: SHBrowseForFolder, aunque para poder sacarle el jugo nos tendremos que apoyar en otras funciones, una de ellas no es "redistribuible" y debe estar ya instalada en el sistema, de hecho todas las DLLs del API de Windows ya deben estar instaladas en el sistema... por tanto sólo podremos usar estas funciones si previamente están instaladas... el que avisa.
Dejemos las partes "legalistas" a un lado y vamos a centrarnos en lo que interesa: saber cómo usarla.
Esta función no es tan "intuitiva" como el
resto y se basa, como otras muchas de la librería Shell, en unos parámetros que se pasan
en forma de datos asignados a un tipo definido, en este caso es: Browseinfo.
En este tipo definido (UDT), asignaremos lo que queremos que ese cuadro de diálogo nos
muestre, por ejemplo se le puede decir que también nos permita seleccionar ficheros,
además de carpetas, el título que queramos que tenga, etc.
Lo que es un poco más complicado de indicarle es el directorio por el que debe empezar a
mostrar, (por defecto empieza en el Escritorio); para indicarle el directorio por defecto
hay que recurrir a la subclasificación, por suerte, desde la versión 5.0 del Visual
Basic es algo más fácil, ya que disponemos de AddressOf, el problema es que la
subclasificación se hace asignando a uno de los parámetros del tipo definido la
dirección de la función que se encargará de procesar esos mensajes... por desgracia
AddressOf no devuelve ningún valor, y lo que necesitamos es poder asignar a una variable
la dirección de memoria de una función creada en Visual Basic... ¿Cómo lo
solucionaremos? Creando una función que devuelva ese valor... ya verás el código y lo
comprenderás mejor.
Aquí tienes el código y una "foto" del formulario de prueba en pleno funcionamiento.
Como puedes comprobar, puedes especificar si quieres empezar a "browsear" por una carpeta determinada y también si quieres seleccionar ficheros, además de poder seleccionar carpetas.
Nos vemos.
Guillermo
P.S.
Por suerte, con el Visual Basic 6.0 se incluyen los CDs de la MSDN Library de Microsoft,
que es de dónde he sacado parte del código que he usado... el problema es que los
artículos están en inglés... pero algo es algo...
Espero que te sea de utilidad...
Haciendo caso del consejo del colega Eduardo Morcillo, aquí te digo los cambios que habría que hacer para poder especificar el título de la ventana, para que no salga el que pone por defecto, en inglés: "Browse for folder", sino el que nosotros queramos.
Lo primero que hay que hacer es añadir un
nuevo parámetro a la función BrowseForFolder para que acepte el Caption que
queremos mostrar.
También he cambiado la función Callback para que "siempre" sea
llamada, de esta forma, si se especifica el path de inicio y/o el título a mostrar,
se llamarán a las funciones apropiadas del API.
Para poder cambiar el título de una ventana, sabiendo el "handle" (hWnd), simplemente llamaremos a SetWindowText.
He dejado el código tal y como estaba originalmente, si quieres ver los cambios, están al final.
'
'//////////////////////////////////////////////////////////////////////////////
'///// ESTE CÓDIGO INSERTALO EN UN MÓDULO BAS /////
'//////////////////////////////////////////////////////////////////////////////
'
'------------------------------------------------------------------------------
' Módulo con las declaraciones y funciones para BrowseForFolder (12/May/99)
'
' ©Guillermo 'guille' Som, 1999
'------------------------------------------------------------------------------
Option Explicit
'//////////////////////////////////////////////////////////////////////////////
' Variables, constantes y funciones para usar con BrowseForFolder (12/May/99)
'//////////////////////////////////////////////////////////////////////////////
'
Private sFolderIni As String
'
Private Const WM_USER = &H400&
Public Const MAX_PATH = 260&
'
' Tipo para usar con SHBrowseForFolder
Private Type BrowseInfo
hWndOwner As Long ' hWnd del formulario
pIDLRoot As Long ' Especifica el pID de la carpeta inicial
pszDisplayName As String ' Nombre del item seleccionado
lpszTitle As String ' Título a mostrar encima del árbol
ulFlags As Long '
lpfnCallback As Long ' Función CallBack
lParam As Long ' Información extra a pasar a la función Callback
iImage As Long '
End Type
'
'// Browsing for directory.
Public Const BIF_RETURNONLYFSDIRS = &H1& '// For finding a folder to start document searching
Public Const BIF_DONTGOBELOWDOMAIN = &H2& '// For starting the Find Computer
Public Const BIF_STATUSTEXT = &H4&
Public Const BIF_RETURNFSANCESTORS = &H8&
Public Const BIF_EDITBOX = &H10&
Public Const BIF_VALIDATE = &H20& '// insist on valid result (or CANCEL)
'
Public Const BIF_BROWSEFORCOMPUTER = &H1000& '// Browsing for Computers.
Public Const BIF_BROWSEFORPRINTER = &H2000& '// Browsing for Printers
Public Const BIF_BROWSEINCLUDEFILES = &H4000& '// Browsing for Everything
'
'// message from browser
Public Const BFFM_INITIALIZED = 1
Public Const BFFM_SELCHANGED = 2
Public Const BFFM_VALIDATEFAILED = 3 '// lParam:szPath ret:1(cont),0(EndDialog)
'Public Const BFFM_VALIDATEFAILEDW = 4& '// lParam:wzPath ret:1(cont),0(EndDialog)
'
'// messages to browser
Public Const BFFM_SETSTATUSTEXT = (WM_USER + 100)
Public Const BFFM_ENABLEOK = (WM_USER + 101)
Public Const BFFM_SETSELECTION = (WM_USER + 102)
'Public Const BFFM_SETSELECTIONW = (WM_USER + 103&)
'Public Const BFFM_SETSTATUSTEXTW = (WM_USER + 104&)
'
Private Declare Function SHBrowseForFolder Lib "shell32.dll" _
(lpbi As BrowseInfo) As Long
'
Private Declare Sub CoTaskMemFree Lib "OLE32.DLL" _
(ByVal hMem As Long)
'
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" _
(ByVal pidList As Long, ByVal lpBuffer As String) As Long
'
Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" _
(ByVal hWnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, lParam As Any) As Long
Public Function BrowseFolderCallbackProc(ByVal hWndOwner As Long, _
ByVal uMSG As Long, _
ByVal lParam As Long, _
ByVal pData As Long) As Long
' Llamada CallBack para usar con la función BrowseForFolder (12/May/99)
Dim szDir As String
On Local Error Resume Next
Select Case uMSG
'--------------------------------------------------------------------------
' Este mensaje se enviará cuando se inicia el diálogo,
' entonces es cuando hay que indicar el directorio de inicio.
Case BFFM_INITIALIZED
' El path de inicio será el directorio indicado,
' si no se ha asignado, usar el directorio actual
If Len(sFolderIni) Then
szDir = sFolderIni & Chr$(0)
Else
szDir = CurDir$ & Chr$(0)
End If
' WParam será TRUE si se especifica un path.
' será FALSE si se especifica un pIDL.
Call SendMessage(hWndOwner, BFFM_SETSELECTION, 1&, ByVal szDir)
'--------------------------------------------------------------------------
' Este mensaje se produce cuando se cambia el directorio
' Si nuestro form está subclasificado para recibir mensajes,
' puede interceptar el mensaje BFFM_SETSTATUSTEXT
' para mostrar el directorio que se está seleccionando.
Case BFFM_SELCHANGED
szDir = String$(MAX_PATH, 0)
' Notifica a la ventana del directorio actualmente seleccionado,
' (al menos en teoría, ya que no lo hace...)
If SHGetPathFromIDList(lParam, szDir) Then
'Debug.Print szDir
Call SendMessage(hWndOwner, BFFM_SETSTATUSTEXT, 0&, ByVal szDir)
End If
Call CoTaskMemFree(lParam)
End Select
Err = 0
BrowseFolderCallbackProc = 0
'------------------------------------------------------------------------------
' Este es el código de C en el que está basada esta función Callback
' Código obtenido de la MSDN Library de Microsoft:
' HOWTO: Browse for Folders from the Current Directory
' Article ID: Q179378
'
' TCHAR szDir[MAX_PATH];
'
' switch(uMsg) {
' case BFFM_INITIALIZED: {
' if GetCurrentDirectory(sizeof(szDir)/sizeof(TCHAR),
' szDir)) {
' // WParam is TRUE since you are passing a path.
' // It would be FALSE if you were passing a pidl.
' SendMessage(hwnd,BFFM_SETSELECTION,TRUE,(LPARAM)szDir);
' }
' break;
' }
' case BFFM_SELCHANGED: {
' // Set the status window to the currently selected path.
' if (SHGetPathFromIDList((LPITEMIDLIST) lp ,szDir)) {
' SendMessage(hwnd,BFFM_SETSTATUSTEXT,0,(LPARAM)szDir);
' }
' break;
' }
' default:
' break;
' }
' return 0;
'------------------------------------------------------------------------------
End Function
Public Function rtnAddressOf(lngProc As Long) As Long
' Devuelve la dirección pasada como parámetro
' Esto se usará para asignar a una variable la dirección de una función
' o procedimiento.
' Por ejemplo, si en un tipo definido se asigna a una variable la dirección
' de una función o procedimiento
rtnAddressOf = lngProc
End Function
Public Function BrowseForFolder(ByVal hWndOwner As Long, ByVal sPrompt As String, _
Optional sInitDir As String = "", _
Optional ByVal lFlags As Long = BIF_RETURNONLYFSDIRS) As String
' Muestra el diálogo de selección de directorios de Windows
' Si todo va bien, devuelve el directorio seleccionado
' Si se cancela, se devuelve una cadena vacía y se produce el error 32755
'
' Los parámetros de entrada:
' El hWnd de la ventana
' El título a mostrar
' Opcionalmente el directorio de inicio
' En lFlags se puede especificar lo que se podrá seleccionar:
' BIF_BROWSEINCLUDEFILES, etc.
' por defecto es: BIF_RETURNONLYFSDIRS
'
Dim iNull As Integer
Dim lpIDList As Long
Dim lResult As Long
Dim sPath As String
Dim udtBI As BrowseInfo
On Local Error Resume Next
With udtBI
.hWndOwner = hWndOwner
' Título a mostrar encima del árbol de selección
.lpszTitle = sPrompt & vbNullChar
' Que es lo que debe devolver esta función
.ulFlags = lFlags
'.ulFlags = lFlags Or BIF_RETURNONLYFSDIRS
'
' Si se especifica el directorio por el que se empezará...
If Len(sInitDir) Then
' Asignar la variable que contendrá el directorio de inicio
sFolderIni = sInitDir
' Indicar la función Callback a usar.
' Como hay que asignar esa dirección a una variable,
' se usa una función "intermedia" que devuelve el valor
' del parámetro pasado... es decir: ¡la dirección de la función!
.lpfnCallback = rtnAddressOf(AddressOf BrowseFolderCallbackProc)
End If
End With
Err = 0
On Local Error GoTo 0
' Mostramos el cuadro de diálogo
lpIDList = SHBrowseForFolder(udtBI)
'
If lpIDList Then
' Si se ha seleccionado un directorio...
'
' Obtener el path
sPath = String$(MAX_PATH, 0)
lResult = SHGetPathFromIDList(lpIDList, sPath)
Call CoTaskMemFree(lpIDList)
' Quitar los caracteres nulos del final
iNull = InStr(sPath, vbNullChar)
If iNull Then
sPath = Left$(sPath, iNull - 1)
End If
Else
' Si se ha pulsado en cancelar...
'
' Devolver una cadena vacía y asignar un error
sPath = ""
With Err
.Source = "MBrowseFolder::BrowseForFolder"
.Number = 32755
.Description = "Cancelada la operación de BrowseForFolder"
End With
End If
BrowseForFolder = sPath
End Function
'//////////////////////////////////////////////////////////////////////////////
' Este código insertalo en un formulario que tenga un botón llamado cmdSelDir,
' un TextBox llamado Text1, un CheckBox llamado Check1 y otro llamado chkIncludeFiles
'//////////////////////////////////////////////////////////////////////////////
'
'------------------------------------------------------------------------------
' Ejemplo de BrowseForFolder y asignación del directorio de inicio (12/May/99)
'
' ©Guillermo 'guille' Som, 1999
'------------------------------------------------------------------------------
Option Explicit
Private Sub cmdSelDir_Click()
' Muestra el diálogo de seleccionar directorio
' Si se marca el Check1, se empezará por el directorio indicado
Dim sDir As String
Dim lFlags As Long
' Para saber si se ha producido el "error" al cancelar...
' no es necesrio interceptar errores:
'On Local Error Resume Next
lFlags = BIF_RETURNONLYFSDIRS
' Si se quiere seleccionar ficheros
If chkIncludeFiles Then
lFlags = lFlags Or BIF_BROWSEINCLUDEFILES
End If
Err = 0
If Check1 Then
sDir = BrowseForFolder(Me.hWnd, "Seleccionar Directorio empezando en " & Text1, Text1, lFlags)
Else
sDir = BrowseForFolder(Me.hWnd, "Seleccionar Directorio", , lFlags)
End If
If Err = 0 Then
Text1 = sDir
Else
MsgBox "Se ha cancelado la operación, el error devuelto es:" & vbCrLf & _
"Source: " & Err.Source & vbCrLf & "Description: " & Err.Description
End If
' Pero si es conveniente poner de nuevo el valor a cero
Err = 0
End Sub
Private Sub Form_Load()
' Asignamos al Text1 el directorio actual
Text1 = CurDir$
End Sub
Los cambios a realizar para poder mostrar un título en la ventana de selección de carpetas:
' En la parte general de declaraciones del módulo BAS:
'
' Variable para guardar el Caption a mostrar
Private sBFFCaption As String
' Declaración de la función del API para cambiar el título de una ventana
Private Declare Function SetWindowText Lib "user32.dll" Alias "SetWindowTextA" _
(ByVal hWnd As Long, ByVal lpString As String) As Long
' Estas son las dos funciones para "browsear"
' La primera es la función callback, que se encargará de inicializar la ventana de selección
Public Function BrowseFolderCallbackProc(ByVal hWndOwner As Long, _
ByVal uMSG As Long, _
ByVal lParam As Long, _
ByVal pData As Long) As Long
' Llamada CallBack para usar con la función BrowseForFolder (12/May/99)
Dim szDir As String
On Local Error Resume Next
Select Case uMSG
'--------------------------------------------------------------------------
' Este mensaje se enviará cuando se inicia el diálogo,
' entonces es cuando hay que indicar el directorio de inicio.
Case BFFM_INITIALIZED
' Si se ha asignado el path de inicio, empezar por ese path
If Len(sFolderIni) Then
szDir = sFolderIni & Chr$(0)
' WParam será TRUE si se especifica un path.
' será FALSE si se especifica un pIDL.
Call SendMessage(hWndOwner, BFFM_SETSELECTION, 1&, ByVal szDir)
End If
' Si se ha especificado el título de la ventana
If Len(sBFFCaption) Then
' Cambiar el título de la ventana.
' Aunque parezca que se cambia el título de la ventana "propietaria",
' realmente se cambia el de la ventana de selección.
Call SetWindowText(hWndOwner, sBFFCaption)
End If
'--------------------------------------------------------------------------
' Este mensaje se produce cuando se cambia el directorio
' Si nuestro form está subclasificado para recibir mensajes,
' puede interceptar el mensaje BFFM_SETSTATUSTEXT
' para mostrar el directorio que se está seleccionando.
Case BFFM_SELCHANGED
szDir = String$(MAX_PATH, 0)
' Notifica a la ventana del directorio actualmente seleccionado,
' (al menos en teoría, ya que no lo hace...)
If SHGetPathFromIDList(lParam, szDir) Then
'Debug.Print szDir
Call SendMessage(hWndOwner, BFFM_SETSTATUSTEXT, 0&, ByVal szDir)
End If
Call CoTaskMemFree(lParam)
End Select
Err = 0
BrowseFolderCallbackProc = 0
End Function
Public Function BrowseForFolder(ByVal hWndOwner As Long, _
ByVal sPrompt As String, _
Optional sInitDir As String = "", _
Optional ByVal lFlags As Long = BIF_RETURNONLYFSDIRS, _
Optional sCaption As String = "") As String
' Muestra el diálogo de selección de directorios de Windows
' Si todo va bien, devuelve el directorio seleccionado
' Si se cancela, se devuelve una cadena vacía y se produce el error 32755
'
' Los parámetros de entrada:
' El hWnd de la ventana
' El título a mostrar encima del árbol
' Opcionalmente el directorio de inicio
' En lFlags se puede especificar lo que se podrá seleccionar:
' BIF_BROWSEINCLUDEFILES, etc.
' por defecto es: BIF_RETURNONLYFSDIRS
' El Caption de la ventana
'
Dim iNull As Integer
Dim lpIDList As Long
Dim lResult As Long
Dim sPath As String
Dim udtBI As BrowseInfo
On Local Error Resume Next
With udtBI
.hWndOwner = hWndOwner
' Título a mostrar encima del árbol de selección
.lpszTitle = sPrompt & vbNullChar
' Que es lo que debe devolver esta función
.ulFlags = lFlags
'
' Asignar el caption de la ventana
sBFFCaption = sCaption
'
' Asignar la variable que contendrá el directorio de inicio
sFolderIni = sInitDir
'
' Indicar la función Callback a usar.
' Nota: Esto sólo es necesario si se quiere cambiar el caption
' y especificar el directorio de inicio.
'
' Como hay que asignar esa dirección a una variable,
' se usa una función "intermedia" que devuelve el valor
' del parámetro pasado... es decir: ¡la dirección de la función!
.lpfnCallback = rtnAddressOf(AddressOf BrowseFolderCallbackProc)
End With
Err = 0
On Local Error GoTo 0
' Mostramos el cuadro de diálogo
lpIDList = SHBrowseForFolder(udtBI)
'
If lpIDList Then
' Si se ha seleccionado un directorio...
'
' Obtener el path
sPath = String$(MAX_PATH, 0)
lResult = SHGetPathFromIDList(lpIDList, sPath)
Call CoTaskMemFree(lpIDList)
' Quitar los caracteres nulos del final
iNull = InStr(sPath, vbNullChar)
If iNull Then
sPath = Left$(sPath, iNull - 1)
End If
Else
' Si se ha pulsado en cancelar...
'
' Devolver una cadena vacía y asignar un error
sPath = ""
With Err
.Source = "MBrowseFolder::BrowseForFolder"
.Number = 32755
.Description = "Cancelada la operación de BrowseForFolder"
End With
End If
BrowseForFolder = sPath
End Function
' Este es el código que hay que cambiar en el procedimiento cmdSelDir_Click:
' Si te fijas, sólo tendrás que añadirle al final un parámetro con el título de la ventana.
Err = 0
If Check1 Then
sDir = BrowseForFolder(Me.hWnd, "Seleccionar Directorio empezando en " & Text1, Text1, _
lFlags, "Título de la ventana")
Else
sDir = BrowseForFolder(Me.hWnd, "Seleccionar Directorio", , _
lFlags, "Título de la ventana")
End If
