Estoy Haciendo una clase para los que quieren de una forma facil el Commondialog de Folders, pero me han asaltado algunas dudas por que por mas que quiero no me sale la ruta de las impresoras,

le mando a flags que me muestre las impresoras y al pidlRoot el directorio especial de impresoras, esto lo hace a la perfeccion pero al momento de seleccionar una impresora no me hace enbled en el boton aceptar, pense que con la constante bffm_enableok mandadolo a lparam me iba a funcionar pero no es asi, voy a subir el code yo creo mañana que lo tenga un poco mas depurado pero si alguien sabe como pasar los flag para que me devuel la ruta de las impresoras se los estaria agredecido!!

y para que sirve .iImage??????????????

Otra duda el operador AddressOf no funciona en clases?

Aqui dejo el Code, pero OJO no funciona todavia, el problema esta en que me da un error de mal uso en addressof, y no le encuentro solucion, pero a ver que pasa al rato jeje, si alguien puede solucionarlo que deje el post

Esto va en un modulo de clase

Código:

Option Explicit
'********************************************APIS********************************************
'API SendMessage para mandar mensajes
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, _
 ByVal wMsg As Long, _
 ByVal wParam As Long, _
 ByVal lParam As String) As Long
'Hacer un espacio en memoria
Private Declare Sub CoTaskMemFree Lib "OLE32.DLL" (ByVal hMem As Long)
'Sirve para concatenar dos cadenas de caracteres
Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, _
 ByVal lpString2 As String) As Long
'Mandar a llamar al cuadro de dialogo "Selecciona un Carpeta"
Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BROWSEINFO) As Long
'Recuperar el Path obtenido de la funcion anterior
Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, _
 ByVal lpBuffer As String) As Long
 
'Hace posible el Drag and Drop en el Cuadro ademas de otras cosas por ejemplo boton "Nueva Carpeta"
Private Declare Function OleInitialize Lib "OLE32.DLL" _
 (lp As Any) As Long
'Termina La anterior funcion
Private Declare Sub OleUninitialize Lib "ole32" ()
'/////////////////////////////////////////////////////////////////////////////////////////////
'******************************************Tipos**********************************************
'Tipo de Dato para el Dialogo Comun
Private Type BROWSEINFO
 hWndOwner As Long ''El Handle del que viene por ejemplo Form1
 pidlRoot As Long 'El Directorio en el que se va a iniciar
 pszDisplayName As Long 'el nombre del objeto seleccionado
 lpszTitle As Long 'el mensaje a mostrar
 ulFlags As Long 'Que y Como se va a mostrar la ventana
 lpfnCallback As Long 'Esto es para por ejemplo poder poner un directorio propio
 lParam As Long 'Argumentos opcionales en el CallBack (BFFM)
 iImage As Long '????
End Type
'///////////////////////////////////////////////////////////////////////////////////////////////
'----------------------------------------Enumeraciones-----------------------------------------
'Enumeracion para todos los Directorios especiales del sistema
Public Enum Directorios_Especiales
 ESCRITORIO = 0
 DESCONOCIDO1 = 1
 INICIO_PROGRAMA_USUARIO = 2
 PANEL_DE_CONTROL = 3
 IMPRESORAS = 4
 MIS_DOCUMENTOS_USUARIO = 5
 FAVORITOS_USUARIO = 6
 INICIO_INICIO_USUARIO = 7
 DOCUMENTOS_RECIENTES_USUARIO = 8
 ENVIAR_A_USUARIO = 9
 DESCONOCIDO2 = 10
 MENÚ_DE_INICIO = 11
 DESCONOCIDO3 = 12
 MI_MÚSICA = 13
 DESCONOCIDO5 = 14
 PAPELERA_DE_RECICLAJE = 15
 ESCRITORIO_USUARIO = 16
 MI_COMPUTADORA = 17
 ENTORNO_DE_RED = 18
 ENTORNO_DE_RED_USUARIO = 19
 TIPO_DE_LETRA = 20
 PLANTILLAS = 21
 INICIO_TODOS_NT = 22
 INICIO_PROGRAMAS_TODOS_NT = 23
 INICIO_INICIO_TODOS_NT = 24
 ESCRITORIO_TODOS_NT = 25
 DATOS_DE_APLICACIÓN_USUARIO = 26
 ENTORNO_DE_IMPRESORAS = 27
 DATOS_DE_APLICACIÓN_LOCALES = 28
 INICIO_NO_LOCALIZADOS = 29
 INICIO_NO_LOCALIZADOS_NT = 30
 FAVORITOS_TODOS_NT = 31
 TEMPORAL_DE_INTERNET = 32
 GALLETAS_INTERNET = 33
 HISTÓRICO_INTERNET = 34
 DATOS_DE_APLICACIÓN_TODOS_NT = 35
 WINDOWS = 36
 SISTEMA_DE_WINDOWS = 37
 ARCHIVOS_DE_PROGRAMA = 38
 MIS_IMÁGENES = 39
 PERFILES = 40
 SISTEMA_DE_WINDOWS2 = 41
 DESCONOCIDO7 = 42
 ARCHIVOS_COMUNES = 43
 MI_PROGRAMA = 44
