Alles über das Multimedia-Control-Interface (MCI-API) Ein Modul mit Funktionen und Prozeduren, um beliebige Multimedia-Dateien abzuspielen und den Abspielvorgang zu steuern.
Autor:   Steffen Stamprath	Bewertung:     [ Jetzt bewerten ]	Views:  48.826
www.bluedeveloper.de	System:  Win9x, WinNT, Win2k, WinXP, Vista, Win7, Win8, Win10	Beispielprojekt auf CD

Geben Sie hier Ihre persönliche Bewertung ab! Anzahl Bewertungen bisher: 129 Bewertung insgesamt: gut Durchschnittliche Bewertung: 4.1 von 5 Sternen

sehr gut     gut     nützlich     mittelmäßig     mangelhaft

Mit Hilfe des Multimedia-Control-Interface (kurz MCI) lassen sich beliebige im System registrierte Multimedia-Dateien abspielen und steuern - sowohl reine Musikdateien, als auch Videodateien. Wir haben Ihnen alle notwendigen Funktionen in ein Modul zusammengefasst, so dass es ab sofort so gut wie keine Probleme mehr beim Abspielen von Multimedia-Dateien geben sollte

Fügen Sie nachfolgenden Code in ein Modul:

Option Explicit
 
' Benötigte API-Deklarationen
Public 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
 
Public Declare Function GetShortPathName Lib "kernel32" _
  Alias "GetShortPathNameA" ( _
  ByVal lpszLongPath As String, _
  ByVal lpszShortPath As String, _
  ByVal cchBuffer As Long) As Long
 
Public Enum mciType
  fromVideo = 0
  fromSound = 1
End Enum

' Multimedia-Datei öffnen
' Falls es sich um eine Videoausgabe handelt, erwartet die Funktion
' das Fensterhandle des Ausgabe-Controls (z.B. PictureBox oder Form)
' als 2. Parameter (hwnd_Output)
Public Sub mciOpen(ByVal sFile As String, _
  Optional ByVal hwnd_Output As Long = 0)
 
  Dim sBuffer As String * 255
  Dim sType As String
  Dim nResult As Long
  Dim sExt As String
  Dim bVideo As Boolean
 
  On Error Resume Next
 
  ' kurzen Dateinamen ermitteln
  nResult = GetShortPathName(sFile, sBuffer, Len(sBuffer))
  sFile = Left$(sBuffer, InStr(sBuffer, vbNullChar) - 1)
 
  ' Multimedia-Typ ermitteln
  sType = mciGetType(sFile, bVideo)
 
  ' File öffnen
  mciSendString "open " & sFile & " type " & sType & " alias TempMCI", 0, 0, 0
  DoEvents
 
  ' Zeitformat auf Millisekunden einstellen
  mciSendString "set TempMCI time format milliseconds", 0, 0, 0
  DoEvents
 
  ' Falls es sich um eine Video-Datei handelt...
  If bVideo And hwnd_Output <> 0 Then
    mciSendString "window TempMCI handle " & CStr(hwnd_Output), 0, 0, 0
  End If
End Sub

' Multimedia-Datei abspielen
Public Sub mciPlay(Optional nFromPos As Long = 0)
  On Error Resume Next
  mciSendString "play TempMCI from " & CStr(nFromPos), 0, 0, 0
  mciSendString "put TempMCI destination", 0, 0, 0
End Sub

' Multimedia-Datei schließen
Public Sub mciClose()
  On Error Resume Next
  mciSendString "close TempMCI", 0, 0, 0
End Sub

' Abspielvorgang stoppen
Public Sub mciStop()
  On Error Resume Next
  mciSendString "stop TempMCI", 0, 0, 0
End Sub

' Pause
Public Sub mciPause()
  On Error Resume Next
  mciSendString "pause TempMCI", 0, 0, 0
End Sub

' Weiterspielen
Public Sub mciResume()
  On Error Resume Next
  mciSendString "resume TempMCI", 0, 0, 0
  mciSendString "put TempMCI destination", 0, 0, 0
End Sub

' Aktuelle Position ermitteln
Public Function mciCurPos() As Long
  Dim sBuffer As String * 255
 
  On Error Resume Next
  mciSendString "status TempMCI position", sBuffer, Len(sBuffer), 0
  mciCurPos = Val(sBuffer)
End Function

' Gesamtspielzeit ermitteln
Public Function mciGetLength() As Long
  Dim sBuffer As String * 255
 
  On Error Resume Next
  mciSendString "status TempMCI length", sBuffer, Len(sBuffer), 0
  mciGetLength = Val(sBuffer)
End Function

' Geschwindigkeit setzen
Public Sub mciSetSpeed(Optional ByVal nSpeed As Long = 1000)
  On Error Resume Next
  If nSpeed < 0 Or nSpeed > 2000 Then Exit Sub
  mciSendString "set TempMCI speed " & CStr(nSpeed), 0, 0, 0
End Sub

