El código completo (incluido el del diseñador del formulario)
'------------------------------------------------------------------------------
' fOpenFileDialog para smartphone 2003 con Visual Studio 2003 (27/Dic/07)
'
' fOpenFileDialog (24/Dic/07)
' Seleccionar ficheros
' Simula el OpenFileDialog, ya que en los Smartphone no está soportado ese control
'
' ©Guillermo 'guille' Som, 2007
'------------------------------------------------------------------------------
Option Strict On
Imports Microsoft.VisualBasic
Imports System
Imports System.Windows.Forms
Imports System.Drawing
Imports System.IO
'Imports System.Collections.Generic
Public Class fOpenFileDialog
Inherits System.Windows.Forms.Form
#Region " Código generado por el Diseñador de Windows Forms "
Public Sub New()
MyBase.New()
'El Diseñador de Windows Forms requiere esta llamada.
InitializeComponent()
'Agregar cualquier inicialización después de la llamada a InitializeComponent()
End Sub
Protected Overloads Overrides Sub Dispose(ByVal disposing As Boolean)
MyBase.Dispose(disposing)
End Sub
'NOTA: el Diseñador de Windows Forms requiere el siguiente procedimiento
'Puede modificarse utilizando el Diseñador de Windows Forms.
'No lo modifique con el editor de código.
'Private components As System.ComponentModel.IContainer
Private mainMenu1 As System.Windows.Forms.MainMenu
Friend WithEvents mnuMenu As System.Windows.Forms.MenuItem
Friend WithEvents mnuDispositivo As System.Windows.Forms.MenuItem
Friend WithEvents mnuDocuments As System.Windows.Forms.MenuItem
Friend WithEvents mnuAppData As System.Windows.Forms.MenuItem
Friend WithEvents mnuWindows As System.Windows.Forms.MenuItem
Friend WithEvents mnuCancelar As System.Windows.Forms.MenuItem
Friend WithEvents mnuSeleccionar As System.Windows.Forms.MenuItem
Friend WithEvents mnuSep2 As System.Windows.Forms.MenuItem
Private WithEvents mnuArriba As System.Windows.Forms.MenuItem
Private WithEvents lvDirs As System.Windows.Forms.ListView
Private WithEvents mnuCambiar As System.Windows.Forms.MenuItem
Private WithEvents imageList1 As System.Windows.Forms.ImageList
Private WithEvents mnuSep0 As System.Windows.Forms.MenuItem
Private WithEvents mnuSep1 As System.Windows.Forms.MenuItem
Private WithEvents mnuSep3 As System.Windows.Forms.MenuItem
Private WithEvents mnuFiltro As System.Windows.Forms.MenuItem
Private WithEvents mnuFiltros1 As System.Windows.Forms.MenuItem
<System.Diagnostics.DebuggerStepThrough()> _
Private Sub InitializeComponent()
Dim resources As System.Resources.ResourceManager = _
New System.Resources.ResourceManager(GetType(fOpenFileDialog))
Me.mainMenu1 = New System.Windows.Forms.MainMenu
Me.mnuArriba = New System.Windows.Forms.MenuItem
Me.mnuMenu = New System.Windows.Forms.MenuItem
Me.mnuFiltro = New System.Windows.Forms.MenuItem
Me.mnuFiltros1 = New System.Windows.Forms.MenuItem
Me.mnuSep3 = New System.Windows.Forms.MenuItem
Me.mnuSeleccionar = New System.Windows.Forms.MenuItem
Me.mnuSep2 = New System.Windows.Forms.MenuItem
Me.mnuCancelar = New System.Windows.Forms.MenuItem
Me.mnuSep0 = New System.Windows.Forms.MenuItem
Me.mnuCambiar = New System.Windows.Forms.MenuItem
Me.mnuSep1 = New System.Windows.Forms.MenuItem
Me.mnuDispositivo = New System.Windows.Forms.MenuItem
Me.mnuDocuments = New System.Windows.Forms.MenuItem
Me.mnuAppData = New System.Windows.Forms.MenuItem
Me.mnuWindows = New System.Windows.Forms.MenuItem
Me.lvDirs = New System.Windows.Forms.ListView
Me.imageList1 = New System.Windows.Forms.ImageList
'
'mainMenu1
'
Me.mainMenu1.MenuItems.Add(Me.mnuArriba)
Me.mainMenu1.MenuItems.Add(Me.mnuMenu)
'
'mnuArriba
'
Me.mnuArriba.Text = "Arriba"
'
'mnuMenu
'
Me.mnuMenu.MenuItems.Add(Me.mnuFiltro)
Me.mnuMenu.MenuItems.Add(Me.mnuSep3)
Me.mnuMenu.MenuItems.Add(Me.mnuSeleccionar)
Me.mnuMenu.MenuItems.Add(Me.mnuSep2)
Me.mnuMenu.MenuItems.Add(Me.mnuCancelar)
Me.mnuMenu.MenuItems.Add(Me.mnuSep0)
Me.mnuMenu.MenuItems.Add(Me.mnuCambiar)
Me.mnuMenu.MenuItems.Add(Me.mnuSep1)
Me.mnuMenu.MenuItems.Add(Me.mnuDispositivo)
Me.mnuMenu.MenuItems.Add(Me.mnuDocuments)
Me.mnuMenu.MenuItems.Add(Me.mnuAppData)
Me.mnuMenu.MenuItems.Add(Me.mnuWindows)
Me.mnuMenu.Text = "Menú"
'
'mnuFiltro
'
Me.mnuFiltro.MenuItems.Add(Me.mnuFiltros1)
Me.mnuFiltro.Text = "Filtro"
'
'mnuFiltros1
'
Me.mnuFiltros1.Text = "*.*"
'
'mnuSep3
'
Me.mnuSep3.Text = "-"
'
'mnuSeleccionar
'
Me.mnuSeleccionar.Text = "Seleccionar"
'
'mnuSep2
'
Me.mnuSep2.Text = "-"
'
'mnuCancelar
'
Me.mnuCancelar.Text = "Cancelar"
'
'mnuSep0
'
Me.mnuSep0.Text = "-"
'
'mnuCambiar
'
Me.mnuCambiar.Text = "Cambiar a"
'
'mnuSep1
'
Me.mnuSep1.Text = "-"
'
'mnuDispositivo
'
Me.mnuDispositivo.Text = "Mi Dispositivo"
'
'mnuDocuments
'
Me.mnuDocuments.Text = "My Documents"
'
'mnuAppData
'
Me.mnuAppData.Text = "Application Data"
'
'mnuWindows
'
Me.mnuWindows.Text = "Windows"
'
'lvDirs
'
Me.lvDirs.Size = New System.Drawing.Size(240, 266)
Me.lvDirs.SmallImageList = Me.imageList1
Me.lvDirs.View = System.Windows.Forms.View.SmallIcon
'
'imageList1
'
Me.imageList1.Images.Add(CType(resources.GetObject("resource"), System.Drawing.Image))
Me.imageList1.Images.Add(CType(resources.GetObject("resource1"), System.Drawing.Image))
Me.imageList1.Images.Add(CType(resources.GetObject("resource2"), System.Drawing.Image))
Me.imageList1.Images.Add(CType(resources.GetObject("resource3"), System.Drawing.Image))
Me.imageList1.ImageSize = New System.Drawing.Size(16, 16)
'
'fOpenFileDialog
'
Me.ClientSize = New System.Drawing.Size(240, 266)
Me.Controls.Add(Me.lvDirs)
Me.Menu = Me.mainMenu1
Me.Text = "fOpenFileDialog"
End Sub
#End Region
Private dirArriba As DirectoryInfo = Nothing
Private m_FileName As String = ""
Private filtroActual As Integer = 0
Private m_Filter As String = "*.*"
''' <summary>
''' Filtros a usar con los ficheros
''' El formato será:
''' Descripción|filtro[|Descripción|filtro]
''' Filtro será cualquier filtro válido
''' se pueden indicar varios separados por ;
''' por ejemplo: *.txt;*.doc
''' </summary>
''' <value></value>
''' <returns></returns>
''' <remarks></remarks>
Public Property Filter() As String
Get
Return m_Filter
End Get
Set(ByVal value As String)
If Len(value) = 0 Then
m_Filter = "(*.*)|*.*"
Else
m_Filter = value
End If
Dim filtros() As String = value.Split("|".ToCharArray)
mnuFiltro.MenuItems.Clear()
Dim mnu As New MenuItem
For i As Integer = 1 To filtros.Length - 1 Step 2
' Si hay varios filtros separados por ;
If filtros(i).IndexOf(";") > -1 Then
Dim filtros2() As String = filtros(i).Split(";".ToCharArray)
For j As Integer = 0 To filtros2.Length - 1
mnu = New MenuItem
mnu.Text = filtros2(j).Trim
mnuFiltro.MenuItems.Add(mnu)
AddHandler mnu.Click, AddressOf mnuFiltros1_Click
Next
Else
mnu = New MenuItem
mnu.Text = filtros(i).Trim
mnuFiltro.MenuItems.Add(mnu)
AddHandler mnu.Click, AddressOf mnuFiltros1_Click
End If
Next
filtroActual = 0
mnuFiltro.MenuItems(filtroActual).Checked = True
End Set
End Property
Public Property Title() As String
Get
Return Me.Text
End Get
Set(ByVal value As String)
Me.Text = value
End Set
End Property
Public Property FileName() As String
Get
Return m_FileName
End Get
Set(ByVal value As String)
m_FileName = value
If Len(value) = 0 _
OrElse File.Exists(value) = False Then
dirArriba = New DirectoryInfo("\")
Else
Dim sDir As String = Path.GetDirectoryName(value)
dirArriba = New DirectoryInfo(sDir)
If dirArriba.Exists = False Then
dirArriba = New DirectoryInfo("\")
End If
End If
End Set
End Property
''' <summary>
''' Rellenar la lista de arriba con los directorios
''' del directorio indicado
''' </summary>
''' <param name=obj">"
''' Directorio en el que se navegará
''' </param>
''' <remarks></remarks>
Private Sub leerDirs(ByVal obj As Object)
If (TypeOf obj Is DirectoryInfo) = False Then
Exit Sub
End If
Dim di As DirectoryInfo
Try
di = DirectCast(obj, DirectoryInfo)
Catch ex As Exception
MessageBox.Show("leerDirs ob no es DirectoryInfo. Error:" & vbCrLf & ex.Message)
Exit Sub
End Try
Dim lvi As ListViewItem
With Me.lvDirs.Items
.Clear()
Dim d2() As DirectoryInfo = di.GetDirectories()
lvi = .Add(New ListViewItem(di.FullName))
lvi.SubItems.Add(di.FullName)
lvi.SubItems.Add("dir")
'lvi.Tag = di
dirArriba = di
lvi.ImageIndex = 3
For Each d As DirectoryInfo In d2
lvi = .Add(New ListViewItem(d.Name))
lvi.SubItems.Add(d.FullName)
lvi.SubItems.Add("dir")
'lvi.Tag = d
lvi.ImageIndex = 2
Next
Dim fi2() As FileInfo = di.GetFiles(mnuFiltro.MenuItems(filtroActual).Text)
For Each f As FileInfo In fi2
lvi = .Add(New ListViewItem(f.Name))
lvi.SubItems.Add(f.FullName)
lvi.SubItems.Add("fic")
'lvi.Tag = f
Select Case f.Extension.ToLower
Case ".wav", ".mp3", ".m3u"
lvi.ImageIndex = 0
Case Else
lvi.ImageIndex = 1
End Select
Next
End With
End Sub
Private Sub fOpenFileDialog_Load(ByVal sender As Object, _
ByVal e As EventArgs) _
Handles MyBase.Load
With lvDirs
.Columns.Clear()
.Columns.Add("Nombre", 150, HorizontalAlignment.Left)
.Columns.Add("FullName", 1, HorizontalAlignment.Left)
.Columns.Add("tipo", 1, HorizontalAlignment.Left)
End With
If dirArriba Is Nothing Then
dirArriba = New DirectoryInfo("\")
End If
leerDirs(dirArriba)
End Sub
Private Sub mnuDispositivo_Click(ByVal sender As Object, _
ByVal e As EventArgs) _
Handles mnuDispositivo.Click
leerDirs(New DirectoryInfo("\"))
End Sub
Private Sub mnuDocuments_Click(ByVal sender As Object, _
ByVal e As EventArgs) _
Handles mnuDocuments.Click
leerDirs(New DirectoryInfo("\My Documents"))
End Sub
Private Sub mnuAppData_Click(ByVal sender As Object, _
ByVal e As EventArgs) _
Handles mnuAppData.Click
leerDirs(New DirectoryInfo("\Application Data"))
End Sub
Private Sub mnuWindows_Click(ByVal sender As Object, _
ByVal e As EventArgs) _
Handles mnuWindows.Click
leerDirs(New DirectoryInfo("\Windows"))
End Sub
Private Sub mnuCancelar_Click(ByVal sender As Object, _
ByVal e As EventArgs) _
Handles mnuCancelar.Click
Me.DialogResult = Windows.Forms.DialogResult.Cancel
End Sub
Private Sub mnuArriba_Click(ByVal sender As Object, _
ByVal e As EventArgs) _
Handles mnuArriba.Click
' Ir al directorio anterior
If dirArriba.Parent Is Nothing Then
leerDirs(dirArriba)
Else
leerDirs(dirArriba.Parent)
End If
End Sub
Private Sub mnuSeleccionar_Click(ByVal sender As Object, _
ByVal e As EventArgs) _
Handles mnuSeleccionar.Click
If lvDirs.FocusedItem Is Nothing Then
Beep()
Exit Sub
End If
If lvDirs.SelectedIndices.Count > 0 Then
Dim i As Integer = lvDirs.SelectedIndices(0)
' Si es un fichero
If lvDirs.Items(i).SubItems(2).Text = "fic" Then
Me.FileName = lvDirs.Items(i).SubItems(1).Text
Me.DialogResult = Windows.Forms.DialogResult.OK
Else
Beep()
End If
End If
End Sub
Private Sub mnuCambiar_Click(ByVal sender As Object, _
ByVal e As EventArgs) _
Handles mnuCambiar.Click
If lvDirs.FocusedItem Is Nothing Then
Beep()
Exit Sub
End If
With Me.lvDirs
If .Items(.SelectedIndices(0)).SubItems(2).Text = "dir" Then
Dim di As New DirectoryInfo(.Items(.SelectedIndices(0)).SubItems(1).Text)
leerDirs(di)
Else
Beep()
End If
End With
End Sub
Private Sub mnuMenu_Popup(ByVal sender As Object, _
ByVal e As EventArgs) _
Handles mnuMenu.Popup
Dim lvi As ListViewItem = lvDirs.FocusedItem
If lvi Is Nothing Then
mnuSeleccionar.Enabled = False
mnuCambiar.Enabled = False
ElseIf lvi.SubItems(2).Text = "dir" Then
mnuCambiar.Enabled = True
mnuSeleccionar.Enabled = False
ElseIf lvi.SubItems(2).Text = "fic" Then
mnuCambiar.Enabled = False
mnuSeleccionar.Enabled = True
End If
End Sub
''' <summary>
''' Este es el evento que se produce al pulsar con el botón central (Intro)
''' </summary>
''' <param name=sender"></param>"
''' <param name=e"></param>"
''' <remarks></remarks>
Private Sub lvDirs_ItemActivate(ByVal sender As Object, _
ByVal e As EventArgs) _
Handles lvDirs.ItemActivate
If lvDirs.FocusedItem Is Nothing Then
Beep()
Exit Sub
End If
Dim lvi As ListViewItem = lvDirs.FocusedItem
If lvi.SubItems(2).Text = "dir" Then
If lvDirs.FocusedItem Is lvDirs.Items(0) Then
leerDirs(dirArriba)
Else
Dim di As New DirectoryInfo(lvi.SubItems(1).Text)
leerDirs(di)
End If
ElseIf lvi.SubItems(2).Text = "fic" Then
Me.FileName = lvi.SubItems(1).Text
Me.DialogResult = Windows.Forms.DialogResult.OK
Else
Beep()
End If
End Sub
Private Sub lvDirs_SelectedIndexChanged(ByVal sender As Object, _
ByVal e As EventArgs) _
Handles lvDirs.SelectedIndexChanged, _
lvDirs.LostFocus
If dirArriba.Root.FullName.CompareTo(dirArriba.FullName) = 0 Then
mnuArriba.Enabled = False
Else
mnuArriba.Enabled = True
End If
End Sub
Private Sub mnuFiltros1_Click(ByVal sender As Object, _
ByVal e As EventArgs) 'Handles mnuFiltros1.Click
Dim mnu As MenuItem = DirectCast(sender, MenuItem)
If mnu Is Nothing Then Exit Sub
mnuFiltro.MenuItems(filtroActual).Checked = False
For i As Integer = 0 To mnuFiltro.MenuItems.Count - 1
If mnuFiltro.MenuItems(i) Is mnu Then
filtroActual = i
mnu.Checked = True
Exit For
End If
Next
leerDirs(dirArriba)
End Sub
End Class