Reproductor Mp3

Permite la reproducción de una lista de temas

Fecha: 26/Oct/2005 (26/10/05)
Autor: Gabriel Alberto Plot - [email protected]

Voy a comenzar explicando como surgió mi idea.

Por necesidad que es la madre de la invención andaba buscando un reproductor de mp3 solamente liviano para una maquina no muy potente, vi el reproductor que estaba en la web del guille el gsPlayWMP y pensaba utilizarlo pero me encontré con que funcionaba y necesitaba algunas características que lo hicieran mas funcional y atractivo, entonces me dedique a la tarea de mejorarlo y adaptarlo a mis necesidades. El formulario principal consta de los botones usuales de reproducción además de los controles para manejar la lista como borrar un tema borrar toda la lista pasar al siguiente tema en la lista cargar la lista y guardar una lista. el control del volumen y una tilde de auto que reproduce indefinidamente la lista.

De este programa se destaca:
* La múltiple selección de ficheros para su apertura.
* Trabajo con listas de reproducción
* Configuracion basica de su aspecto (fuente y fondo con popup)
* Utilizacion de una clase pequeña para la manipulación de los temas

A continuación sigue el código en Visual Basic:

Formulario Principal :

'===================================================
'Reproductor de MP3 con wmp de windows
'     -------------------------------------
'Este codigo es una modificacion del codigo original
'de gsPlayWMP de la pagina de "el guille"
'Como realize muchos cambios del original en el
'formulario principal no esta discriminado que es
'mio o que no, para esto debe ver el codigo original
'y sacar sus propias conclusiones
'     -------------------------------------
'Utilice otro poco de otro Proyecto MP3Player de ahi
'saque el modulo "AuxFuncs", algunos botones y
'la barra de progreso
'     --------------------------------------
'Por Gabriel Alberto Plot
'[email protected] / [email protected]
'06/04/2005
'===================================================

Option Explicit
Option Compare Text

Const Titulo = "Mp3 Player"
Const VersionNumero = "1.0.5"

Private MiPath As String

Private sEstadoActual() As String
Private m_Tocando As Boolean

Private ruta As String     ' ruta del archivo
Private LargoCol As String ' largo de la coleccion

Private total As Double
    Private ProgressTop As Integer
    Private ProgressValue As Integer

    ' Clase para manejar el fichero a tocar
    Private m_csPlay As cPlayWMP
    Private Sub Vista()
    On Error Resume Next
    '******************************************
    'Carga del archivo config.ini la parte que
    'corresponde a cada control
    '******************************************
    LCD.BackColor = LeerIni(MiPath, "RELOJ", "FONDO")
    LCD.ForeColor = LeerIni(MiPath, "RELOJ", "FRENTE")
    List1.BackColor = LeerIni(MiPath, "LISTA", "FONDO")
    List1.ForeColor = LeerIni(MiPath, "LISTA", "FRENTE")
    List1.Font = LeerIni(MiPath, "LISTA", "FONT")
    List1.FontSize = LeerIni(MiPath, "LISTA", "SIZE")
    List1.FontBold = LeerIni(MiPath, "LISTA", "BOLD")
    chkAuto.Value = InStr(LeerIni(MiPath, "AUTO", "SET"), "TRUE")
    ' Asignar el volumen a 0 (normal), ya que en el IE5 se asigna a -600
    m_csPlay.Volumen = Val(LeerIni(MiPath, "VOLUMEN", "VOL"))
End Sub

Private Sub PushBar()
    '***************************
    'Avanza la barra de progreso
    '***************************
On Error Resume Next
Dim Contador As Integer
ProgressBar.AutoRedraw = True

shapeFondo.Left = (m_csPlay.CurrentPosition * (ProgressBar.Width)) / m_csPlay.Duration
'Debug.Print m_csPlay.CurrentPosition
'Debug.Print shapeFondo.Left
'Debug.Print m_csPlay.Duration

'For Contador = 1 To Fix(ProgressBar.ScaleWidth / ProgressTop)
'    ProgressBar.Line (ProgressValue + Contador, 0)-Step(0, ProgressBar.ScaleHeight)
'Next Contador
'ProgressBar.AutoRedraw = False
'ProgressValue = ProgressValue + Contador
End Sub

Private Sub CleanLista()
'******************************************
'limpia la lista
'Comentario: creo que se puede hacer con un
'procedimiento, pero lo hice asi
'******************************************
Dim i As Integer
For i = List1.ListCount - 1 To 0 Step -1
    List1.RemoveItem i
Next i
End Sub