End Enum
'Enumeracion BIF (Browse Info)
Public Enum eBIF
 BIF_BROWSEFORCOMPUTER = &H1000
 BIF_BROWSEFORPRINTER = &H2000
 BIF_BROWSEINCLUDEFILES = &H4000
 BIF_BROWSEINCLUDEURLS = &H80
 BIF_DONTGOBELOWDOMAIN = &H2
 BIF_EDITBOX = &H10
 BIF_NEWDIALOGSTYLE = &H40
 BIF_RETURNFSANCESTORS = &H8
 BIF_RETURNONLYFSDIRS = &H1
 BIF_SHAREABLE = &H8000
 BIF_STATUSTEXT = &H4
 BIF_USENEWUI = &H40
 BIF_VALIDATE = &H20
End Enum
'Enumeracion BFFM Antes y despues del cuadro de dialogo
Public Enum eBFFM
 BFFM_ENABLEOK = (WM_USER + 101)
 BFFM_INITIALIZED = 1
 BFFM_SELCHANGED = 2
 BFFM_SETSELECTIONA = (WM_USER + 102)
 BFFM_SETSELECTIONW = (WM_USER + 103)
 BFFM_SETSTATUSTEXTA = (WM_USER + 100)
 BFFM_SETSTATUSTEXTW = (WM_USER + 104)
 BFFM_VALIDATEFAILEDA = 3
 BFFM_VALIDATEFAILEDW = 4
End Enum
'///////////////////////////////////////////////////////////////////////////////////////////////////
'-------------------------------------Constantes--------------------------------------------------
'WM = General Windows Message
Private Const WM_USER As Long = &H400
'Constante para la longitud maxima de caracteres en el path
Private Const MAX_PATH = 260
'*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*Lista de Errores*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
'Lista de Errores
'1 = No esta en el rango de los directorios especiales
'2 = No Existe el Path

'//////////////////////////////////////////////////////////////////////////////////////////////////////
'----------------------------------Propiedades de la Clase----------------------------------------

'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'Este es para Seleccionar el directorio especial de windows en el cual se debe de iniciar
Private m_Tipo_Directorio As Directorios_Especiales
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'Esta propiedad es para poner un path definido por el usuario
Private m_Directorio_Inicial As String
Private m_Directorio_Sel As String
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'Esta Propiedad es para Saber si se muestran o no los archivos en el Cuadro de Dialogo
Public Incluir_Archivos As Boolean
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'Esta Propiedad es para tener el Titulo que aparecera en el cuadro de dialogo
Public Titulo_Dialogo As String

'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'Esta prpiedad es para saber el CSILD (el numero de directorio especial)
Public Property Get Tipo_Directorio() As Directorios_Especiales
'Devolvemos el Path Especial
Tipo_Directorio = m_Tipo_Directorio
End Property
Public Property Let Tipo_Directorio(ByVal Dir As Directorios_Especiales)
'Checamos que el Directorio este en el rango Indicado
If Dir >= 0 And Dir <= 43 Then
 m_Tipo_Directorio = Dir
Else
 If Dir = 44 Then
 m_Directorio_Inicial = App.Path & "\"
 Else
 With Err
 .Number = 1
 .Description = "No esta en el Rango de Directorios"
 .Source = "cBrowse.Tipo_Directorio = " & Dir
 .Raise 1
 End With
 End If
