home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Game Programming for Teens / VBGPFT.cdr / sources / chapter21 / MusicTest / Form1.frm (.txt) next >
Encoding:
Visual Basic Form  |  2004-10-26  |  4.0 KB  |  125 lines
  1. VERSION 5.00
  2. Begin VB.Form Form1 
  3.    Caption         =   "Form1"
  4.    ClientHeight    =   3195
  5.    ClientLeft      =   60
  6.    ClientTop       =   345
  7.    ClientWidth     =   4680
  8.    LinkTopic       =   "Form1"
  9.    ScaleHeight     =   3195
  10.    ScaleWidth      =   4680
  11.    StartUpPosition =   3  'Windows Default
  12. Attribute VB_Name = "Form1"
  13. Attribute VB_GlobalNameSpace = False
  14. Attribute VB_Creatable = False
  15. Attribute VB_PredeclaredId = True
  16. Attribute VB_Exposed = False
  17. '----------------------------------------------------------------------
  18. ' Visual Basic Game Programming For Teens
  19. ' MusicTest Program
  20. '----------------------------------------------------------------------
  21. Option Explicit
  22. Option Base 0
  23. 'main DirectX object
  24. Dim dx As DirectX8
  25. 'DirectMusic loader object
  26. Private dmLoader As DirectMusicLoader8
  27. 'DirectMusic performance object
  28. Private dmPerf As DirectMusicPerformance8
  29. 'DirectMusic segment object
  30. Private dmSeg As DirectMusicSegment8
  31. 'DirectMusic segment state object
  32. Private dmSegState As DirectMusicSegmentState8
  33. 'DirectMusic audio path object
  34. Private dmPath As DirectMusicAudioPath8
  35. 'DirectMusic audio parameters
  36. Dim dmA As DMUS_AUDIOPARAMS
  37. Private Sub Form_Load()
  38.     'set up line-by-line error checking
  39.     On Local Error Resume Next
  40.     'create the DirectX object
  41.     Set dx = New DirectX8
  42.     'create the DirectMusic loader object
  43.     Set dmLoader = dx.DirectMusicLoaderCreate
  44.     If Err.Number <> 0 Then
  45.         MsgBox "Error creating DirectMusic loader object"
  46.         Shutdown
  47.     End If
  48.     'create the DirectMusic performance object
  49.     Set dmPerf = dx.DirectMusicPerformanceCreate
  50.     If Err.Number <> 0 Then
  51.         MsgBox "Error creating DirectMusic performance object"
  52.         Shutdown
  53.     End If
  54.     'initialize DirectMusic
  55.     dmPerf.InitAudio Me.hWnd, DMUS_AUDIOF_ALL, dmA
  56.     If Err.Number <> 0 Then
  57.         MsgBox "Error initializing DirectMusic audio system"
  58.         Shutdown
  59.     End If
  60.     'create the DirectMusic audio path object
  61.     Set dmPath = dmPerf.CreateStandardAudioPath( _
  62.         DMUS_APATH_DYNAMIC_3D, 64, True)
  63.     If Err.Number <> 0 Then
  64.         MsgBox "Error creating DirectMusic audio path object"
  65.         Shutdown
  66.     End If
  67.     'load the MIDI file
  68.     If Not LoadMusic(App.Path & "\symphony.rmi") Then
  69.         MsgBox "Error loading music file symphony.rmi"
  70.         Shutdown
  71.     End If
  72.     'print some music information to the immediate window
  73.     Debug.Print "Length: " & dmSeg.GetLength
  74.     Debug.Print "Name: " & dmSeg.GetName
  75.     Debug.Print "Repeats: " & CBool(dmSeg.GetRepeats)
  76.     Debug.Print "Clock time: " & dmPerf.GetClockTime
  77.     Debug.Print "Music time: " & dmPerf.GetMusicTime
  78.     Debug.Print "Latency time: " & dmPerf.GetLatencyTime
  79.     PlayMusic
  80. End Sub
  81. Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
  82.     Shutdown
  83. End Sub
  84. Public Function LoadMusic(sFile As String) As Boolean
  85.     On Local Error Resume Next
  86.     LoadMusic = False
  87.     If Len(sFile) = 0 Then Exit Function
  88.     'remove any existing segment
  89.     If Not (dmSeg Is Nothing) Then
  90.         dmSeg.Unload dmPath
  91.         Set dmSeg = Nothing
  92.     End If
  93.     'load the MIDI file
  94.     Set dmSeg = dmLoader.LoadSegment(sFile)
  95.     If Err.Number <> 0 Then Exit Function
  96.     dmSeg.SetStandardMidiFile
  97.     'download the music segment
  98.     dmSeg.Download dmPath
  99.     If Err.Number <> 0 Then Exit Function
  100.     'success
  101.     LoadMusic = True
  102. End Function
  103. Private Sub PlayMusic()
  104.     If dmSeg Is Nothing Then Exit Sub
  105.     Set dmSegState = dmPerf.PlaySegmentEx(dmSeg, 0, 0, Nothing, dmPath)
  106. End Sub
  107. Private Sub StopMusic()
  108.     If dmSeg Is Nothing Then Exit Sub
  109.     dmPerf.StopEx dmSeg, 0, 0
  110. End Sub
  111. Private Sub Shutdown()
  112.     'stop music playback
  113.     If Not (dmPerf Is Nothing) Then
  114.         dmPerf.StopEx dmSeg, 0, 0
  115.         dmPerf.CloseDown
  116.     End If
  117.     'delete DirectMusic objects
  118.     Set dmLoader = Nothing
  119.     Set dmSeg = Nothing
  120.     Set dmPath = Nothing
  121.     Set dmPerf = Nothing
  122.     Set dx = Nothing
  123.     End
  124. End Sub
  125.