Private Sub RefreshLista()
'************************************
'Actualiza la lista luego de realizar
'una modificacion a la coleccion
'************************************
Dim Largo As Integer
Dim i As Integer
CleanLista
VerUltimo ruta, LargoCol
Largo = Val(LargoCol)
For i = 0 To Largo - 1
    Ver i + 1, ruta, LargoCol
    List1.AddItem " " & LargoCol & " - " & GetFileName(ruta), List1.ListCount
Next i
End Sub

Private Sub botones_Click(Index As Integer)
'***********************************************
'Controla el acceso por medio de los botones
'que se encuentran dentro del cuadro "Controles"
'***********************************************
Dim total As Integer
Dim i As Integer
Dim temp As String
On Error GoTo errores

Select Case Index
    Case 0:
        If List1.ListIndex >= 0 Then

            ProgressBar.AutoRedraw = True
            ProgressBar.Cls
            ProgressBar.AutoRedraw = False

            Ver List1.ListIndex + 1, ruta, LargoCol
            If Dir(ruta) <> "" Then
                m_csPlay.Tocar ruta
                ' El valor de cada paso del HScrollPos
                ProgressTop = Fix(m_csPlay.SegundosRestantes + 1)
                ProgressValue = 0

                m_Tocando = True
                Me.Caption = Titulo & " - " & GetFileName(ruta)
            Else
                MsgBox "EL TEMA A REPRODUCIR FUE REMOVIDO", vbCritical, "ERROR"
            End If
        End If
    Case 1
        ' Pausa
        If m_csPlay.EstadoActual = ecsPaused Then
            m_csPlay.Tocar
        Else
            m_csPlay.Pausa
        End If
    Case 2
        ' Parar
        m_csPlay.Parar
        m_Tocando = False
        frmPlayer.Caption = Titulo
    Case 3:
        'la multiple seleccion no se logra solamente con la constante de
        'seleccion en el commondialog, ademas hay que fijar
        'un numero en la propiedad del commondialog MAXFILESIZE
        '"que es el maximo tamaño del nombre del archivo abierto"
        'en este caso yo puse 16000, porque me parecio un numero suficiente
        'este se puede ver haciendo click derecho sobre el control
        'en vista de diseño del formulario o en la ventana de propiedades

CommonDialog1.Flags = cdlOFNAllowMultiselect + cdlOFNExplorer + cdlOFNHideReadOnly
CommonDialog1.Filter = "Todos los archivos disponibles|*.mp3;*.wav|*.mp3|*.mp3|*.wav|*.wav"
CommonDialog1.InitDir = ""
CommonDialog1.FileName = ""
CommonDialog1.ShowOpen
        If Err = 0 Then
            total = cad(CommonDialog1.FileName)
            If total = 1 Then
                Agregar CommonDialog1.FileName
                VerUltimo ruta, LargoCol
                List1.AddItem LargoCol & " - " & GetFileName(ruta), List1.ListCount
            Else
                For i = 2 To total
                    Agregar Buffer(1) & "\" & Buffer(i)
                    VerUltimo ruta, LargoCol
                    List1.AddItem LargoCol & " - " & GetFileName(ruta), List1.ListCount
                Next i
            End If
            If List1.ListIndex < 0 Then
                List1.Selected(0) = True
            End If
        End If
    Case 4:
        'Remover Seleccionado
        Remover (List1.ListIndex + 1)
        RefreshLista
        If List1.ListCount > 0 Then
            List1.Selected(0) = True
            frmPlayer.Caption = Titulo
        End If
    Case 5:
        'Remover todo
        m_csPlay.Parar
        m_Tocando = False
        RemoverTodo
        CleanLista
        frmPlayer.Caption = Titulo
    Case 6:
        'Tocar siguiente
        If (List1.ListCount > 0) And (List1.ListIndex = List1.ListCount - 1) Then
            List1.Selected(0) = True
        ElseIf (List1.ListCount > 0) Then
            List1.Selected(List1.ListIndex + 1) = True
        End If
        botones_Click (0)
    Case 7:
        'Abrir lista
        m_csPlay.Parar
        m_Tocando = False
        frmPlayer.Caption = Titulo
