CodeItBetter Programming Another VB Programming Blog

'MultiMedia - How to Play MPEG-files in VB 6.
Private Declare Function mciGetErrorString Lib "winmm.dll" Alias "mciGetErrorStringA" _
    (ByVal dwError As Long, ByVal lpstrBuffer As String, ByVal uLength 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
Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" _
    (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, _
    ByVal hwndCallback As Long) As Long
 
'Default Property Values:
Const m_def_FileName = ""
 
'Property Variables:
Dim m_FileName As String
 
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=UserControl,UserControl,-1,Enabled
Public Property Get Enabled() As Boolean
    Enabled = UserControl.Enabled
End Property
 
Public Property Let Enabled(ByVal New_Enabled As Boolean)
    UserControl.Enabled() = New_Enabled
    PropertyChanged "Enabled"
End Property
 
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=13,0,0,
Public Property Get FileName() As String
    FileName = m_FileName
End Property
 
Public Property Let FileName(ByVal New_FileName As String)
    m_FileName = New_FileName
    PropertyChanged "FileName"
End Property
 
'Initialize Properties for User Control
Private Sub UserControl_InitProperties()
    m_FileName = m_def_FileName
End Sub
 
'Load property values from storage
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
    UserControl.Enabled = PropBag.ReadProperty("Enabled", True)
    m_FileName = PropBag.ReadProperty("FileName", m_def_FileName)
End Sub
 
Private Sub UserControl_Terminate()
    mmStop
End Sub
 
'Write property values to storage
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
    Call PropBag.WriteProperty("Enabled", UserControl.Enabled, True)
    Call PropBag.WriteProperty("FileName", m_FileName, m_def_FileName)
End Sub
 
Public Function IsPlaying() As Boolean
    Static s As String * 30
    mciSendString "status MPEGPlay mode", s, Len(s), 0
    IsPlaying = (Mid$(s, 1, 7) = "playing")
End Function
 
Public Function mmPlay()
    Dim cmdToDo As String * 255
    Dim dwReturn As Long
    Dim ret As String * 128
 
    Dim tmp As String * 255
    Dim lenShort As Long
    Dim ShortPathAndFie As String
 
    If Dir(FileName) = "" Then
        mmOpen = "Error with input file"
        Exit Function
    End If
    lenShort = GetShortPathName(FileName, tmp, 255)
    ShortPathAndFie = Left$(tmp, lenShort)
    glo_hWnd = hwnd
    cmdToDo = "open " & ShortPathAndFie & " type MPEGVideo Alias MPEGPlay Parent " & _
        UserControl.hwnd & " Style 1073741824"
    dwReturn = mciSendString(cmdToDo, 0&, 0&, 0&)
 
    If dwReturn <> 0 Then  'not success
        mciGetErrorString dwReturn, ret, 128
        mmOpen = ret
        MsgBox ret, vbCritical
        Exit Function
    End If
 
    mmPlay = "Success"
    mciSendString "play MPEGPlay", 0, 0, 0
End Function
 
Public Function mmPause()
    mciSendString "pause MPEGPlay", 0, 0, 0
End Function
 
Public Function mmStop() As String
    mciSendString "stop MPEGPlay", 0, 0, 0
    mciSendString "close MPEGPlay", 0, 0, 0
End Function
 
Public Function PositionInSec()
    Static s As String * 30
    mciSendString "set MPEGPlay time format milliseconds", 0, 0, 0
    mciSendString "status MPEGPlay position", s, Len(s), 0
    PositionInSec = Round(Mid$(s, 1, Len(s)) / 1000)
End Function
 
Public Function Position()
    Static s As String * 30
    mciSendString "set MPEGPlay time format milliseconds", 0, 0, 0
    mciSendString "status MPEGPlay position", s, Len(s), 0
    sec = Round(Mid$(s, 1, Len(s)) / 1000)
    If sec < 60 Then Position = "0:" & Format(sec, "00")
    If sec > 59 Then
        mins = Int(sec / 60)
        sec = sec - (mins * 60)
        Position = Format(mins, "00") & ":" & Format(sec, "00")
    End If
End Function
 
Public Function LengthInSec()
    Static s As String * 30
    mciSendString "set MPEGPlay time format milliseconds", 0, 0, 0
    mciSendString "status MPEGPlay length", s, Len(s), 0
    LengthInSec = Round(Val(Mid$(s, 1, Len(s))) / 1000)
End Function
 
Public Function Length()
    Static s As String * 30
    mciSendString "set MPEGPlay time format milliseconds", 0, 0, 0
    mciSendString "status MPEGPlay length", s, Len(s), 0
    sec = Round(Val(Mid$(s, 1, Len(s))) / 1000)
    If sec < 60 Then Length = "0:" & Format(sec, "00")
    If sec > 59 Then
        mins = Int(sec / 60)
        sec = sec - (mins * 60)
        Length = Format(mins, "00") & ":" & Format(sec, "00")
    End If
End Function
 
Public Function About()
    frmCtlAbout.Show vbModal, Me
End Function
 
Public Function SeekTo(Second)
    mciSendString "set MPEGPlay time format milliseconds", 0, 0, 0
    If IsPlaying = True Then mciSendString "play MPEGPlay from " & Second, 0, 0, 0
    If IsPlaying = False Then mciSendString "seek MPEGPlay to " & Second, 0, 0, 0
End Function