NOTA: Este control es parecido a SelDir (gsSelDir.ocx), pero he añadido la opción de poder mostrar y seleccionar un archivo.
Puedes probarlo en la página de ejemplo del control (pincha aquí), te recuerdo que para poder instalar el control, deberás tener "puesta" la seguridad en "media" para que te pregunte si quieres instalar los componentes.
Puedes seguir fiándote de mi, no tiene "virus".Baja los listados para VB5 (SelDirFile.zip 16.0 KB)
El funcionamiento es igual que el de "su primo hermano" gsSelDir, sólo que ahora he añadido una opción (o método) para poder mostrar/seleccionar archivos.
Si ya has usado el gsSelDir, puedes sustituir el otro control por este y no tendrás que cambiar la forma de usarlo.
Las nuevas propiedades y métodos son:Propiedades: FileName Nombre del archivo/Path del directorio Filter Extensiones a mostrar, en formato: Descrip|ext;ext|Descp2|ext;ext... DialogTitle El Caption del diálogo Flags Pueden ser estos valores, o una suma de ellos: (Cuando se muestra con ShowOpen/ShowSave, están todos conectados) sdfFile 1-Mostrar los archivos sdfExt 2-Mostrar las extensiones sdfInfo 4-Mostrar la información del archivo sdfPic 8-Mostrar el picture para ver los archivos gráficos Stretch Para asignar la propiedad del mismo nombre de la imagen del diálogo Métodos: ShowOpen Seleccionar un archivo ShowSave Seleccionar un archivo (por compatibilidad con los diálogos comunes) ShowSelDir Seleccionar un directorio (no muestra ni archivos no extensión) ShowSelFile Seleccionar un archivo, opcionalmente mostrará la imagen y la información SplitPath Para "desgranar" una ruta en sus partes...Para usarlo, hazlo de esta forma:
'Seleccionar un directorio: Text1(cDirIni) = oSelDir.ShowSelDir(Trim$(Text1(cDirIni))) 'Seleccionar un archivo: oSelDir.Filter = "Todos los archivos|*.*|Basic|*.vbp;*.bas" oSelDir.filename = Trim$(Text1(0)) oSelDir.Flags = sdfInfo + sdfPic oSelDir.ShowOpen sFile = oSelDir.filename 'O también de esta forma: sFile = oSelDir.ShowSelFile(Trim$(Text1(0))) sFile = oSelDir.ShowSelFile(Trim$(Text1(0)), sdfInfo + sdfPic) oSelDir.SplitPath sFile, sPath, , sExt Text1(0) = "." & sExt Text1(cDirIni) = sPath 'Para crear una colección de los archivos especificados, 'y mostrarlos en un listbox: (esto es igual que con el otro control) Private Sub CmdAceptar_Click() 'Empieza la acción Dim sRuta As String Dim i As Long Dim sExt As String Dim tNombre As Object Dim colDir As Object Dim cSelDir As Object Set tNombre = oSelDir.cNombre Set colDir = oSelDir.cNombres Set cSelDir = oSelDir.SelDir On Local Error Resume Next If cmdAceptar.Caption = "Cancelar" Then Cancelar = True cSelDir.Cancelar = True GoTo Salir End If Cancelar = False cSelDir.Cancelar = False sRuta = Trim$(Text1(cDirIni)) cmdAceptar.Caption = "Cancelar" MousePointer = vbArrowHourglass DoEvents 'Leer la estructura de directorios, si se activa Check1 ' Text1(cExtension) = Trim$(Text1(cExtension)) 'Asegurarse de que se queda sólo la extensión sExt = Text1(cExtension) oSelDir.SplitPath sExt, "", , sExt If Check1 Then 'Si se recorren los directorios, usar la función Label2 = "Procesando los directorios de " & sRuta If Len(sExt) Then Label2 = Label2 & vbCrLf & "con la extensión: " & sExt End If DoEvents cSelDir.Directorios colDir, sRuta, sExt Label2 = "" If cSelDir.Cancelar Then GoTo Salir End If Else If Len(Text1(cExtension)) Then 'Los archivos del directorio especificado cSelDir.Directorio colDir, sRuta, Text1(cExtension) If cSelDir.Cancelar Then GoTo Salir End If Else 'Sólo el directorio actual colDir.Nuevo sRuta End If End If 'Mostrar el contenido de colDir List1.Clear For Each tNombre In colDir.Nombres List1.AddItem tNombre.Nombre Next Label2 = "Archivos/Directorios hallados: " & List1.ListCount 'Liberar memoria y los objetos Set tNombre = Nothing Set colDir = Nothing Set cSelDir = Nothing ' Salir: 'Restaurar los "valores" por defecto cmdAceptar.Caption = "&Aceptar" MousePointer = vbDefault DoEvents On Local Error GoTo 0 End SubY esto es todo, como te digo siempre: echale un vistazo al código y verás lo fácil que es esto de crear controles.
Además funciona con VB4 de 32 bits sin problemas.¡ A disfrutarlo !