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 48.826 mal aufgerufen.
Anzeige
![]() ![]() ![]() (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. |
TOP Entwickler-Paket ![]() TOP-Preis!! Mit der Developer CD erhalten Sie insgesamt 24 Entwickler- komponenten und Windows-DLLs. Die Einzelkomponenten haben einen Gesamtwert von 1605.50 EUR... Tipp des Monats ![]() Thomas Decker Prüfen, ob ein Verzeichnis existiert III Eine weitere Variante, mit der sich prüfen lässt, ob ein bestimmtes Verzeichnis existiert oder nicht. Neu! sevEingabe 3.0 ![]() Einfach stark! Ein einziges Eingabe-Control für alle benötigten Eingabetypen und -formate, inkl. Kalender-, Taschenrechner und Floskelfunktion, mehrspaltige ComboBox mit DB-Anbindung, ImageComboBox u.v.m. |
||||||||||||||||
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. |