CommonDialog1.Flags = cdlOFNExplorer + cdlOFNHideReadOnly
CommonDialog1.Filter = "*.m3g|*.m3g"
CommonDialog1.InitDir = App.Path
CommonDialog1.FileName = ""
CommonDialog1.ShowOpen
        If Err = 0 Then
            total = Val(LeerIni(CommonDialog1.FileName, "TEMAS", "TOTAL"))
            If total > 0 Then
                RemoverTodo
                CleanLista
                For i = 1 To total
                    temp = LeerIni(CommonDialog1.FileName, "TEMAS", "TEMA" & i)
                    Agregar temp
                Next i
                RefreshLista
                List1.Selected(0) = True
            Else
                MsgBox "No hay canciones"
            End If
        End If
    Case 8:
CommonDialog1.Flags = cdlOFNExplorer + cdlOFNHideReadOnly
        'Guardar lista
CommonDialog1.Filter = "*.m3g|*.m3g"
CommonDialog1.InitDir = App.Path
CommonDialog1.FileName = ""
CommonDialog1.ShowSave
        If (Err = 0) And (List1.ListCount > 0) Then
            VerUltimo ruta, LargoCol
            GuardarIni CommonDialog1.FileName, "TEMAS", "TOTAL", LargoCol
            'Dim i As Integer
            For i = 1 To LargoCol
                Ver i, ruta, LargoCol
                GuardarIni CommonDialog1.FileName, "TEMAS", "TEMA" & i, ruta
            Next i
        End If
End Select
Exit Sub
errores:
Select Case Err
    Case 52:
        MsgBox "El archivo fue removido"
    Case 32755:
    Case 5:
    Case Else
        MsgBox "Error :" & Err.Number & " al reproducir el archivo"
End Select
End Sub

Private Sub chkAuto_Click()
'***********************************
'guarda en config.ini el set de auto
'***********************************
If chkAuto.Value Then
    GuardarIni MiPath, "AUTO", "SET", "TRUE"
Else
    GuardarIni MiPath, "AUTO", "SET", "FALSE"
End If
End Sub

Private Sub Form_Load()
If Not App.PrevInstance Then
    '**************************************************
    ' Para mostrar el estado actual                                 (12/Dic/99)
    ' ecspEstado.mpStopped =0, ecspEstado.mpClosed = 8
    '**************************************************

    ReDim sEstadoActual(ecspEstado.mpStopped To ecspEstado.mpClosed)
    sEstadoActual(ecspEstado.mpClosed) = "Closed"
    sEstadoActual(ecspEstado.mpPaused) = "Paused"
    sEstadoActual(ecspEstado.mpPlaying) = "Playing"
    sEstadoActual(ecspEstado.mpScanForward) = "ScanForward"
    sEstadoActual(ecspEstado.mpScanReverse) = "ScanReverse"
    sEstadoActual(ecspEstado.mpSkipForward) = "SkipForward"
    sEstadoActual(ecspEstado.mpSkipReverse) = "SkipReverse"
    sEstadoActual(ecspEstado.mpStopped) = "Stopped"
    sEstadoActual(ecspEstado.mpWaiting) = "Waiting"

    Timer1.Enabled = False

    Set m_csPlay = New cPlayWMP
        Label5.Caption = "ver:" & VersionNumero
        MiPath = App.Path & RutaIni
        If Dir(MiPath) <> "" Then
            Vista 'setea los colores
        End If
        Timer1.Enabled = True
    Else
        MsgBox "El programa ya esta abierto"
        Unload Me
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Set m_csPlay = Nothing
        Set frmPlayer = Nothing
        End Sub


        Private Sub LCD_Change()
            '*****************************
            'si cambia actualizar la barra
            '*****************************
            PushBar
        End Sub

        Private Sub LCD_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
            If Button = 2 Then
                PopupMenu mnuContador
            End If
        End Sub

        Private Sub List1_DblClick()
            botones_Click 0
        End Sub

        Private Sub List1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
            If Button = 2 Then
                PopupMenu mnuLista
            End If
        End Sub

        Private Sub mnuFondo_Click()
        On Error Resume Next
CommonDialog1.ShowColor
        If Err = 0 Then
            List1.BackColor = CommonDialog1.Color
            GuardarIni MiPath, "LISTA", "FONDO", CommonDialog1.Color
        End If
    End Sub

    Private Sub mnuFondoLCD_Click()
    On Error Resume Next
CommonDialog1.ShowColor
    If Err = 0 Then
        LCD.BackColor = CommonDialog1.Color
        GuardarIni MiPath, "RELOJ", "FONDO", CommonDialog1.Color
    End If
End Sub

