Sección de código fuente Visual basic

Código fuente de un ocx para utilizar un CommonDialog que permite abrir archivos en diferentes vistas

Este ocx tiene las propiedades de un CommonDialog clásico de los que utiliza Visual basic para abrir archivos, (InitDir, Filter, FileName, FileTitle etc..) pero con una propiedad mas llamada Vistas. Esta propiedad puede tener los valores , Vista detallada, Iconos, Mosaico, Vista en miniatura y Vista en estilo de Lista.

La imagen muestra el CommonDialog con Vista en miniatura:

También se pueden especificar los otros tipos de vista que utiliza windows en sus cuadros de diálogo: ( Mosaicos, Iconos, Lista y vista Detalle )

Descar código fuente

Código fuente del ocx

A continuación se lista el código fuente del control, o si querés descarga el código fuente está al final de la página

Abrir un nuevo proyecto de tipo Control ActiveX.
Indicar en la propiedad InvisibleAtRuntime del control el valor True, esto hace que el control no sea visible en tiempo de ejcución, ya que no es necesario.

Vista de esta propiedad

vista de la ventana de propiedades del control

Ahora a la propiedad Name del control, escribir CdView.

vista de la ventana de propiedades pra cambiar el nombre al ocx

Abrir la ventana de código del UserControl y pegar lo siguiente

'Para las copias locales de las propiedades '********************************************** Private m_FileName As String Private m_Filter As String Private m_DialogTitle As String Private m_InitDir As String Private m_Vista As Long Private m_Flags As Long Private m_FileTitle As String 'Enum para los tipos de vista del commonDialog _ *********************************************** Enum e_Vista VISTA_LISTA ' = 28715 'vista Lista VISTA_MOSAICO '= 28718 'vista de Mosaicos VISTA_THUMBNAIL '= 28717 ' vista Thumbnail - Vista miniatura VISTA_ICONOS '= 28713 'vista de iconos VISTA_DETALLE '= 28716 'vista detallada End Enum 'Función que abre el CommonDialog '***************************************** Public Function ShowOpen(form As Object) m_FileName = Abrir(form, m_DialogTitle, m_Filter, _ m_InitDir, m_Vista, m_Flags, m_FileName, m_FileTitle) m_FileTitle = Archivo PropertyChanged "FileTitle" End Function 'Propiedades '***************************************** 'Propiedad FileName: Nombre de archivo Public Property Get FileName() As String FileName = m_FileName End Property Public Property Let FileName(ByVal vNewValue As String) m_FileName = vNewValue PropertyChanged "FileName" End Property 'Propiedad Filter: Extenciones Public Property Get Filter() As Variant Filter = m_Filter End Property Public Property Let Filter(ByVal vNewValue As Variant) m_Filter = vNewValue PropertyChanged "Filter" End Property 'Propiedad DialogTitle: Texto para el título del cuadro de diálogo Public Property Get DialogTitle() As String DialogTitle = m_DialogTitle End Property Public Property Let DialogTitle(ByVal vNewValue As String) m_DialogTitle = vNewValue PropertyChanged "DialogTitle" End Property 'Propiedad InitDir: Directorio inicial del cuadro de diálogo Public Property Get InitDir() As Variant InitDir = m_InitDir End Property Public Property Let InitDir(ByVal vNewValue As Variant) m_InitDir = vNewValue PropertyChanged "InitDir" End Property 'Propiedad Vista: Tipos de vista del CommonDialog: 'Iconos, detalle, Mosaico, Miniatura etc.. Public Property Get Vista() As e_Vista Vista = m_Vista End Property Public Property Let Vista(ByVal vNewValue As e_Vista) m_Vista = vNewValue PropertyChanged "Vista" End Property 'Propiedad Flags: opciones del Commondialog Public Property Get Flags() As Long m_Flags = Flags End Property Public Property Let Flags(ByVal vNewValue As Long) m_Flags = vNewValue PropertyChanged "Flags" End Property 'Propiedad FileTitle: Nombre del Archivo Seleccionado Public Property Get FileTitle() As String FileTitle = m_FileTitle End Property Public Property Let FileTitle(ByVal vNewValue As String) m_FileTitle = vNewValue PropertyChanged "FileTitle" End Property Private Sub UserControl_Initialize() 'Vista por defecto del Commondialg en Thumbnail al agregarlo al form m_Vista = VISTA_THUMBNAIL m_Flags = 0 End Sub 'Cargar valores de propiedad desde el almacén Private Sub UserControl_ReadProperties(PropBag As PropertyBag) InitDir = PropBag.ReadProperty("InitDir", "") Vista = PropBag.ReadProperty("Vista", 2) Filter = PropBag.ReadProperty("Filter", "*.*") DialogTitle = PropBag.ReadProperty("DialogTitle", "Abrir") FileName = PropBag.ReadProperty("FileName", "") Flags = PropBag.ReadProperty("Flags", 0) FileTitle = PropBag.ReadProperty("FileTitle", "") End Sub 'Escribir valores de propiedad en el almacén Private Sub UserControl_WriteProperties(PropBag As PropertyBag) Call PropBag.WriteProperty("InitDir", m_InitDir, "") Call PropBag.WriteProperty("Vista", m_Vista, 2) Call PropBag.WriteProperty("Filter", m_Filter, "*.*") Call PropBag.WriteProperty("DialogTitle", m_DialogTitle, "Abrir") Call PropBag.WriteProperty("FileName", m_FileName, "") Call PropBag.WriteProperty("Flags", m_Flags, 0) Call PropBag.WriteProperty("FileTitle", m_FileTitle, "") End Sub Private Sub UserControl_Resize() UserControl.Width = 485 UserControl.Height = 485 End Sub