' Multimedia-Typ ermitteln
Public Function mciGetType(ByVal sFile As String, _
  ByRef bVideo As Boolean) As String
 
  Dim sExt As String
 
  bVideo = False
  If InStr(sFile, ".") > 0 Then
    sExt = Right$(sFile, Len(sFile) - InStrRev(sFile, ".", Len(sFile)))
    Select Case LCase(sExt)
      Case "mid", "midi"
        mciGetType = "Sequencer"
      Case "rmi"
        mciGetType = "Sequencer"
      Case "wav"
        mciGetType = "waveaudio"
      Case "cda"
        mciGetType = "CDAudio"
      Case "aif", "aifc", "aiff", "au", "mp3", "snd"
        mciGetType = "MPEGVideo"
      Case "wma"
        mciGetType = "MPEGVideo2"
      Case "mpeg", "mpg", "m1v", "mp2", "mpa", "mpe"
        mciGetType = "MPEGVideo"
        bVideo = True
      Case "avi"
        mciGetType = "AVIVideo"
        bVideo = True
      Case "wmv"
        mciGetType = "MPEGVideo2"
        bVideo = True
      Case Else
        mciGetType = "MPEGVideo"
    End Select
  End If
End Function

' Vollbild-Anzeige
Public Sub mciSetFullscreen(ByVal bFullScreen As Boolean)
  Dim sBuffer As String * 255
 
  On Error Resume Next
  mciSendString "status TempMCI position", sBuffer, Len(sBuffer), 0
  If bFullScreen Then
    mciSendString "play TempMCI fullscreen from " & CStr(Val(sBuffer)), 0, 0, 0
  Else
     mciSendString "play TempMCI window from " & CStr(Val(sBuffer)), 0, 0, 0
  End If
End Sub

' Video-Ausgabegröße setzen
Public Sub mciSetVideoSize(ByVal nX As Long, ByVal nY As Long, _
  ByVal nWidth As Long, ByVal nHeight As Long)
 
  On Error Resume Next
   mciSendString "put TempMCI destination at " & CStr(nX) & " " & CStr(nY) & " " & _
     CStr(nWidth) & " " & CStr(nHeight), 0, 0, 0
End Sub

' Mute ein/aus
Public Sub mciSetMute(ByVal bMute As Boolean)
  On Error Resume Next
  If bMute Then
     mciSendString "set TempMCI audio all off", 0, 0, 0
  Else
     mciSendString "set TempMCI audio all on", 0, 0, 0
  End If
End Sub

' Geöffnete MCI-Datei ermitteln
Public Function mciGetOpenFile() As String
  Dim sBuffer As String * 255
 
  On Error Resume Next
  mciSendString "info TempMCI file", sBuffer, Len(sBuffer), 0
  mciGetOpenFile = Left$(sBuffer, InStr(sBuffer, vbNullChar) - 1)
End Function

' Videobild stretchen
Public Sub mciSetVideoStretch()
  On Error Resume Next
  mciSendString "window TempMCI stretch", 0, 0, 0
End Sub

' aktuellen Status abfragen
Public Function mciGetStatus() As String
  Dim sBuffer As String * 255
 
  On Error Resume Next
  mciSendString "status TempMCI mode", sBuffer, Len(sBuffer), 0
  mciGetStatus = Left$(sBuffer, InStr(sBuffer, vbNullChar) - 1)
End Function

' Videogröße (Breite) ermitteln
Public Function mciGetVideoWidth() As Long
  Dim sBuffer As String * 255
  Dim sTemp() As String
 
  On Error Resume Next
  mciSendString "where TempMCI destination", sBuffer, Len(sBuffer), 0
  sTemp = Split(Left$(sBuffer, InStr(sBuffer, vbNullChar) - 1), " ")
  mciGetVideoWidth = Val(sTemp(2))
End Function

' Videgröße (Höhe) ermitteln
Public Function mciGetVideoHeight() As Long
  Dim sBuffer As String * 255
  Dim sTemp() As String
 
  On Error Resume Next
  mciSendString "where TempMCI destination", sBuffer, Len(sBuffer), 0
  sTemp = Split(Left$(sBuffer, InStr(sBuffer, vbNullChar) - 1), " ")
  mciGetVideoHeight = Val(sTemp(3))
End Function

' Multimedia-Typ der geöffneten Datei ermitteln
Public Function mciGetOpenType() As mciType
  Dim sBuffer As String * 255
 
  On Error Resume Next
  mciSendString "where TempMCI destination", sBuffer, Len(sBuffer), 0
 If Left$(sBuffer, InStr(sBuffer, vbNullChar) - 1) <> "" Then
   mciGetOpenType = fromVideo
 Else
   mciGetOpenType = fromSound
 End If
End Function

' Millisekunden nach mm:ss umrechnen
 Private Function mciFormatTime(ByVal nMSec As Long) As String
  Dim nMin As Integer
  Dim nSec As Integer
 
  nSec = Int(nMSec / 1000)
  nMin = Int(nSec / 60)
  nSec = nSec - (nMin * 60)
  mciFormatTime = Format$(nMin, "00") & ":" & Format$(nSec, "00")
End Function

Beispiel:

' MP3-Datei öffnen und abspielen
mciOpen "c:\mp3s\song.mp3"
mciPlay

' Länge (Spieldauer) ermitteln
Dim nLength As Long
nLength = mciGetLength()
lblLength.Caption = mciFormatTime(nLength)

' Pause (anhalten)
mciPause

' Abspielvorgang fortsetzen
mciResume

' Lautstärke aus
mciSetMute True

' Lautstärke wieder ein
mciSetMute False

' Abspielgeschwindigkeit ändern
mciSetSpeed 1200

' aktuelle Position ermitteln
Dim nPos As Long
nPos = mciGetCurPos()
lblPos.Caption = mciFormatTime(nPos)

' Abspielvorgang beenden und Datei schließen
mciStop
mciClose