Private Sub mnuFuente_Click()
On Error Resume Next
CommonDialog1.FontName = "MS Sans Serif"
CommonDialog1.Flags = 3
CommonDialog1.ShowFont
If Err = 0 Then
    List1.Font = CommonDialog1.FontName
    List1.FontSize = CommonDialog1.FontSize
    List1.FontBold = CommonDialog1.FontBold
    GuardarIni MiPath, "LISTA", "FONT", CommonDialog1.FontName
    GuardarIni MiPath, "LISTA", "SIZE", CommonDialog1.FontSize
    GuardarIni MiPath, "LISTA", "BOLD", CommonDialog1.FontBold
End If
End Sub

Private Sub mnuTexto_Click()
On Error Resume Next
CommonDialog1.ShowColor
If Err = 0 Then
List1.ForeColor = CommonDialog1.Color
GuardarIni MiPath, "LISTA", "FRENTE", CommonDialog1.Color
End If
End Sub

Private Sub mnuTextoLCD_Click()
On Error Resume Next
CommonDialog1.ShowColor
If Err = 0 Then
LCD.ForeColor = CommonDialog1.Color
GuardarIni MiPath, "RELOJ", "FRENTE", CommonDialog1.Color
End If
End Sub

Private Sub Timer1_Timer()
On Local Error Resume Next

With m_csPlay
' Si se está tocando el fichero...
If m_Tocando Then
' mostrar el tiempo restante

LCD = .TiempoRestante

' Si se ha terminado
If .Terminado Then
ProgressBar.AutoRedraw = True
ProgressBar.Cls
ProgressBar.AutoRedraw = False
m_Tocando = False
If chkAuto.Value Then
    botones_Click (6)
End If
End If
Else
' Si no se está tocando, mostrar el tiempo total,
' si hay un fichero cargado
If .FicheroCargado Then
LCD = .TiempoTotal
ProgressBar.AutoRedraw = True
ProgressBar.Cls
ProgressBar.AutoRedraw = False
Else
LCD = "00:00"
ProgressBar.AutoRedraw = True
ProgressBar.Cls
ProgressBar.AutoRedraw = False
End If
End If
End With
Err = 0
End Sub

Private Sub VerHelp_Click(Index As Integer)
VerHelp(0).Visible = Not VerHelp(0).Visible
VerHelp(1).Visible = Not VerHelp(1).Visible
frmPlayer.Height = IIf(frmPlayer.Height = 6375, 4140, 6375)
End Sub

Private Sub Vol_Click(Index As Integer)
'***************************************
'Controla el volumen lo hice asi porque
'no me gustaba como estaba en el programa
'original
'***************************************
Select Case Index
Case 0
If m_csPlay.Volumen > -10000 Then
m_csPlay.Volumen = m_csPlay.Volumen - 500
End If
Case 1
m_csPlay.Volumen = 0
Case 2
If m_csPlay.Volumen <= 0 Then
m_csPlay.Volumen = m_csPlay.Volumen + 500
End If
End Select
GuardarIni MiPath, "VOLUMEN", "VOL", m_csPlay.Volumen
End Sub

Acá Esta el código del modulo init que básicamente es usado para tratar con ficheros ".ini" para guardar las configuraciones.

Option Explicit
'********************************************
'Modulo Publico con constantes
'para acceder al archivo de configuracion
'Gabriel Alberto Plot
'[email protected] / [email protected]
'11/02/2005
'********************************************

#If Win32 Then
    'Declaraciones para 32 bits
Private Declare Function GetPrivateProfileString Lib "Kernel32" Alias "GetPrivateProfileStringA" _
    (ByVal lpApplicationName As String, ByVal lpKeyName As Any, _
    ByVal lpDefault As String, ByVal lpReturnedString As String, _
    ByVal nSize As Long, ByVal lpFileName As String) As Long
Private Declare Function WritePrivateProfileString Lib "Kernel32" Alias "WritePrivateProfileStringA" _
    (ByVal lpApplicationName As String, ByVal lpKeyName As Any, _
    ByVal lpString As Any, ByVal lpFileName As String) As Long
#Else
    'Declaraciones para 16 bits
Private Declare Function GetPrivateProfileString Lib "Kernel" _
    (ByVal lpApplicationName As String, ByVal lpKeyName As Any, _
    ByVal lpDefault As String, ByVal lpReturnedString As String, _
    ByVal nSize As Integer, ByVal lpFileName As String) As Integer
Private Declare Function WritePrivateProfileString Lib "Kernel" _
    (ByVal lpApplicationName As String, ByVal lpKeyName As Any, _
    ByVal lpString As Any, ByVal lplFileName As String) As Integer
#End If

'Archivo con las configuraciones
Public Const RutaIni = "\Config.ini"

