vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
NEU! sevCoolbar 3.0 - Professionelle Toolbars im modernen Design!  
 vb@rchiv Quick-Search: Suche startenErweiterte Suche starten   Impressum  | Datenschutz  | vb@rchiv CD Vol.6  | Shop Copyright ©2000-2024
 
zurück
Rubrik: Multimedia & Sound · Sonstiges   |   VB-Versionen: VB608.09.03
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 StamprathBewertung:     [ Jetzt bewerten ]Views:  49.251 
www.bluedeveloper.deSystem:  Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11 Beispielprojekt auf CD 

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

Dieser Tipp wurde bereits 49.251 mal aufgerufen.

Voriger Tipp   |   Zufälliger Tipp   |   Nächster Tipp

Über diesen Tipp im Forum diskutieren
Haben Sie Fragen oder Anregungen zu diesem Tipp, können Sie gerne mit anderen darüber in unserem Forum diskutieren.

Aktuelle Diskussion anzeigen (7 Beiträge)

nach obenzurück


Anzeige

Kauftipp Unser Dauerbrenner!Diesen und auch alle anderen Tipps & Tricks finden Sie auch auf unserer aktuellen vb@rchiv  Vol.6
(einschl. Beispielprojekt!)

Ein absolutes Muss - Geballtes Wissen aus mehr als 8 Jahren vb@rchiv!
- nahezu alle Tipps & Tricks und Workshops mit Beispielprojekten
- Symbol-Galerie mit mehr als 3.200 Icons im modernen Look
Weitere Infos - 4 Entwickler-Vollversionen (u.a. sevFTP für .NET), Online-Update-Funktion u.v.m.
 
   

Druckansicht Druckansicht Copyright ©2000-2024 vb@rchiv Dieter Otter
Alle Rechte vorbehalten.
Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein.

Diese Seiten wurden optimiert für eine Bildschirmauflösung von mind. 1280x1024 Pixel