Option Explicit
Private Declare Function mciSendString Lib "winmm.dll" Alias _
    "mciSendStringA" (ByVal lpstrCommand As String, ByVal _
    lpstrReturnString As Any, ByVal uReturnLength As Long, ByVal _
    hwndCallback As Long) As Long

Private Declare Function GetShortPathName Lib "kernel32" _
      Alias "GetShortPathNameA" (ByVal lpszLongPath As String, _
      ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long
'*** Constantes ***
Private Const OFN_FILEMUSTEXIST = &H1000&
Private Const OFN_READONLY = &H4&

'*** Variables ***
Private DialogCaption As String
Private FileName As String
Private Const MODAL = 1
Private Const MODELESS = 2

Dim i As Long
Dim ShortName
Dim mssg As String * 255
Dim ResumeStat As String
Dim FFRR As String


   Public Function GetShortName(ByVal sLongFileName As String) As String
       Dim lRetVal As Long, sShortPathName As String, iLen As Integer
      
       sShortPathName = Space(255)
       iLen = Len(sShortPathName)

      
       lRetVal = GetShortPathName(sLongFileName, sShortPathName, iLen)
       
       GetShortName = Left(sShortPathName, lRetVal)
   End Function
Private Sub Command1_Click()
  Dim MInfo As String
Screen.MousePointer = 11

CommonDialog1.CancelError = True
On Error GoTo EH1

CommonDialog1.Filter = "Archivos de Video|*.wmv;*.mpa;*.mpe;*.mpg;*.mpeg;*.avi|Windows Media Video|*.wmv|Archivo de Pelicula(mpeg)|*.mpg;*.mpa;*.mpe;*.mpeg|Video para Windows|*.avi|Todos los ficheros (*.*)|*.*"
CommonDialog1.Flags = OFN_FILEMUSTEXIST Or OFN_READONLY

CommonDialog1.ShowOpen

 ShortName = GetShortName(CommonDialog1.FileName)

i = mciSendString("close all", 0&, 0, 0)

Get_Size GetShortName(CommonDialog1.FileName)



Command2.Enabled = True
Command3.Enabled = True
Command4.Enabled = True
Command5.Enabled = True
Screen.MousePointer = 0
Me.Caption = "Reproductor de Video - " + CommonDialog1.FileTitle
App.Title = "Reproductor de Video - " + CommonDialog1.FileTitle
Exit Sub

EH1:

Screen.MousePointer = 0
If Err = 32755 Then Err.Clear: Exit Sub
MsgBox Err.Description, vbExclamation, "ERR #" & Err
End Sub

Private Sub Command2_Click()
 i = mciSendString("play video1 from " & Slider1.Value, 0&, 0, 0)
End Sub


Private Sub Command3_Click()
 i = mciSendString("pause video1", 0&, 0, 0)
End Sub


Private Sub Command4_Click()
 i = mciSendString("stop video1", 0&, 0, 0)
 i = mciSendString("seek video1 to start", 0&, 0, 0)
 Slider1.Value = 0
End Sub



Private Sub Command5_Click()
 i = mciSendString("resume video1", 0&, 0, 0)
End Sub

Private Sub Command6_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
i = mciSendString("set video1 audio all off", mssg, 255, 0)
i = mciSendString("status video1 mode", mssg, 255, 0)
FFRR = mssg
Timer2.Enabled = True

End Sub


Private Sub Command6_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
i = mciSendString("set video1 audio all on", mssg, 255, 0)
Timer2.Enabled = False

Select Case Left$(FFRR, 4)
Case "stop"
 i = mciSendString("stop video1", 0&, 0, 0)
Case "play"
 i = mciSendString("play video1", 0&, 0, 0)
Case "paus"
 i = mciSendString("pause video1", 0&, 0, 0)
Case Else
End Select


End Sub


Private Sub Command7_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
i = mciSendString("set video1 audio all off", mssg, 255, 0)
i = mciSendString("status video1 mode", mssg, 255, 0)
FFRR = mssg
Timer3.Enabled = True

End Sub


Private Sub Command7_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
i = mciSendString("set video1 audio all on", mssg, 255, 0)
Timer3.Enabled = False

Select Case Left$(FFRR, 4)
Case "stop"
 i = mciSendString("stop video1", 0&, 0, 0)
Case "play"
 i = mciSendString("play video1", 0&, 0, 0)
Case "paus"
 i = mciSendString("pause video1", 0&, 0, 0)
Case Else
End Select

End Sub




Private Sub Form_Unload(Cancel As Integer)
 i = mciSendString("close video1", 0&, 0, 0)


End Sub



Public Function Get_Size(ShortName As String)
Dim sReturn As String * 128
Dim lPos As Long
Dim lStart As Long
Dim Last$, Todo$, lWidth, lHeight

    
Last$ = Form1.hWnd & " Style " & &H40000000
Todo$ = "open " & ShortName & " Alias video1 parent " & Last$
i = mciSendString(Todo$, 0&, 0, 0)

i = mciSendString("Where video1 destination", ByVal sReturn, Len(sReturn) - 1, 0)
    
lStart = InStr(1, sReturn, " ")
lPos = InStr(lStart + 1, sReturn, " ")
lStart = InStr(lPos + 1, sReturn, " ")
lWidth = Mid(sReturn, lPos, lStart - lPos)
lHeight = Mid(sReturn, lStart + 1)
    
    
i = mciSendString("put video1 window at 8 80 " & lWidth & " " & lHeight, 0&, 0, 0)


i = mciSendString("set video1 time format ms", 0&, 0, 0)
i = mciSendString("status video1 length", mssg, 255, 0)


Slider1.Max = Val(mssg)

 Timer1.Enabled = True
End Function

Private Sub Label1_Click()

End Sub

Private Sub Slider1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

Timer1.Enabled = False
i = mciSendString("status video1 mode", mssg, 255, 0)

If Left$(mssg, 7) = "playing" Then
  ResumeStat = "playing"
Else
  ResumeStat = ""
End If

i = mciSendString("pause video1", 0&, 0, 0)
End Sub


Private Sub Slider1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
 
 i = mciSendString("seek video1 to " & Slider1.Value, 0&, 0, 0)

If ResumeStat = "playing" Then
  i = mciSendString("play video1", 0&, 0, 0)
End If
  
   
  Timer1.Enabled = True
   
End Sub


Private Sub Timer1_Timer()
On Error Resume Next
Dim VidPos As String
Dim SegunI, MinutosI, SegundosI, LTrackPosition
i = mciSendString("status video1 position", mssg, 255, 0)
VidPos = Str(mssg)

Slider1.Value = VidPos
LTrackPosition = mssg
SegunI = Val(LTrackPosition) \ 1000
MinutosI = SegunI \ 60
SegundosI = SegunI Mod 60
Label1.Caption = MinutosI & " min. " & SegundosI & " seg."
If Err Then Exit Sub

End Sub


Private Sub Timer2_Timer()
On Error Resume Next
 i = mciSendString("stop video1", 0&, 0, 0)
 i = mciSendString("status video1 position", mssg, 255, 0)
 
 If mssg + 50 > Slider1.Max Then
     i = mciSendString("seek video1 to end", 0&, 0, 0)
 Else
    i = mciSendString("play video1 from " & mssg + 50, 0&, 0, 0)
 End If
End Sub

Private Sub Timer3_Timer()
On Error Resume Next
 i = mciSendString("stop video1", 0&, 0, 0)
 i = mciSendString("status video1 position", mssg, 255, 0)
 
 If mssg - 50 <= 0 Then
    i = mciSendString("seek video1 to start", 0&, 0, 0)
    Slider1.Value = 0
 Else
    i = mciSendString("play video1 from " & mssg - 50, 0&, 0, 0)
 End If

End Sub

    Option Explicit  
    'Función Api GetShortPathName para obtener _  
    los paths de los archivos en formato corto  
    Private Declare Function GetShortPathName _  
        Lib "kernel32" _  
        Alias "GetShortPathNameA" ( _  
            ByVal lpszLongPath As String, _  
            ByVal lpszShortPath As String, _  
            ByVal lBuffer As Long) As Long  
      
    'Función Api mciExecute para reproducir los archivos de música  
    Private Declare Function mciExecute _  
        Lib "winmm.dll" ( _  
            ByVal lpstrCommand As String) As Long  
    Dim ret As Long, path As String  
      
    'Le pasamos el comando Play  
    Private Sub Command1_Click()  
        ejecutar ("Play ")  
        Habilitar "Play"  
    End Sub  
      
    Private Sub Command2_Click()  
        'Le pasamos el comando Stop  
        ejecutar ("Stop ")  
        Habilitar "Stop"  
    End Sub  
      
    'Le pasamos el comando Pause  
    Private Sub Command3_Click()  
        ejecutar ("Pause ")  
        Habilitar "Pause"  
    End Sub  
      
    'Le pasamos el comando Close a MciExecute para cerrar el dispositivo  
    Private Sub Form_Unload(Cancel As Integer)  
        mciExecute "Close All"  
    End Sub  
      
    'Botón para abrir seleccionar los archivos de audio  
    Private Sub Command4_Click()  
        With CommonDialog1  
            .Filter = "Archivos Wav|*.wav|Archivos Mp3|*.mp3|Archivos MIDI|*.mid"  
            .ShowOpen  
            If .FileName = "" Then  
                Habilitar "Iniciar"  
                Exit Sub  
            Else  
                'Le pasamos a la sub que obtiene con _  
                el Api GetShortPathName el nombre corto del archivo  
                PathCorto .FileName  
                Label1 = .FileName  
                'cerramos todo  
                mciExecute "Close All"  
                'Para Habilitar y deshabilitar botones  
                Habilitar "Stop"  
            End If  
        End With  
    End Sub  
      
    'Sub que obtiene el path corto del archivo a reproducir  
    Private Sub PathCorto(archivo As String)  
    Dim temp As String * 250 'Buffer  
        path = String(255, 0)  
        'Obtenemos el Path corto  
        ret = GetShortPathName(archivo, temp, 164)  
        'Sacamos los nulos al path  
        path = Replace(temp, Chr(0), "")  
    End Sub  
      
    'Procedimiento que ejecuta el comando con el Api mciExecute  
    '************************************************************  
    Private Sub ejecutar(comando As String)  
        If path = "" Then MsgBox "Error", vbCritical: Exit Sub  
        'Llamamos a mciExecute pasandole un string que tiene el comando y la ruta  
      
        mciExecute comando & path  
      
    End Sub  
      
    Private Sub Form_Load()  
        Command1.Caption = "Play >>"  
        Command2.Caption = "Stop ||||"  
        Command3.Caption = "Pause ||"  
        Command4.Caption = ":::: Abrir archivo de música ::::"  
        Habilitar "Iniciar"  
        Label1 = "": Label1.AutoSize = True  
    End Sub  
      
    Private Sub Habilitar(Accion As String)  
        Select Case Accion  
            Case "Iniciar"  
                Command1.Enabled = False  
                Command2.Enabled = False  
                Command3.Enabled = False  
            Case "Play"  
                Command1.Enabled = False  
                Command2.Enabled = True  
                Command3.Enabled = True  
            Case "Stop"  
                Command1.Enabled = True  
                Command2.Enabled = False  
                Command3.Enabled = False  
            Case "Pause"  
                Command1.Enabled = True  
                Command2.Enabled = True  
                Command3.Enabled = False  
        End Select  
    End Sub