Tipp 0393 MIDI's mit DirectX 8 abspielen (einfach)
Autor/Einsender:
Datum:
  Alexander Csadek
21.04.2004
Entwicklungsumgebung:
DirectX-Version:
  VB 6
DirectX 8
MIDIs mit DirectX abzuspielen mag am Anfang auf Grund der vielen Objekte recht kompliziert aussehen. Wenn man allerdings einmal weiß, wie die Objekte eingesetzt werden müssen, ist es genauso einfach wie das Abspielen eines WAVs mit DirectSound.
Neben dem DirectX8-Objekt werden noch 4 weitere DirectMusic-Objekte benötigt:
-  DirectMusicLoader8
-  DirectMusicSegment8
-  DirectMusicPerformance8
-  DirectMusicSegmentState8
Mit dem DirectMusicLoader8 wird das MIDI geladen. Im DirectMusicSegment8 stehen die Musik-Daten. Über DirectMusicPerformance8 kann das MIDI abgespielt werden und Angaben über das MIDI erhalten wir vom DirectMusicSegmentState8.
 
Option Explicit

Dim DX8           As New DirectX8
Dim MIDLoader     As DirectMusicLoader8
Dim MIDSeg        As DirectMusicSegment8
Dim MIDPerf       As DirectMusicPerformance8
Dim MIDSegState   As DirectMusicSegmentState8

Dim mtTime        As Long
Dim GetStartTime  As Long
Dim Offset        As Long
Dim MIDInPause    As Boolean

Private Sub cmd_Open_Click()
  Set MIDLoader = Nothing
  Set MIDLoader = DX8.DirectMusicLoaderCreate

  Set MIDPerf = Nothing
  Set MIDPerf = DX8.DirectMusicPerformanceCreate

  Dim dmusAudio As DMUS_AUDIOPARAMS
  MIDPerf.InitAudio Me.hWnd, DMUS_AUDIOF_ALL, dmusAudio, _
        Nothing, DMUS_APATH_DYNAMIC_STEREO, 128
  MIDPerf.SetMasterAutoDownload True
  MIDPerf.AddNotificationType DMUS_NOTIFY_ON_SEGMENT

  CDialog_Open.Filter = "MIDI Files (*.mid)|*.mid"
  CDialog_Open.FileName = vbNullString
  CDialog_Open.InitDir = App.Path
  CDialog_Open.ShowOpen

  If CDialog_Open.FileName <> vbNullString Then
    Set MIDSeg = MIDLoader.LoadSegment(CDialog_Open.FileName)
    MIDSeg.SetStandardMidiFile
    MIDSeg.SetStartPoint 0
    cmd_Play.Enabled = True
  Else
    Exit Sub
  End If
End Sub

Private Sub cmd_Play_Click()
  MIDSeg.SetStartPoint 0
  If chk_Loop.Value = vbChecked Then
    MIDSeg.SetRepeats -1
  Else
    MIDSeg.SetRepeats 0
  End If
  Set MIDSegState = MIDPerf.PlaySegmentEx( _
        MIDSeg, DMUS_SEGF_DEFAULT, 0)

  cmd_Open.Enabled = False
  cmd_Play.Enabled = False
  cmd_Pause.Enabled = True
  cmd_Stop.Enabled = True

  Timer1.Enabled = True

  MIDInPause = False
End Sub

Private Sub cmd_Pause_Click()
  If MIDPerf.IsPlaying(MIDSeg, MIDSegState) = True Then
    MIDInPause = True
    Timer1.Enabled = False
    mtTime = MIDPerf.GetMusicTime()
    GetStartTime = MIDSegState.GetStartTime()
    MIDPerf.StopEx MIDSeg, 0, 0
  Else
    Offset = mtTime - GetStartTime + Offset + 1
    MIDSeg.SetStartPoint Offset
    Set MIDSegState = MIDPerf.PlaySegmentEx(MIDSeg, 0, 0)
    MIDInPause = False
    Timer1.Enabled = True
  End If
End Sub

Private Sub cmd_Stop_Click()
  MIDPerf.StopEx MIDSeg, 0, 0

  cmd_Play.Enabled = True
  cmd_Pause.Enabled = False
  cmd_Stop.Enabled = False
  cmd_Open.Enabled = True

  Timer1.Enabled = False
  MIDInPause = False
End Sub

Private Sub cmd_Close_Click()
  If MIDSeg Is Nothing Then
    End
  Else
    If MIDPerf.IsPlaying(MIDSeg, MIDSegState) Then
      MIDPerf.StopEx MIDSeg, 0, 0
    End If

    Set MIDSegState = Nothing
    Set MIDPerf = Nothing
    Set MIDSeg = Nothing
    Set MIDLoader = Nothing
    Set DX8 = Nothing

    End
  End If
End Sub

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

Private Sub Timer1_Timer()
  If MIDInPause Then Exit Sub

  If MIDPerf.IsPlaying(MIDSeg, MIDSegState) = False Then
    Timer1.Enabled = False
    cmd_Play.Enabled = True
    cmd_Pause.Enabled = False
    cmd_Stop.Enabled = False
    cmd_Open.Enabled = True
  End If

End Sub
 
Weitere Links zum Thema
Segmente abspielen (einfach)
Hinweis
Um dieses Beispiel ausführen zu können, wird die DirectX 8 for Visual Basic Type Library benötigt (siehe dazu die Erläuterungen in der DirectX-Rubrik).

Windows-Version
95
98/SE
ME
NT
2000
XP
Vista
Win 7
VB-Version
VBA 5
VBA 6
VB 4/16
VB 4/32
VB 5
VB 6


Download  (18,8 kB) Downloads bisher: [ 440 ]

Vorheriger Tipp Zum Seitenanfang Nächster Tipp

Startseite | Projekte | Tutorials | API-Referenz | VB-/VBA-Tipps | Komponenten | Bücherecke | VB/VBA-Forum | VB.Net-Forum | DirectX-Forum | Foren-Archiv | DirectX | VB.Net-Tipps | Chat | Spielplatz | Links | Suchen | Stichwortverzeichnis | Feedback | Impressum

Seite empfehlen Bug-Report
Letzte Aktualisierung: Dienstag, 6. September 2011