Home > How-To Library > Multimedia

How to Play MPEG-files in VB 6.

****************************************************************
*       © 2007 CodeItBetter http://www.codeitbetter.com        *
*          This notice MUST stay intact for legal use          *
****************************************************************

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

If you would like to submit your code here please us. Do not forget to mention your name. We are always thankful to each and everyone of you who submitted their code here.