Die Community zu .NET und Classic VB.

Startseite / Tipps / VB 5/6-Tipp 0082: Wav und Midi endlos abspielen per API

VB 5/6-Tipp 0082: Wav und Midi endlos abspielen per API

 von ActiveVB

Schwierigkeitsgrad:

Verwendete API-Aufrufe: CallWindowProcA (CallWindowProc), GetShortPathNameA (GetShortPathName), SetWindowLongA (SetWindowLong), mciSendStringA (mciSendString)

Download: Download des Beispielprojektes [12,02 KB]

'Dieser Quellcode stammt von http://www.activevb.de
'und kann frei verwendet werden. Für eventuelle Schäden
'wird nicht gehaftet.

'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
'Ansonsten viel Spaß und Erfolg mit diesem Source!

'------------- Anfang Projektdatei Project1.vbp -------------
'--------- Anfang Formular "Form1" alias Form1.frm  ---------
' Steuerelement: Optionsfeld-Steuerelement "Option1" (Index von 0 bis 1)
' Steuerelement: Schaltfläche "Command2"
' Steuerelement: Schaltfläche "Command1"
' Steuerelement: Beschriftungsfeld "Label1"

Option Explicit

Private Const MAX_PATH As Long = 260&

Private Declare Function GetShortPathName Lib "kernel32" _
        Alias "GetShortPathNameA" (ByVal lpszLongPath As String, _
        ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long

Private Sub Form_Load()
    hForm = Me.hwnd
    Option1(0).Value = True
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode _
                             As Integer)
    Call MCI_Stop
End Sub

Private Sub Command1_Click()
    Call MCI_Start
End Sub

Private Sub Command2_Click()
    Call MCI_Stop
End Sub

Private Sub Option1_Click(Index As Integer)
    Dim sBuffer As String
    Dim nResult As Long
    
    Call MCI_Stop
    If Index = 0 Then
        Path = App.Path & _
            IIf(Right$(App.Path, 1) = "\", "", "\") & "\sound1.wav"
            
    Else
        Path = App.Path & _
            IIf(Right$(App.Path, 1) = "\", "", "\") & "\sound2.mid"
            
    End If
    
    sBuffer = Space(MAX_PATH)
    ' kurzen Dateinamen ermitteln
    nResult = GetShortPathName(Path, sBuffer, Len(sBuffer))
    Path = Left$(sBuffer, InStr(sBuffer, vbNullChar) - 1)
End Sub
'---------- Ende Formular "Form1" alias Form1.frm  ----------
'--------- Anfang Modul "Module1" alias Module1.bas ---------

Option Explicit

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
        
Private Declare Function CallWindowProc Lib "user32" Alias _
        "CallWindowProcA" (ByVal lpPrevWndFunc As Long, _
        ByVal hwnd As Long, ByVal msg As Long, ByVal wParam _
        As Long, ByVal lParam As Long) As Long

Private Declare Function SetWindowLong Lib "user32" Alias _
        "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex _
        As Long, ByVal dwNewLong As Long) As Long

Private Const MCI_NOTIFY As Long = &H3B9&
Private Const MCI_NOTIFY_SUCCESS As Long = &H1&
Private Const GWL_WNDPROC As Long = -4&

Public Path As String
Public hForm As Long
Private hPWnd As Long
Private Repeat As Boolean

Public Sub MCI_Start()
    If Not Repeat Then
        hPWnd = SetWindowLong(hForm, GWL_WNDPROC, AddressOf chkMCI)
        Repeat = True
    End If
    
    Call mciSendString("close " & Path, 0&, 0&, 0&)
    Call mciSendString("open " & Path, 0&, 0&, hForm)
    Call mciSendString("play " & Path & " notify", 0&, 0&, hForm)
End Sub

Public Sub MCI_Stop()
    Call mciSendString("close " & Path, 0&, 0&, 0&)
    
    If Repeat Then
        Call SetWindowLong(hForm, GWL_WNDPROC, hPWnd)
        Repeat = False
    End If
End Sub

Function chkMCI(ByVal hwnd As Long, ByVal uMsg As Long, _
                ByVal wParam As Long, ByVal lParam As Long) As Long
  
    If uMsg = MCI_NOTIFY And wParam = MCI_NOTIFY_SUCCESS Then
        Call MCI_Start
    End If
    
    chkMCI = CallWindowProc(hPWnd, hwnd, uMsg, wParam, lParam)
End Function
'---------- Ende Modul "Module1" alias Module1.bas ----------
'-------------- Ende Projektdatei Project1.vbp --------------

Archivierte Nutzerkommentare 

Klicken Sie diesen Text an, wenn Sie die 4 archivierten Kommentare ansehen möchten.
Diese stammen noch von der Zeit, als es noch keine direkte Forenunterstützung für Fragen und Kommentare zu einzelnen Artikeln gab.
Aus Gründen der Vollständigkeit können Sie sich die ausgeblendeten Kommentare zu diesem Artikel aber gerne weiterhin ansehen.