Public Function LeerIni(lpFileName As String, lpAppName As String, lpKeyName As String, Optional vDefault) As String
    'Los parámetros son:
    'lpFileName:    La Aplicación (fichero INI)
    'lpAppName:     La sección que suele estar entrre corchetes
    'lpKeyName:     Clave
    'vDefault:      Valor opcional que devolverá
    '               si no se encuentra la clave.
    '
    Dim lpString As String
    Dim LTmp As Long
    Dim sRetVal As String
    'Si no se especifica el valor por defecto,
    'asignar incialmente una cadena vacía
    If IsMissing(vDefault) Then
        lpString = ""
    Else
        lpString = vDefault
    End If
    sRetVal = String$(255, 0)
    LTmp = GetPrivateProfileString(lpAppName, lpKeyName, lpString, sRetVal, Len(sRetVal), lpFileName)
    If LTmp = 0 Then
        LeerIni = lpString
    Else
        LeerIni = Left(sRetVal, LTmp)
    End If
End Function

Sub GuardarIni(lpFileName As String, lpAppName As String, lpKeyName As String, lpString As String)
    'Guarda los datos de configuración
    'Los parámetros son los mismos que en LeerIni
    'Siendo lpString el valor a guardar
    '
    Dim LTmp As Long

    LTmp = WritePrivateProfileString(lpAppName, lpKeyName, lpString, lpFileName)
End Sub

Acá Comienza la clase encargada de manejar un solo tema :

'*****************************************************************
'cancion
'Clase para manejar un tema en particular
'esta clase almacena y muestra la ruta del archivo y un numero,
'que se utiliza para saber la ubicacion de ese tema
'en la coleccion o en el programa principal
'Por Gabriel Alberto Plot
'[email protected] / [email protected]
'06/04/2005
'*****************************************************************
Private numero As String
Private ruta As String

Public Property Get VerNumero() As Variant
VerNumero = numero
End Property
Public Property Get VerRuta() As Variant
VerRuta = ruta
End Property

Public Property Let SetNumero(n As Variant)
numero = n
End Property
Public Property Let SetRuta(r As Variant)
ruta = r
End Property

Acá comienza el modulo de administrar la lista de temas :

'********************************************************
'MiModulo
'agrega y remueve elementos a una coleccion de canciones
'retorna cadenas con el nombre de la cancion y su numero
'Por Gabriel Alberto Plot
'[email protected] / [email protected]
'06/04/2005
'********************************************************
Option Explicit
Private Coleccion As New Collection

Public Sub Agregar(r As String)
    Dim MiCancion As New Cancion
    Dim aux As Integer
    aux = Coleccion.Count
    MiCancion.SetRuta = r
    MiCancion.SetNumero = aux + 1

    Coleccion.Add MiCancion
    Debug.Print Coleccion.Count
End Sub

Public Sub Ver(i As Integer, ByRef r As String, ByRef l As String)
    Dim MiCancion As New Cancion
    If Coleccion.Count >= i Then
        Set MiCancion = Coleccion.Item(i)
            r = MiCancion.VerRuta
            l = i
        Else
            r = ""
            l = ""
        End If
    End Sub
    Public Sub VerUltimo(ByRef r As String, ByRef l As String)
        Dim MiCancion As New Cancion
        Dim aux As Integer
        aux = Coleccion.Count
        If aux >= 1 Then
            Set MiCancion = Coleccion.Item(aux)
                r = MiCancion.VerRuta
                l = Str(aux)
            Else
                r = ""
                l = ""
            End If
        End Sub

        Public Sub Remover(i As Integer)
            Debug.Print Coleccion.Count
            If Coleccion.Count >= i Then
                Coleccion.Remove i
                Debug.Print Coleccion.Count
            End If
        End Sub

        Public Sub RemoverTodo()
            Dim n As Integer
            For n = 1 To Coleccion.Count
                Coleccion.Remove 1
            Next
        End Sub

Imágenes de la aplicación :

Acá puede verse una característica muy importante que puede ser de interés la múltiple selección de ficheros :

Algo que quiero aclarar es que la múltiple selección no se logra solamente con la constante de selección en el commondialog, además hay que fijar un numero de tamaño máximo de archivo" Los ficheros que faltan no los coloque porque están disponibles en otras secciones sin embargo los incluyo en el código fuente para que puedan compilarlo sin problema.
Agradecería que me informaran de cualquier problema y/o sugerencia que tengan para mejorarlo.

Fichero con el código de ejemplo: gabiplot_mp3.zip - 24 KB