Sección de controles Ocx para Visual basic , Dll , Activex

220 - cDlgMultiselect - Seleccionar ficheros desde diferentes ubicaciones en un diálogo de sistema para abrir archivos

<Volver> - Anterior - Siguiente

---

 

 

Este ejemplo en vb puede ser útil si en alguna ocasión se desea que el usuario del programa pueda, desde un cuadro de diálogo de sistema para abrir archivos, seleccionar todos los ficheros que desee, pero seleccionándolos desde diferentes directorios y ubicaciones de la pc, de forma que pueda añadirlos todos en un control de lista y luego retornarlos a la aplicación.

El cuadro de diálogo contiene incrustado un control ListBox donde se pueden arrastrar los archivos, desde la lista de carpetas y ficheros de windows ( control Listview del CD - sysListview32 ). Luego , al presionar el botón Aceptar , se obtiene en una cadena, todos los archivos incluidos en la lista para poder trabajarlos en el programa.

El módulo prácticamente no contiene opciones y es muy fácil de usar, inclusive hay algunas cosas del código que se pueden mejorar mucho, como por ejemplo poder crear todos los controles mediante el api de windows, y no tener que hacerlo con controles de vb mediante los métodos Controls.Add etc .. ( Creo que se podrían crear sin problemas con la función createWindowsEx y hacer un subclassing a cada control, pero no estoy seguro, ya que no le he probado ).

Algunas Notas

Para llamar al diálogo se debe ejecutar la función showDialog. Si se presionó el botón ' Aceptar , la función devuelve el valor True, si no el valor False.

Luego de cerrar el diálogo y poder obtener la lista de ficheros, se debe consultar la variable FileNames. Esta variable contiene toda la lista de archivos, donde cada archivo o ruta se encuentra separado mediante un caracter nulo ( Chr (0)), por ejemplo:

: "Archivo.txt" + chr(0) + "OtroArchivo.txt" + Chr(0) , etc..

Entonces, luego se puede utilizar la función Split de visual basic para obtener en un array cada uno de los valores.

Nota. Por defecto el CD visualiza todos las extensiones de archivo. Si se desea pasar los filtros de extensiones propios, se debe hacer como se utilizan mediante las apis, no como el control ComonDialog de vb.

Por ejemplo :

    Set cCDMS = New cDlgMultiselect
    With cCDMS
        ' establecer filtros para tipos de archivos de SQL y extensión MDF
        Dim sFilters As String
        sFilters = "Archivo SQL" & Chr(0) & "*.sql" & Chr(0)
        sFilters = sFilters & "Archivos MDF" & Chr(0) & "*.mdf"
        
        ' Mostrar diálogo
        If .ShowDialog(Me, sFilters, True) Then
        
        ' .......................   

 

Ejemplo

>> Código fuente del módulo de clase

Créditos

• Giorgio Brausi : Código base para subclasificar el diálogo de windows.
• Paul Caton : Para poder usar el CallBack desde el módulo de clase.

 

---

Capturas de pantalla

 

 

---

 

Código fuente - Ejemplo

• Crear un nuevo proyecto
• Añadir al formulario : Un Control CommandButton ( Command1 ) , un Control ListBox ( List1 )
• Agregar un módulo de clase : Cambiarle el nombre a : cDlgMultiselect

 

Código fuente en el formulario

Option Explicit

'\\ Declaraciones
' -------------------------------------------------------------------------
Private cCDMS As cDlgMultiselect

'\\ Mostrar diálogo
' -------------------------------------------------------------------------
Private Sub Command1_Click()
    
    Set cCDMS = New cDlgMultiselect
    With cCDMS
        ' Mostrar los nombres incluyendo la ruta
           .ListMode = eFullPaths
        ' Abrir el CD. Si retorna True, es por que se pesionó el botón 'Aceptar'
        If .ShowDialog(Me, , True) Then
            ' Verificar si hay archivos ...
            If Len(.FileNames) Then
                ' Desgplozar el array
                Dim arrFiles() As String
                arrFiles = Split(.FileNames, Chr(0))
                Dim i As Integer
                ' Recorrer el array
                For i = 0 To UBound(arrFiles)
                    ' .. agregar los archivos
                    If Len(arrFiles(i)) Then
                        List1.AddItem arrFiles(i)
                    End If
                Next
            End If
        End If
    End With
    Set cCDMS = Nothing
End Sub

' \\ Eliminar referencias
' -----------------------------------------------------------------------------
Private Sub Form_Unload(Cancel As Integer)
    
    Set cCDMS = Nothing
End Sub
  

 

 

Código fuente en el módulo de clase

Option Explicit

'===============================================================================
' ---------------------------------------------------------------
' \\ Descripción : Ejemplo para selección de múltiples archivos _
                   desde diferentes ubicaciones mediante un cuadro _
                   de diálogo  de windows 'Abrir archivo'
' \\ Autor       : Luciano Lodola
'                  http://www.recursosvisualbasic.com.ar/
' ---------------------------------------------------------------
' \\   Créditos:
'      -> Paul Caton         : Código para implementar el Hook _
                               del cuadro de diálogo dentro del módulo de clase
         
'      -> Giorgio Brausi     : Código para hacer el hook al CD de windows
' ---------------------------------------------------------------
'===============================================================================


'===============================================================================
' \\ Declaraciones
'===============================================================================


'===============================================================================
' \\ Constantes
'===============================================================================

' Constante para sendMessage( para la barra del listbox )
Private Const LB_SETHORIZONTALEXTENT = &H194
' Constantes para sendMessage( para cerrar una ventana a partir del handle, la del CD )
Private Const WM_SYSCOMMAND = &H112
Private Const SC_CLOSE = &HF060&
' Constantes para usar con setWindowLong ( Establer borde Flat para el listbox )
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOSIZE = &H1
Private Const GWL_EXSTYLE = (-20)
Private Const WS_EX_CLIENTEDGE = &H200
Private Const WS_EX_STATICEDGE = &H20000
Private Const SWP_FRAMECHANGED = &H20
Private Const SWP_NOACTIVATE = &H10
Private Const SWP_NOZORDER = &H4
Private Const SWP_DRAWFRAME = SWP_FRAMECHANGED

Private Const SWP_FLAGS = SWP_NOZORDER Or _
                          SWP_NOSIZE Or _
                          SWP_NOMOVE Or _
                          SWP_DRAWFRAME
  
Private Const WM_USER = &H400
' Valores de flags para el CD
Private Const OFN_ALLOWMULTISELECT As Long = &H200 ' permite multiselección
Private Const CDM_FIRST = (WM_USER + 100)          ' mensajes( no se para que es)
Private Const CDM_GETFILEPATH = (CDM_FIRST + &H1)
Private Const CDN_FIRST = (-601)
Private Const CDN_LAST = (-699)
Private Const CDN_INITDONE = (CDN_FIRST - &H0)     ' Mensaje cuando inicia el CD
Private Const CDN_SELCHANGE = (CDN_FIRST - &H1)    ' Mensaje Cuando se cambia el filtro
Private Const CDN_FOLDERCHANGE = (CDN_FIRST - &H2)
Private Const CDN_SHAREVIOLATION = (CDN_FIRST - &H3)
Private Const CDN_HELP = (CDN_FIRST - &H4)

' ,Mensaje Cuando se presiona el botón Abrir o se hace doble clic en el archivo ( No se usa )
Private Const CDN_FILEOK = (CDN_FIRST - &H5)
Private Const CDN_TYPECHANGE = (CDN_FIRST - &H6)
' Notificación de cualquier mensaje que se produzca
Private Const WM_NOTIFY = &H4E
' flag para la estructura de la función getOpenFileName ( Permite activar el Hook )
Private Const OFN_ENABLEHOOK = &H20
' Varios ( Ver descripción desde el examinador de propiedades con un CommonDLG _
  Creo que son las mismas
Private Const OFN_HIDEREADONLY = &H4
Private Const OFN_PATHMUSTEXIST = &H800
Private Const OFN_FILEMUSTEXIST = &H1000
Private Const OFN_EXPLORER = &H80000
Private Const OFN_LONGNAMES = &H200000
Private Const SWP_SHOWWINDOW = &H40
Private Const lst1 = &H460

' \\ Constantes del módulo cSuperClass
' Ubound(callback thunkdata)+1, index of the callback
Private Const IDX_CALLBACKORDINAL As Long = 22
Private Const WM_DESTROY As Long = &H2
Private Const SEE_MASK_INVOKEIDLIST = &HC
Private Const SEE_MASK_NOCLOSEPROCESS = &H40
Private Const SEE_MASK_FLAG_NO_UI = &H400
  

'=======================================================================
' \\ Fin de constantes
'=======================================================================



'=======================================================================
' \\ Types y Enums
'=======================================================================

' Estructura de datos para la función ShellExecuteEx
Private Type SHELLEXECUTEINFO
    cbSize As Long
    fMask As Long
    hwnd As Long
    lpVerb As String
    lpFile As String
    lpParameters As String
    lpDirectory As String
    nShow As Long
    hInstApp As Long
    lpIDList As Long
    lpClass As String
    hkeyClass As Long
    dwHotKey As Long
    hIcon As Long
    hProcess As Long
End Type
'Para usar con screenToclient y obtener coordenadas del sysListview32 del CD
Private Type POINTAPI
  x As Long
  y As Long
End Type
' Para almacenar los valores de las dimensiones ( Para las ventanas del CD)
Private Type RECT
  Left As Long
  Top As Long
  Right As Long
  Bottom As Long
End Type
' Enum para mostrar los archivos solo por el nombre con el path completo en la lista
Enum eListMode
    [eFileTitle] = 0
    [eFullPaths] = 1
    
End Enum

' Estructura de datos para getopenFileName
Private Type OPENFILENAME
    lStructSize As Long
    hwndOwner As Long
    hInstance As Long
    lpstrFilter As String
    lpstrCustomFilter As String
    nMaxCustFilter As Long
    nFilterIndex As Long
    lpstrFile As String
    nMaxFile As Long
    lpstrFileTitle As String
    nMaxFileTitle As Long
    lpstrInitialDir As String
    lpstrTitle As String
    flags As Long
    nFileOffset As Integer
    nFileExtension As Integer
    lpstrDefExt As String
    lCustData As Long
    lpfnHook As Long
    lpTemplateName As String
End Type
Private Type OPENFILENAME2
    lStructSize As Long
    hwndOwner As Long
    hInstance As Long
    lpstrFilter As Long
    lpstrCustomFilter As Long
    nMaxCustFilter As Long
    nFilterIndex As Long
    lpstrFile As Long
    nMaxFile As Long
    lpstrFileTitle As Long
    nMaxFileTitle As Long
    lpstrInitialDir As Long
    lpstrTitle As Long
    flags As Long
    nFileOffset As Integer
    nFileExtension As Integer
    lpstrDefExt As Long
    lCustData As Long
    lpfnHook As Long
    lpTemplateName As Long
End Type
' Types para el Hook
Private Type NMHDR
    hwndFrom As Long
    idFrom As Long
    code As Long ' Este valor es el código del mensaje
End Type
Private Type OFNOTIFY
    hdr As NMHDR
    lpOFN As OPENFILENAME2
    pszFile As Long
End Type

'=====================================================================
' \\ Fin de Types y Enums
'=====================================================================


'=====================================================================
' \\ Apis
'=====================================================================

' Paa cerrar el diálogo de windows
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

' Para ocultar el textbox del el diálogo de windows y otros
Private Declare Function ShowWindow _
    Lib "user32" ( _
    ByVal hwnd As Long, _
    ByVal nCmdShow As Long) As Long