Ahora agregar un módulo bas y pegar este otro código:

Option Explicit ' En un módulo BAS '''''''''''''''''''''''''''''''''' 'Variable local Private m_Vista As Long Public Archivo As String 'constantes para las versiones de windows Private Const VER_PLATFORM_WIN32_NT As Long = 2 Private Const OSV_LENGTH As Long = 76 Private Const OSVEX_LENGTH As Long = 88 Public OSV_VERSION_LENGTH As Long 'our const to hold appropriate OSV length 'Estructura OSVERSIONINFO Private Type OSVERSIONINFO OSVSize As Long dwVerMajor As Long dwVerMinor As Long dwBuildNumber As Long PlatformID As Long szCSDVersion As String * 128 End Type 'Declaración mensajes y notificaciones Private Const WM_COMMAND = &H111 Public Const WM_NOTIFY As Long = &H4E& Public Const WM_INITDIALOG As Long = &H110 Public Const CDN_FIRST As Long = -601 Public Const CDN_INITDONE As Long = (CDN_FIRST - &H0&) Public Const MAX_PATH As Long = 260 'Constantes para openfilename Public Const OFN_ENABLEHOOK As Long = &H20 Public Const OFN_EXPLORER As Long = &H80000 Public Const OFN_ENABLESIZING As Long = &H800000 Public Const OFN_EX_NOPLACESBAR As Long = &H1 'Declaración de la estructura OPENFILENAME Public Type OPENFILENAME nStructSize As Long hwndOwner As Long hInstance As Long sFilter As String sCustomFilter As String nMaxCustFilter As Long nFilterIndex As Long sFile As String nMaxFile As Long sFileTitle As String nMaxTitle As Long sInitialDir As String sDialogTitle As String Flags As Long nFileOffset As Integer nFileExtension As Integer sDefFileExt As String nCustData As Long fnHook As Long sTemplateName As String pvReserved As Long dwReserved As Long flagsEx As Long End Type 'Variable para utilizar la estructura OPENFILENAME que tiene _ los datos para el Commondialog de windows Public OFN As OPENFILENAME 'Api GetVersionEx para recuperar la version del sistema operativo Private Declare Function GetVersionEx Lib "kernel32" _ Alias "GetVersionExA" _ (lpVersionInformation As Any) As Long 'Api GetOpenFileName para el CommonDialog Public Declare Function GetOpenFileName Lib "comdlg32.dll" _ Alias "GetOpenFileNameA" _ (pOpenfilename As OPENFILENAME) As Long 'Api FindWindowEx Private Declare Function FindWindowEx Lib "user32" _ Alias "FindWindowExA" _ (ByVal hWndParent As Long, _ ByVal hWndChildAfter As Long, _ ByVal lpClassName As String, _ ByVal lpWindowName As String) As Long 'Api GetParent Private Declare Function GetParent Lib "user32" _ (ByVal hWnd As Long) As Long 'Api SendMessage Private Declare Function SendMessage Lib "user32" _ Alias "SendMessageA" _ (ByVal hWnd As Long, _ ByVal wMsg As Long, _ ByVal wParam As Long, _ lParam As Any) As Long Public Function Abrir(form As Object, m_DialogTitle As String, _ m_Filter As String, m_InitDir As String, _ Vista As Long, m_Flags, m_FileName, m_FileTitle _ As String) As String Dim sFilters As String Dim OFN As OPENFILENAME If m_Flags = 0 Then m_Flags = OFN_EXPLORER Or OFN_ENABLEHOOK Or OFN_ENABLESIZING End If If OSV_VERSION_LENGTH = 0 Then SetOSVersion 'reemplazamos el caracter | por un chr(0) para el Filtro sFilters = Replace(m_Filter, "|", Chr$(0)) m_Vista = Vista2(Vista) 'llenamos la estructura OpenFileName con los datos de los parámetros y otros With OFN .nStructSize = OSV_VERSION_LENGTH 'Hwnd del formulario que utiliza el commondialog .hwndOwner = form.hWnd 'Propiedad Filter .sFilter = sFilters + Chr$(0) .nFilterIndex = 0 If m_FileName = "" Then m_FileName = vbNullChar End If .sFile = m_FileName & Space$(MAX_PATH) & vbNullChar & vbNullChar .nMaxFile = Len(.sFile) .sDefFileExt = "*.bmp" & vbNullChar & vbNullChar .sFileTitle = vbNullChar & Space$(512) & vbNullChar & vbNullChar .nMaxTitle = Len(OFN.sFileTitle) 'directorio inicial del CommonDialog .sInitialDir = m_InitDir & vbNullChar & vbNullChar 'Titulo del CommonDialog .sDialogTitle = m_DialogTitle 'flags del CommonDialog .Flags = m_Flags 'Dirección del Hook .fnHook = FARPROC(AddressOf OFNHookProc) End With Call GetOpenFileName(OFN) If Asc(Mid(OFN.sFile, 1, 1)) <> 0 Then Abrir = Trim$(Replace(OFN.sFile, Chr$(0), vbNullString)) Archivo = Trim$(Replace(OFN.sFileTitle, Chr$(0), vbNullString)) Else Abrir = "" End If End Function Public Function Vista2(ByVal Valor As Long) As Long 'VISTA_LISTA = 28715 'vista Lista 'VISTA_MOSAICO = 28718 'vista de Mosaicos 'VISTA_THUMBNAIL = 28717 ' vista Thumbnail - Vista miniatura 'VISTA_ICONOS = 28713 'vista de iconos 'VISTA_DETALLE = 28716 'vista detallada Select Case Valor Case 0: Vista2 = 28715 Case 1: Vista2 = 28718 Case 2: Vista2 = 28717 Case 3: Vista2 = 28713 Case 4: Vista2 = 28716 End Select End Function Public Function FARPROC(pfn As Long) As Long FARPROC = pfn End Function Public Function IsWin2000Plus() As Boolean Dim osv As OSVERSIONINFO osv.OSVSize = Len(osv) If GetVersionEx(osv) = 1 Then IsWin2000Plus = (osv.PlatformID = VER_PLATFORM_WIN32_NT) And _ (osv.dwVerMajor = 5 And osv.dwVerMinor >= 0) End If End Function Public Function OFNHookProc(ByVal hWnd As Long, _ ByVal uMsg As Long, _ ByVal wParam As Long, _ ByVal lParam As Long) As Long Dim hWndParent As Long Dim hwndLv As Long Static bLvSetupDone As Boolean Select Case uMsg Case WM_INITDIALOG bLvSetupDone = False Case WM_NOTIFY If bLvSetupDone = False Then 'Hwnd del CommonDialog hWndParent = GetParent(hWnd) hwndLv = FindWindowEx(hWndParent, 0, "SHELLDLL_DefView", vbNullChar) If hwndLv > 0 Then Call SendMessage(hwndLv, WM_COMMAND, ByVal m_Vista, ByVal 0&) bLvSetupDone = True End If End If Case Else End Select End Function Public Sub SetOSVersion() Select Case IsWin2000Plus() Case True OSV_VERSION_LENGTH = OSVEX_LENGTH Case Else OSV_VERSION_LENGTH = OSV_LENGTH End Select End Sub

Pasos para probarlo desde un formulario en un proyecto EXE

Desde el Menú Archivo elegir la opción Agregar Proyecto y seleccionar Proyecto de tipo Exe , para de este modo tener un grupo de proyectos.

En la ventana se verá algo por el estilo:

vista previa del explorador de proyectos de visual basic

Serciorarse que el formulario del proyecto EXE, está establecido como Objeto Inicial ( para que arranque primero )

vista del explorador de proyectos para establecer el EXE como proyecto inicial al ejecutar el programa

Agregar una instancia del control en el formulario para poder usarlo.

Importante: Si ves que el control Ocx está deshabilitado y no lo puedes agregar al formulario , debes cerrar la ventana del diseñador del control ocx, de lo contrario no podrás insertar una instancia de dicho control, ni tampoco manipularlo.

Código en el Form1

'*************************************************************************** '* Nombre : CommonDialog con diferentes tipo de vistas '* Description : 'Nota: la propiedad que define las diferentes estilos de _ Vistas "Vista" y tiene los posibles valores: _ ' Autor: Luciano LE '*************************************************************************** Private Sub Command1_Click() With CdView1 .DialogTitle = "Seleccionar archivo" 'Extenciones .Filter = "Archivos (*.Jpg)|*.jpg|Archivos (*.Bmp)|*.Bmp|All Files (*.*)|*.*" 'directorio inicial .InitDir = "c:\windows\web\wallpaper" 'Vista de archivos en miniatura CdView1.Vista = VISTA_THUMBNAIL End With 'Abrimos el CommonDialog pasandole el Formulario como parámetro CdView1.ShowOpen Me 'Mostramos el archivo y la ruta seleccionado MsgBox CdView1.FileName 'Mostramos solo el nombre del archivo seleccionado MsgBox CdView1.FileTitle End Sub

Buscar en Recursos vb