End If
End Property
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'Esta propiedad es para poner un directorio inicial
Public Property Get Directorio_Inicial() As String
'Devolvemos el path escogido por el usuario
Directorio_Inicial = m_Directorio_Inicial
End Property
Public Property Let Directorio_Inicial(ByVal sPath As String)
'Checamos que sea ( \ ) si no lo remplazamos por ( / )
If InStr(1, sPath, "/") <> 0 Then sPath = Replace(sPath, "/", "\")
'Checamos que tenga al final ( \ )
If Right(sPath, 1) <> "\" Then sPath = sPath & "\"
'Checamos que el directorio no rebase el MAX_PATH
If Len(sPath) > MAX_PATH Then
 With Err
 .Number = 3
 .Description = "No puede exceder = " & MAX_PATH & " caracteres"
 .Source = "cBrowse.DirectorioInicial = " & sPath
 .Raise 3
 End With
Else
 'Ahora Checamos que el Directorio Exista
 If Dir(sPath, vbDirectory) = "" Then
 With Err
 .Number = 2
 .Description = "El Directorio no Existe"
 .Source = "cBrowse.DirectorioInicial = " & sPath
 .Raise 2
 End With
 Else
 m_Directorio_Inicial = sPath
 End If
End If
End Property

'////////////////////////////////////////////////////////////////////////////////////////////////////
'---------------------------------------------Subs--------------------------------------------------
'Este Procedimiento Muestra el cuadro de dialogo
Public Sub Show_Folder(f_hWnd As Long)
Dim vFlags As Variant 'Para la forma en la que se va a mostrar el cuadro
Dim lpIDList As Long 'Donde se va a guardar el ID del path que regreso el cuadro
Dim tfolder As BROWSEINFO 'Aqui se guarda toda la info que se le va a pasar como parametros al cuadro
Dim sBuffer As String
vFlags = IIf(Incluir_Archivos, BIF_BROWSEINCLUDEFILES, 0) + _
 BIF_DONTGOBELOWDOMAIN + BIF_EDITBOX + BIF_USENEWUI
With tfolder
 .hWndOwner = f_hWnd
 .ulFlags = vFlags
 
 If m_Directorio_Inicial <> "" Then
 
 '.lpfnCallback = GetAddressofFunction(AddressOf BrowseCallbackProc)
 Else
 If m_Tipo_Directorio <> -1 Then
 .pidlRoot = m_Tipo_Directorio
 End If
 End If
 
 .lpszTitle = lstrcat(Titulo_Dialogo, "")
 
End With
 lpIDList = SHBrowseForFolder(tfolder)
 If (lpIDList) Then
 sBuffer = Space(MAX_PATH)
 SHGetPathFromIDList lpIDList, sBuffer
 sBuffer = Left(sBuffer, InStr(sBuffer, vbNullChar) - 1)
 m_Directorio_Sel = sBuffer
 Else
 m_Directorio_Sel = ""
 End If
 
End Sub
Private Function GetAddressofFunction(add As Long) As Long
 GetAddressofFunction = add
End Function

Private Function BrowseCallbackProc(ByVal hWnd As Long, ByVal uMSG As Long, ByVal lp As Long, ByVal pData As Long) As Long
 
 Dim lpIDList As Long
 Dim ret As Long
 Dim sBuffer As String
 
 On Error Resume Next 'Sugested by MS to prevent an error from
 'propagating back into the calling process.
 
 Select Case uMSG
 
 Case BFFM_INITIALIZED
 Call SendMessage(hWnd, BFFM_SETSELECTIONA, 1, m_CurrentDirectory)
 
 Case BFFM_SELCHANGED
 sBuffer = Space(MAX_PATH)
 
 ret = SHGetPathFromIDList(lp, sBuffer)
 If ret = 1 Then
 Call SendMessage(hWnd, BFFM_SETSTATUSTEXTA, 0, sBuffer)
 End If
 
 End Select
 
 BrowseCallbackProc = 0
 
End Function

'/////////////////////////////////////////////////////////////////////////////////////////////////////
'----------------------------------Inicializar Clase-------------------------------------------------
Private Sub Class_Initialize()
'Inicializa la Clase
'inicializamos las Variables
m_Tipo_Directorio = -1
m_Directorio_Inicial = ""
Incluir_Archivos = False
End Sub
Public Property Get Directorio_Sel() As String
Directorio_Sel = m_Directorio_Sel
End Property

Le acabo de hacer unas pequeñas modificaciones para que funcione pero no como me gustaria dejarlo pruebenlo y cuando este terminado lo subimos a la guia de recursos, ya ando algo cansado por que aqui ya son las 5:30 de la madrugada y no he dormido nada por que me trae lco eso del AddressOf , pero esta bien jejeEdited by: Zitro

Hola Zitro!

Por lo que he leido, la variable iImage recibe un índice asociado a la carpeta seleccionada.

Depurando y en la ventana de locales me sale esto:

Seleccionado Valor iImage
------------------------------------------ ----------------
Disco duro (incluidas particiones) 6
Unidad CD 10
Unidad DVD 9
Carpeta "Escritorio" 4
Carpeta "Mis imágenes"19
Carpeta normal 7
......

La verdad es que no sé qué utilidad puede tener esto, pero supongo que alguna tendrá.
Si se le asigna un valor en ejecución aésta variable, no tiene ningún efecto, es decir, al seleccionar una carpeta, la sustituye.

Suerte en tu proyecto, que estoy seguro que como siempre,aportarás algo bueno.

Saludos


Edited by: Anibal

Gracias, oye y tu no sabes como saber el manejador para la ventana desde la clase, es que me marca error en el addressof desde la clase pero en el bas o en el frm corre bien, bueno pues si sabes o alguien por ahi sabe la respuesta por favor dejen un post por que me tiene como loco

Al parecer tengo que hacer la llamada a la funcion BrowseCallbackProc desde unmodulo bas, pero entonces se perderia el fin de la clase por que simplemente lo podria hacer desde un bas, so alguien sabe de una api que funcione como addressof por fa pasenmela, bueno ps yo sigo sin poder resolver este asunto, lo bueno es que ya lo hice mas manejable desde el punto de vista de drag&drop crear nueva carpeta cosas asi, bueno aca esperando una respuesta jeje

Creo que no se puede,ysi o si la función CallBack debe estar en un bas.

Al parecer es cierto.... Ami pesar, bueno pues nimodo mañana yo creo que subo el recurso pero BAS, voy a tratar de hacerlo lo mas amigable posible, bueno pues muchas gracias... mañana subo el code...