title image


Smiley Re: hat keiner eine Idee






Meist Du sowas?

Keine Ahnung, obs in Access klappt. In VB 5 und 6 funktionierts.



Gruß Frank





'Abspielen einer MIDI-Datei

Private Sub Form_Load()

    mciOpen App.Path & "\Dateiname.MID"

    mciPlay

End Sub



'Abspielen einer WAV oder MP3 Datei geht genau so. einfach die Datei mit mciOpen... laden.





'Script in MOD_PlaySound

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

'

'





Code eingefügt mit Syntaxhighlighter 4.0





geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: