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