' Para enumerar los controles del CD
Private Declare Function EnumChildWindows _
    Lib "user32" ( _
    ByVal hWndParent As Long, _
    ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
' para obtener el nombre de clase de una ventana
Private Declare Function GetClassName _
    Lib "user32" Alias "GetClassNameA" ( _
    ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
' Usos varios - Se usa para cambiar el borde del listbox
Private Declare Function GetWindowLong _
    Lib "user32" Alias "GetWindowLongA" ( _
    ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong _
    Lib "user32" Alias "SetWindowLongA" ( _
    ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
' Para cambiar la posición de una ventana
Private Declare Function MoveWindow _
    Lib "user32" ( _
    ByVal hwnd As Long, ByVal x As Long, ByVal y As Long, _
    ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long
' Usos varios - Se usa para abrir el cuadro de diálogo de propiedades de archivo
Private Declare Function ShellExecuteEX _
    Lib "shell32.dll" Alias "ShellExecuteEx" ( _
    SEI As SHELLEXECUTEINFO) As Long
' Para obtener solo el nombre de un archivo pasándole el Path completo
Private Declare Function GetFileTitle _
    Lib "comdlg32.dll" Alias "GetFileTitleA" ( _
    ByVal lpszFile As String, ByVal lpszTitle As String, _
    ByVal cbBuf As Integer) As Integer
Private Declare Function CommDlgExtendedError Lib "comdlg32.dll" () As Long
' Obtener Handle de la ventana padre
Private Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long
' Para recuperar el handle de los controles del cuadro de diálogo
 '(Para el listview)
Private Declare Function GetDlgItem _
    Lib "user32" (ByVal hDlg As Long, _
    ByVal nIDDlgItem As Long) As Long
' Obtener dimensiones y posiciónd de una ventana
Private Declare Function GetWindowRect _
    Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
' Para ubicar la nueva posición del CD
Private Declare Function SetWindowPos _
    Lib "user32" (ByVal hwnd As Long, _
    ByVal hWndInsertAfter As Long, ByVal x As Long, _
    ByVal y As Long, ByVal cx As Long, _
    ByVal cy As Long, ByVal wFlags As Long) As Long
' Para obtener el path seleccionado en el listview ( no se usa )
Private Declare Function SendMessageByString _
    Lib "user32" Alias "SendMessageA" ( _
    ByVal hwnd As Long, ByVal wMsg As Long, _
    ByVal wParam As Long, ByVal lParam As String) As Long
' Para incrustar una ventana en otra
Private Declare Function SetParent _
    Lib "user32" (ByVal hwndChild As Long, ByVal hWndNewParent As Long) As Long
' Para cmabiar las cordenadas absolutas a las cordenadas de la ventana
Private Declare Function ScreenToClient _
    Lib "user32" ( _
    ByVal hwnd As Long, lpPoint As POINTAPI) As Long
' Para saber si e sun directorio
Private Declare Function PathIsDirectory _
    Lib "shlwapi.dll" Alias "PathIsDirectoryA" (ByVal pszPath As String) As Long
' Se usa para devolver el código de los mensajes en el procedimiento de notificación
Private Declare Sub CopyMemory2 _
    Lib "kernel32" Alias "RtlMoveMemory" ( _
    Dest As Any, ByVal Source As Any, ByVal Length As Long)
' Para abrir el CD
Private Declare Function GetOpenFileName _
    Lib "comdlg32.dll" Alias "GetOpenFileNameA" ( _
    pOpenfilename As OPENFILENAME) As Long

' Para el módulo cSuperClass ( ni idea )
Private Declare Sub RtlMoveMemory _
    Lib "kernel32" ( _
    ByVal Destination As Long, ByVal Source As Long, ByVal Length As Long)
Private Declare Function IsBadCodePtr _
    Lib "kernel32" (ByVal lpfn As Long) As Long
Private Declare Function VirtualAlloc _
    Lib "kernel32" ( _
    ByVal lpAddress As Long, ByVal dwSize As Long, _
    ByVal flAllocationType As Long, ByVal flProtect As Long) As Long
Private Declare Function GetModuleHandleA _
    Lib "kernel32" (ByVal lpModuleName As String) As Long
Private Declare Function GetModuleHandleW _
    Lib "kernel32" (ByVal lpModuleName As Long) As Long
Private Declare Function GetProcAddress _
    Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long

'========================================================================================
' \\ Fin de Apis
'========================================================================================


'========================================================================================
' \\ Variables , miembros
'========================================================================================



' \\ Vars de cSuperclass
' -----------------------------------------------------------------------------------
'Flag indicating we are in IDE
Private z_IDEflag                           As Long
'Thunk base address
Private z_ScMem                             As Long
'callback/thunk-address collection
Private z_cbFunk                            As Collection

' Control de lista para los archivos
Private WithEvents mListBox                 As ListBox
' Control contenedor con la botonera
Private mPicButtons                         As PictureBox
' Referencia al formulario
Private mform                               As Form
' Botones de Eliminar, Aceptar y cancelar el cuadro de diálogo
Private WithEvents mCmdDelete               As CommandButton
Private WithEvents mCmdDeleteAll            As CommandButton
Private WithEvents mCmdOk                   As CommandButton
Private WithEvents mCmdCancel               As CommandButton
' Colección para guardar los archivos
Private mColFiles                           As Collection
' Hndles varios
Private mHwnd_CDParent                      As Long
Private mHwnd2                              As Long
' Propiedad local para los ficheros
Private mFileNames                          As String
' Valor que indica si se presionó el botón 'Aceptar' o se canceló
Private mOk                                 As Boolean
' Variable para el modo de visualización de los items( path completo o solo el nombre )
Private mListMode                           As eListMode



'========================================================================================
' Funciones, Subs , propiedades
'========================================================================================


' \\ - Propiedad con los archivos ( separados por un caracter nulo  chr(0))
' ----------------------------------------------------------------------------------------
Property Get FileNames() As String
    FileNames = mFileNames
End Property

' \\ Propiedad para Mostrar los archivos con la ruta completa o solo el nombre
' ----------------------------------------------------------------------------------------
Property Get ListMode() As eListMode
    ListMode = mListMode
End Property

Property Let ListMode(lValue As eListMode)
    mListMode = lValue
End Property


' \\ Aplicar estilo flat al listbox ( por que compilado pierde el borde)
' ----------------------------------------------------------------------------------------

Private Sub setFlat(ByVal hwnd As Long)
    Dim lStyle As Long
    lStyle = GetWindowLong(hwnd, GWL_EXSTYLE)
    lStyle = lStyle And Not WS_EX_CLIENTEDGE Or WS_EX_STATICEDGE
    Dim lRet As Long
    lRet = SetWindowLong(hwnd, GWL_EXSTYLE, lStyle)
    If lRet Then
        SetWindowPos hwnd, 0, 0, 0, 0, 0, _
            SWP_NOACTIVATE Or _
            SWP_NOZORDER Or _
            SWP_FRAMECHANGED Or _
            SWP_NOSIZE Or _
            SWP_NOMOVE
    End If
End Sub

' \\ Agregar scrollBar horizontal  al listbox
'    (para poder visualizarlo si el path es muy largo)
' ----------------------------------------------------------------------------------------

Private Sub setListBoxScrollBar()
    Dim lRet As Long
    Dim i As Integer
    Dim lMaxWidth As Long
    Dim lTextWidth As Long
    Dim lTextHeight As Long
    
    With mListBox
        ' recorrer todos los elementos de la lista
        For i = 0 To .ListCount - 1
            ' Valor del ancho del texto en pixeles
            lTextWidth = mform.TextWidth(.List(i))
            ' Almacenar el valor mas ancho
            If lTextWidth > lMaxWidth Then lMaxWidth = lTextWidth + 10
        Next
        ' Establecer el scroll
        lRet = SendMessage(.hwnd, LB_SETHORIZONTALEXTENT, lMaxWidth, ByVal 0&)
    End With

End Sub

' \\ Crear nueva colección para los archivos
' -----------------------------------------------------------------------------
Private Sub Class_Initialize()
    Set mColFiles = New Collection
End Sub

Private Sub Class_Terminate()
    Set mColFiles = Nothing
End Sub

' \\ Botón para cancelar
' -----------------------------------------------------------------------------

Private Sub mCmdCancel_Click()
    mOk = False
    ' Enviar el mensaje SC_CLOSE para cerrar la ventana
    Call SendMessage(mHwnd_CDParent, WM_SYSCOMMAND, SC_CLOSE, ByVal 0&)
End Sub

' \\ Botón para aceptar, retornar los archivos y salir
' -----------------------------------------------------------------------------
Private Sub mCmdOk_Click()
    Dim xItem As Variant
    Dim sTempFiles As String
    ' Recorrer todos los items de la colección
    For Each xItem In mColFiles
        ' almacenar cada item y agregarle un NullChar
        sTempFiles = sTempFiles & xItem & Chr(0)
    Next
    ' Guardar el valor para leerlo después de cerrar el CD
    mFileNames = sTempFiles
    mOk = True
    Dim lRet As Long
    ' Cerrar la ventana de CD
    lRet = SendMessage(mHwnd_CDParent, WM_SYSCOMMAND, SC_CLOSE, ByVal 0&)
End Sub

' \\ Botón para eliminar el archivo seleccionado de la lista
' -----------------------------------------------------------------------------

Private Sub mCmdDelete_Click()
    With mListBox
        If .ListIndex <> -1 Then
            ' REmover el item en la colección
            mColFiles.Remove .ListIndex + 1
            ' Volver a cargar la colección de archivos en el control de lista
            Call mLoadCollection(mColFiles)
        End If
    End With
    ' Activar o desactivar botones
    Call mEnabledButtons
End Sub

' \\ Botón para eliminar todos los archivos de la lista
' -----------------------------------------------------------------------------

Private Sub mCmdDeleteAll_Click()
    With mColFiles
        ' ntes de eliminar , comprobar que hay elementos ...
        If .Count > 0 Then
            ' Preguntar
            If MsgBox("¿ Eliminar todos los archivos ?", vbQuestion + vbYesNo) = vbYes Then
                ' Mientras haya, eliminar siempre el primero hasta que no haya mas
                While .Count <> 0
                    .Remove 1
                Wend
                ' limpiar listbox
                mListBox.Clear
            End If
        End If
    End With
    ' Deshabilitar botonera
    Call mEnabledButtons
End Sub


' \\ REcibir los archivos arrastrados
' -----------------------------------------------------------------------------
 
Private Sub mListBox_OLEDragDrop( _
    Data As DataObject, _
    Effect As Long, _
    Button As Integer, _
    Shift As Integer, _
    x As Single, y As Single)
    
    Dim i As Integer
    With Data
        ' Comprobar el formato de los datos que se arrastran desde el listview
        If .GetFormat(vbCFFiles) Then
            For i = 1 To .Files.Count
                ' Comprobar que no sea un directorio, si no lo es, agregarlo a la colección
                If PathIsDirectory(.Files(i)) = 0 Then
                    Call mAddValueCollection(mColFiles, .Files(i))
                End If
            Next
            ' Volver a cargar todo los items de la colección  la lista
            Call mLoadCollection(mColFiles)
            ' Habilitar botones
            Call mEnabledButtons
        End If
    End With
End Sub

' \\ Habilitar / deshabilitar los botones ( Eliminar, Aceptar y cancelar )
' -----------------------------------------------------------------------------
Private Sub mEnabledButtons()
    mCmdDelete.Enabled = Abs(mListBox.ListCount)
    mCmdDeleteAll.Enabled = Abs(mListBox.ListCount)
    mCmdOk.Enabled = Abs(mListBox.ListCount)
End Sub


' \\ Agregar nuevo valor a  la colección de archivos
' ----------------------------------------------------------------------------------------
Private Sub mAddValueCollection(pCol As Collection, vValue As Variant)
On Error GoTo error_handler
    With pCol
        If .Count > 0 Then
            .Add vValue, vValue, 1 'poner primero
        Else
            .Add vValue, vValue
        End If
    End With
    Exit Sub
    ' Error cuando se intenta añadir un elemento que ya existia
error_handler:
    If Err.Number = 457 Then
        Resume Next
    Else
        MsgBox Err.Description, vbCritical
    End If
End Sub

' \\ Cargar la colección de archivos en el lstbox
' -----------------------------------------------------------------------------
Private Sub mLoadCollection(pCol As Collection)
    With mListBox
    
        .Clear

        Dim vItem As Variant
        ' REcorrer los items de la colección
        For Each vItem In pCol
            ' chequear el modo ( solo archivos o con la ruta completa )
            If mListMode = eFileTitle Then
                .AddItem Me.GetFileTitles(vItem)
            Else
                .AddItem vItem
            End If
        Next
        If .ListCount > 0 Then
            Call setListBoxScrollBar
           ' seleccionar el primer elemento luego de arrastrar los ficheros
           .ListIndex = 0
        End If
    End With
End Sub

' \\ Devolver solo el nombre del archivo desde la ruta completa
' -----------------------------------------------------------------------------
Function GetFileTitles(ByVal sFilePath As String) As String
    
    Dim sBuffer     As String
    Dim lRet        As Long
    ' Crear buffer para el nombre
    sBuffer = String(255, 0)
    If Len(sFilePath) Then
        ' Enviar el Buffer y el path
        lRet = GetFileTitle(sFilePath, sBuffer, Len(sBuffer))
        ' Quitar los nulos y retornar el nombre
        GetFileTitles = mTrimNull(sBuffer)
    End If
End Function

' \\ Función inicial para llamar al cuadro de diálogo
' -----------------------------------------------------------------------------

Function ShowDialog( _
    ByVal OwnerForm As Form, _
    Optional sFilters As String = "*.*", _
    Optional bAllowMultiSelect As Boolean = True, _
    Optional sInitialDir As String = vbNullString, _
    Optional sTitle As String = "Seleccionar archivos", _
    Optional lIndex As Long = 0)
    
    Dim oldFrmScale As Integer
    Dim oldFont As StdFont
    ' Cambiar escala del form temporalmente y también la fuente
    With OwnerForm
        oldFrmScale = .ScaleMode
        .ScaleMode = vbPixels
         Set oldFont = .Font
        .Font.Name = "MS Sans Serif"
        .Font.Size = 8
        .FontBold = False
        .Font.Italic = False
        .FontStrikethru = False
        .FontUnderline = False
    End With
    
    Dim lFlags As Long
    Dim sFileName As String
    ' Asignar los flags para el CD
    lFlags = OFN_EXPLORER Or _
            OFN_HIDEREADONLY Or _
            OFN_LONGNAMES Or _
            OFN_PATHMUSTEXIST Or _
            OFN_ENABLEHOOK Or _
            OFN_FILEMUSTEXIST
    ' Si se pasó como parámetro , permite selección múltiple de archivos
    If bAllowMultiSelect Then
        lFlags = lFlags Or OFN_ALLOWMULTISELECT
    End If
    
    'Si no se pasó el argumento de filtros, usar todos
    If sFilters = "*.*" Then
       sFilters = " Todos los archivos *.*" & Chr(0) & "*.*"
    End If
    
    Dim OFN As OPENFILENAME
    Dim szFile As String
    Dim lRet As Long
    
    szFile = sFileName & String$(256 - Len(sFileName), 0)
    ' CArgar estructura de datos para getOpenFileName
    With OFN
        .lStructSize = Len(OFN)
        .hwndOwner = OwnerForm.hwnd
        .flags = lFlags
        .lpstrFilter = sFilters & vbNullChar
        .nFilterIndex = lIndex
        .lpstrFile = szFile
        .nMaxFile = Len(szFile$)
        .lpstrFileTitle = szFile$ & vbNullChar
        .lpstrInitialDir = sInitialDir & vbNullChar
        .lpstrTitle = sTitle & vbNullChar
        .lpfnHook = scb_SetCallbackAddr(4, 1) ' Indica e inicia el procedimiento de Hook
    End With
    
    Set mform = OwnerForm
    ' Crear controles ( Botones, listbox y el picbox para la botonera )
    With mform.Controls
        Set mListBox = .Add("vb.listbox", "mListBox")
        Set mPicButtons = .Add("vb.picturebox", "mPicButtons")
        Set mCmdDelete = .Add("vb.Commandbutton", "mCmdDelete")
        Set mCmdDeleteAll = .Add("vb.Commandbutton", "mCmdDeleteAll")
        Set mCmdOk = .Add("vb.Commandbutton", "mCmdOk")
        Set mCmdCancel = .Add("vb.Commandbutton", "mCmdCancel")
    End With
    ' Habilitar el drag drop para el control
    With mListBox
        .OLEDropMode = 1
    End With
    ' Abrir el cuadro de diálogo
    Call GetOpenFileName(OFN)
    
    ' restaurar valores del formulario y terminar
    OwnerForm.ScaleMode = oldFrmScale
    Set OwnerForm.Font = oldFont
    
    ' \\ - Retornar
    ShowDialog = mOk
End Function


' \\ Función que procesa las acciones y eventos realizados en el CD ( lp contiene el mensaje )
' -----------------------------------------------------------------------------
Private Function CDNotify(ByVal hwnd As Long, ByVal lp As Long) As Long

    
    ' \\ Declaraciones
    ' -----------------------------------------------------------------------------
    Const MAX_PATH = 255
    
    Dim rc As RECT
    Dim rcDesk As RECT
    Dim rL As RECT
    Dim lpon As OFNOTIFY
    Dim hLV As Long
    Dim pt As POINTAPI
    
    ' -----------------------------------------------------------------------------
    
    Call CopyMemory2(lpon, lp&, Len(lpon))
    
    ' \\ Seleccionar acciones ejecutadas en el CD
    ' -----------------------------------------------------------------------------
    Select Case lpon.hdr.code
        
    
    ' \\ CDN_INITDONE : Se ejecuta una sola vez al Iniciar el CD _
        ( Redimensionar el CD y preparar los controles ( picbox y botones ) )
    ' -----------------------------------------------------------------------------
        Case CDN_INITDONE:
            
            If mHwnd2 <> hwnd Then mHwnd2 = hwnd
            
            mHwnd_CDParent = GetParent(hwnd)
            ' Enumerar ventanas del cuadro de diálogo
            Call EnumChildWindows(mHwnd_CDParent, scb_SetCallbackAddr(2, 2), ByVal 0&)
            ' Copiar en rc las dimensiones del CD
            Call GetWindowRect(mHwnd_CDParent, rc)
            ' Handle del LV
            hLV = GetDlgItem(mHwnd_CDParent, lst1)
            ' Copiar en rl las cordenadas y dimensiones del sysListview32
            Call GetWindowRect(hLV, rL)
            ' Cambiar los valores para que sean realitvos a la ventana
            pt.x = rL.Left
            pt.y = rL.Top
            
            Call ScreenToClient(mHwnd_CDParent, pt)
            ' Cambiar el acnho de la ventana
            rc.Right = rL.Right + mListBox.Width + (pt.x * 4) - 3
            ' Incrustar listbox y la botonera
            Call SetParent(mListBox.hwnd, mHwnd_CDParent)
            Call SetParent(mPicButtons.hwnd, mHwnd_CDParent)
            
            ' Rectángulo con las dimensiones de la pantalla ( se usa para centrar el CD )
            With rcDesk
               .Left = 0
               .Top = 0
               .Right = Screen.Width / Screen.TwipsPerPixelX
               .Bottom = Screen.Height / Screen.TwipsPerPixelY
            End With
            ' Cambiar tamaño del listview ( sysListview32 )
            Call SetWindowPos(hLV, 0, pt.x, pt.y, 300, 170, ByVal 0&)
                                        
            ' Cambiar tamaño del control del listbox y establecer posición
            With mListBox
                .Height = 173 * Screen.TwipsPerPixelY
                .Width = 300 * Screen.TwipsPerPixelY
                .Left = 310 * Screen.TwipsPerPixelX
                .Top = pt.y * Screen.TwipsPerPixelY
            End With
            
            ' Cambiar tamaño del control picbox ( botonera ) y establecer posición
            With mPicButtons
                .Top = mListBox.Height + mListBox.Top + 2
                .Width = mListBox.Width
                .Left = mListBox.Left
                .Height = 25 * 15
                .BorderStyle = 0
            End With
            ' Incrustar botones en la botonera ( en el picbox )
            With mCmdDelete
                Call SetParent(.hwnd, mPicButtons.hwnd)
                .Move 10, 10, 1000, mPicButtons.ScaleHeight - 10
            End With
            With mCmdDeleteAll
                Call SetParent(.hwnd, mPicButtons.hwnd)
                .Move (mCmdDelete.Left + mCmdDelete.Width + 50), 10, 1300, _
                      (mPicButtons.ScaleHeight - 10)
            End With
            With mCmdOk
                Call SetParent(.hwnd, mPicButtons.hwnd)
                .Width = 1000
                .Move (mPicButtons.ScaleWidth - (.Width + 1050)), 10, .Width, _
                      (mPicButtons.ScaleHeight - 10)
            End With
            With mCmdCancel
                Call SetParent(.hwnd, mPicButtons.hwnd)
                .Width = 1000
                .Move (mPicButtons.ScaleWidth - (.Width)), 10, .Width, _
                      (mPicButtons.ScaleHeight - 10)
                .Tag = 0
            End With
            
            ' establecer posición y dimensiones del CD
            SetWindowPos _
                (mHwnd_CDParent), 0, _
                (rcDesk.Right - (rc.Right - rc.Left)) / 2, _
                (rcDesk.Bottom - (rc.Bottom - rc.Top)) / 2, _
                (rc.Right - rc.Left) + 70, _
                (rc.Bottom - rc.Top - 5), SWP_SHOWWINDOW
            
            ' Propiedades varias de los controles
            With mListBox
                .Visible = True
                setFlat .hwnd
            End With
            With mPicButtons
                .Visible = True
            End With
            With mCmdDelete
                .Visible = True
                .Enabled = False
                .Caption = "Eliminar"
            End With
            With mCmdDeleteAll
                .Visible = True
                .Enabled = False
                .Caption = "Eliminar todos"
            End With
            With mCmdOk
                .Enabled = False
                .Visible = True
                .Caption = "Aceptar"
            End With
            With mCmdCancel
                .Visible = True
                .Caption = "Cancelar"
            End With
        
        ' \\ Mensaje Cuando se presiona el botón Abrir, o se hace doble clic en el archivo.
             '(No se produce cuando se cancela)
        ' -------------------------------------------------------------------------
        Case CDN_FILEOK:
            
        
        ' \\ Mensaje que se produce Cuando se selecciona un archivo de la lista
        ' -------------------------------------------------------------------------
        Case CDN_SELCHANGE:
    
    ' \\ Otras Acciones ...
    ' -----------------------------------------------------------------------------
               
          ' Se dispara cuando se cambia un valor desde la lista de filtros
          Case CDN_TYPECHANGE
            
          Case CDN_SHAREVIOLATION
            MsgBox "Error general!", vbCritical
    End Select
    
    Exit Function
    
error_handler:

End Function

' \\ Función para mostrar el Diálogo de sistema ' Propiedades de archivo '
' ---------------------------------------------------------------------------------

Function showDlgFileProperty(sFileName As String, Hwnd_Form As Long) As Long
    Dim SEI As SHELLEXECUTEINFO
    Dim RET As Long
    
    If Len(sFileName) = 0 Then Exit Function
    If Len(Dir(sFileName)) = 0 Then
       MsgBox "No se ha encontrado el archivo: " & sFileName, vbExclamation
       Exit Function
    End If
    
    With SEI
        .cbSize = Len(SEI)
        .fMask = SEE_MASK_NOCLOSEPROCESS Or SEE_MASK_INVOKEIDLIST Or SEE_MASK_FLAG_NO_UI
        .hwnd = Hwnd_Form
        .lpVerb = "properties"
        .lpFile = sFileName
        .lpParameters = vbNullChar
        .lpDirectory = vbNullChar
        .nShow = 0
        .hInstApp = 0
        .lpIDList = 0
        
        RET = ShellExecuteEX(SEI)
        showDlgFileProperty = .hInstApp
    End With
End Function

' \\ Eliminar caracteres nulos de los paths
' ---------------------------------------------------------------------------------
Private Function mTrimNull(sFilePath As String) As String
    Dim lPos As Long
    lPos = InStr(sFilePath, vbNullChar)
    If lPos > 0 Then mTrimNull = Left$(sFilePath, lPos - 1)
End Function


' \\ Subs , funciones de cSuperClass
' ----------------------------------------------------------------------------------


'-SelfCallback code-----------------------------------------------------------------
'-The following routines are exclusively for the scb_SetCallbackAddr routines-------
Private Function scb_SetCallbackAddr(ByVal nParamCount As Long, _
       Optional ByVal nOrdinal As Long = 1, _
       Optional ByVal oCallback As Object = Nothing, _
       Optional ByVal bIdeSafety As Boolean = True) As Long
    '*********************************************************************************
    '* nParamCount  - The number of parameters that will callback
    '* nOrdinal     - Callback ordinal number, the final private method is ordinal 1, _
       the second last is ordinal 2, etc...
    '* oCallback    - Optional, the object that will receive the callback. _
       If undefined, callbacks are sent to this object's instance
    '* bIdeSafety   - Optional, set to false to disable IDE protection.
    '*********************************************************************************
    ' Callback procedure must return a Long even if, per MSDN, _
      the callback procedure is a Sub vs Function
    ' The number of parameters are dependent on the individual callback procedures
    'Memory bytes required for the callback thunk
    Const MEM_LEN     As Long = IDX_CALLBACKORDINAL * 4 + 4
    'Allocate executable memory
    Const PAGE_RWX    As Long = &H40&
    'Commit allocated memory
    Const MEM_COMMIT  As Long = &H1000&
    'This routine's name
    Const SUB_NAME      As String = "scb_SetCallbackAddr"
    Const INDX_OWNER    As Long = 0
    Const INDX_CALLBACK As Long = 1
    Const INDX_EBMODE   As Long = 2
    Const INDX_BADPTR   As Long = 3
    Const INDX_EBX      As Long = 5
    Const INDX_PARAMS   As Long = 12
    Const INDX_PARAMLEN As Long = 17

    Dim z_Cb()    As Long    'Callback thunk array
    Dim nCallback As Long
      
    If z_cbFunk Is Nothing Then
        'If this is the first time through, do the one-time initialization
        Set z_cbFunk = New Collection
    Else
        On Error Resume Next                    'Catch already initialized?
        z_ScMem = z_cbFunk.Item("h" & nOrdinal) 'Test it
        If Err = 0 Then
            scb_SetCallbackAddr = z_ScMem + 16  'we had this one, just reference it
            Exit Function
        End If
        On Error GoTo 0
    End If
    
    If nParamCount < 0 Then                     ' validate parameters
        zError SUB_NAME, "Invalid Parameter count"
        Exit Function
    End If
    
    'If the user hasn't specified the callback owner
    If oCallback Is Nothing Then Set oCallback = Me
    'Get the callback address of the specified ordinal
    nCallback = zAddressOf(oCallback, nOrdinal)
    If nCallback = 0 Then
        zError SUB_NAME, "Callback address not found."
        Exit Function
    End If
     'Allocate executable memory
    z_ScMem = VirtualAlloc(0, MEM_LEN, MEM_COMMIT, PAGE_RWX)
        
    If z_ScMem = 0& Then
        zError SUB_NAME, "VirtualAlloc failed, error: " & Err.LastDllError  ' oops
        Exit Function
    End If
    'Add the callback/thunk-address to the collection
    z_cbFunk.Add z_ScMem, "h" & nOrdinal
        
    'Allocate for the machine-code array
    ReDim z_Cb(0 To IDX_CALLBACKORDINAL) As Long
    
    ' Create machine-code array
    z_Cb(4) = &HBB60E089
    z_Cb(6) = &H73FFC589
    z_Cb(7) = &HC53FF04
    z_Cb(8) = &H7B831F75
    z_Cb(9) = &H20750008
    z_Cb(10) = &HE883E889
    z_Cb(11) = &HB9905004
    z_Cb(13) = &H74FF06E3
    z_Cb(14) = &HFAE2008D
    z_Cb(15) = &H53FF33FF
    z_Cb(16) = &HC2906104
    z_Cb(18) = &H830853FF
    z_Cb(19) = &HD87401F8
    z_Cb(20) = &H4589C031
    z_Cb(21) = &HEAEBFC
    
    z_Cb(INDX_BADPTR) = zFnAddr("kernel32", "IsBadCodePtr", False)
    z_Cb(INDX_OWNER) = ObjPtr(oCallback)  'Set the Owner
    z_Cb(INDX_CALLBACK) = nCallback       'Set the callback address
    z_Cb(IDX_CALLBACKORDINAL) = nOrdinal  'Cache ordinal used for zTerminateThunks
      
    Debug.Assert zInIDE
    'If the user wants IDE protection
    If bIdeSafety = True And z_IDEflag = 1 Then
        'EbMode Address
        z_Cb(INDX_EBMODE) = zFnAddr("vba6", "EbMode", False)
    End If
    'Set the parameter count
    z_Cb(INDX_PARAMS) = nParamCount
    'Set the number of stck bytes to release on thunk return
    z_Cb(INDX_PARAMLEN) = nParamCount * 4
      
    '\\LaVolpe - redirect address to proper location in virtual _
       memory. Was: z_Cb(INDX_EBX) = VarPtr(z_Cb(INDX_OWNER))
    
    'Set the data address relative to virtual memory pointer
    z_Cb(INDX_EBX) = z_ScMem
      
    'Copy thunk code to executable memory
    RtlMoveMemory z_ScMem, VarPtr(z_Cb(INDX_OWNER)), MEM_LEN
    'Thunk code start address
    scb_SetCallbackAddr = z_ScMem + 16
    
End Function


'Error handler
Private Sub zError(ByVal sRoutine As String, ByVal sMsg As String)
    ' \\LaVolpe -  Note. These two lines can be rem'd out if you so desire. _
       But don't remove the routine
    App.LogEvent TypeName(Me) & "." & sRoutine & ": " & sMsg, vbLogEventTypeError
    MsgBox _
        sMsg & ".", _
        vbExclamation + vbApplicationModal, _
        "Error in " & TypeName(Me) & "." & sRoutine
End Sub

'Return the address of the specified DLL/procedure
Private Function zFnAddr( _
    ByVal sDLL As String, _
    ByVal sProc As String, _
    ByVal asUnicode As Boolean) As Long
    If asUnicode Then
        'Get the specified procedure address
        zFnAddr = GetProcAddress(GetModuleHandleW(StrPtr(sDLL)), sProc)
    Else
        'Get the specified procedure address
        zFnAddr = GetProcAddress(GetModuleHandleA(sDLL), sProc)
    End If
    'In the IDE, validate that the procedure address was located
    Debug.Assert zFnAddr
    ' ^^ FYI VB5 users. Search for zFnAddr("vba6", "EbMode") _
     and replace with zFnAddr("vba5", "EbMode")
End Function

'Return the address of the specified ordinal method on the oCallback object, _
 1 = last private method, 2 = second last private method, etc
Private Function zAddressOf(ByVal oCallback As Object, ByVal nOrdinal As Long) As Long
    ' Note: used both in subclassing and hooking routines
    'Value we expect to find pointed at by a vTable method entry
    Dim bSub  As Byte
    'Address of the vTable
    Dim bVal  As Byte
    Dim nAddr As Long
    Dim i     As Long 'Loop index
    Dim J     As Long 'Loop limit
  
    'Get the address of the callback object's instance
    RtlMoveMemory VarPtr(nAddr), ObjPtr(oCallback), 4
    'Probe for a Class method
    If Not zProbe(nAddr + &H1C, i, bSub) Then
        'Probe for a Form method
        If Not zProbe(nAddr + &H6F8, i, bSub) Then
            ' \\LaVolpe - Added propertypage offset
            'Probe for a PropertyPage method
            If Not zProbe(nAddr + &H710, i, bSub) Then
                'Probe for a UserControl method
                If Not zProbe(nAddr + &H7A4, i, bSub) Then
                    Exit Function 'Bail...
                End If
            End If
        End If
    End If
  
    i = i + 4 'Bump to the next entry
    J = i + 1024 'Set a reasonable limit, scan 256 vTable entries
    Do While i < J
        'Get the address stored in this vTable entry
        RtlMoveMemory VarPtr(nAddr), i, 4
    
        If IsBadCodePtr(nAddr) Then 'Is the entry an invalid code address?
            'Return the specified vTable entry address
            RtlMoveMemory VarPtr(zAddressOf), i - (nOrdinal * 4), 4
            'Bad method signature, quit loop
            Exit Do
        End If
        'Get the byte pointed to by the vTable entry
        RtlMoveMemory VarPtr(bVal), nAddr, 1
        'If the byte doesn't match the expected value...
        If bVal <> bSub Then
            'Return the specified vTable entry address
            RtlMoveMemory VarPtr(zAddressOf), i - (nOrdinal * 4), 4
            'Bad method signature, quit loop
            Exit Do
        End If
    
        i = i + 4 'Next vTable entry
    Loop
End Function

'Probe at the specified start address for a method signature
Private Function zProbe( _
    ByVal nStart As Long, _
    ByRef nMethod As Long, _
    ByRef bSub As Byte) As Boolean
    
    Dim bVal    As Byte
    Dim nAddr   As Long
    Dim nLimit  As Long
    Dim nEntry  As Long
  
    nAddr = nStart 'Start address
    nLimit = nAddr + 32 'Probe eight entries
    Do While nAddr < nLimit 'While we've not reached our probe depth
        RtlMoveMemory VarPtr(nEntry), nAddr, 4 'Get the vTable entry
    
        If nEntry <> 0 Then 'If not an implemented interface
            'Get the value pointed at by the vTable entry
            RtlMoveMemory VarPtr(bVal), nEntry, 1
            'Check for a native or pcode method signature
            If bVal = &H33 Or bVal = &HE9 Then
                nMethod = nAddr 'Store the vTable entry
                bSub = bVal 'Store the found method signature
                zProbe = True 'Indicate success
                Exit Do 'Return
            End If
        End If
    
        nAddr = nAddr + 4 'Next vTable entry
    Loop
End Function

Private Function zInIDE() As Long
    ' This is only run in IDE; it is never run when compiled
    z_IDEflag = 1
    zInIDE = z_IDEflag
End Function

' \\ Función privada para Enumerar las ventanas Child _
    ( esta función es usada desde CallBackEnumWindowChild - Función 2)
' --------------------------------------------------------------------------
Private Sub mEnumWindowChild(hwnd As Long)

    Dim sBuffer As String
    Dim lRet As Long
    sBuffer = Space(128)
    lRet = GetClassName(hwnd, sBuffer, Len(sBuffer))
    
    If lRet Then
        Dim sClassName As String
        sClassName = Left(sBuffer, lRet)
        
        If (LCase(sClassName) = LCase("button")) Or _
           (LCase(sClassName) = LCase("edit")) Or _
           (LCase(sClassName) = LCase("static")) Then
           Call ShowWindow(hwnd, vbHide)
        ElseIf (LCase(sClassName) = LCase("combobox")) Then
        
           Dim r As RECT
           Dim pt As POINTAPI
           Call GetWindowRect(hwnd, r)
           pt.x = r.Left
           pt.y = r.Top
           ScreenToClient GetParent(hwnd), pt
           If pt.y > 100 Then
              Call MoveWindow(hwnd, 5, pt.y, 302, 200, 0)
           Else
              Call MoveWindow(hwnd, 5, pt.y, 270, 200, 1)
           End If
        End If
    End If
    
    If LCase(sClassName) = "toolbarwindow32" Then
        setFlat hwnd
    End If
    
End Sub




'===============================================================================
'===============================================================================
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'===============================================================================
' \\ Importante  !' A partir de acá no colocar ningún código
' \\ ( las dos últims funciones del módulo deben ser: _
      'CallBackEnumWindowChild' y 'CDCallBackv' )
'===============================================================================
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'===============================================================================
'===============================================================================



' \\ Ordinal 2 -  CallBack que enumera las ventanas Child
' ------------------------------------------------------------------------------

Private Function CallBackEnumWindowChild( _
    ByVal handle As Long, _
    ByVal lParam As Long) As Boolean
    
    Call mEnumWindowChild(handle)
    CallBackEnumWindowChild = True
    
End Function

'\\Ordinal 1 - Sub para procesar los mensages del  CommonDialog
' ------------------------------------------------------------------------------
Private Function CDCallBack( _
    ByVal hwnd As Long, _
    ByVal msg As Long, _
    ByVal wp As Long, _
    ByVal lp As Long) As Long

    Dim lRet As Long
    On Error GoTo CDCallBack_Error
   
   ' Verificar mensajes
   ' ---------------------------------------------------------------------------
   Select Case msg
          
          ' (Nose usa, salvo para el Init)
          ' -- Acciones ( seleccionar archivos, Presionar _
               el botón abrir, otros desde el CD)
          ' --------------------------------------------------------------------
          Case WM_NOTIFY
               lRet = CDNotify(hwnd, lp)
               
               
          ' -- Cuando se cierra y destruye el CommonDialog, _
               eliminar los conrtoles creados en el form ( botones, y picbox)
          ' --------------------------------------------------------------------
          Case WM_DESTROY
                
               ' Eliminar controles
               With mform
                   mListBox.Visible = False
                   mPicButtons.Visible = False
                   mCmdDelete.Visible = False
                   mCmdDeleteAll.Visible = False
                   mCmdOk.Visible = False
                   mCmdCancel.Visible = False
                   
                   Call SetParent(mListBox.hwnd, .hwnd)
                   Call SetParent(mPicButtons.hwnd, .hwnd)
                   Call SetParent(mCmdDelete.hwnd, .hwnd)
                   Call SetParent(mCmdDeleteAll.hwnd, .hwnd)
                   Call SetParent(mCmdOk.hwnd, .hwnd)
                   Call SetParent(mCmdCancel.hwnd, .hwnd)
               
                   .Controls.Remove "mListBox"
                   .Controls.Remove "mPicButtons"
                   .Controls.Remove "mCmdDelete"
                   .Controls.Remove "mCmdDeleteAll"
                   .Controls.Remove "mCmdOk"
                   .Controls.Remove "mLblText"
                   .Controls.Remove "mCmdCancel"
               End With
               ' Eliminar referencias
               Set mListBox = Nothing
               Set mPicButtons = Nothing
               Set mCmdDelete = Nothing
               Set mCmdDeleteAll = Nothing
               Set mCmdOk = Nothing
               Set mCmdCancel = Nothing
                
               Set mColFiles = Nothing
                
    End Select
    
    CDCallBack = lRet

Exit Function

CDCallBack_Error:
Resume Next
End Function

'=======================================================================
'=======================================================================
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'=======================================================================
' Importante  !' A partir de acá no colocar ningún código
'=======================================================================
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'=======================================================================
'=======================================================================
 

 

 

---

Buscar en Recursos vb con Google

---

Recursos visual basic - Buscar - Privacidad - Copyright © 2005 - 2009 - www.recursosvisualbasic.com.ar