VERSION 1.0 CLASS BEGIN MultiUse = -1 'True Persistable = 0 'NotPersistable DataBindingBehavior = 0 'vbNone DataSourceBehavior = 0 'vbNone MTSTransactionMode = 0 'NotAnMTSObject END Attribute VB_Name = "cDirectMusic8" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = True Attribute VB_PredeclaredId = False Attribute VB_Exposed = False Option Explicit '============================================================================================================= ' ' cDirectMusic8 Class Module ' -------------------------- ' ' Created By : Kevin Wilson ' http://www.TheVBZone.com ( The VB Zone ) ' http://www.TheVBZone.net ( The VB Zone .net ) ' ' Last Update : May 08, 2001 ' ' VB Versions : 5.0 / 6.0 ' ' Requires : Windows 95/98/ME/2000 with Microsoft DirectX 8a (or better) installed [See Note For WinNT4] ' DX8VB.DLL (Microsoft DirectX 8a library for Visual Basic) ' ' Description : This class module gives you easy access to the DirectMusic components and functionality ' contained within DirectX 8a. One of the biggest advantages of using DirectMusic over just ' the Win32 API for playing music is DirectMusic automatically mixes the music when multiple ' MIDIs are played at the same time. When using the Win32 API, you either have to play one ' at a time, or go through a VERY complex process of mixing and playing MIDIs to do what ' DirectMusic has built into it. ' ' NOTE : This class module was not meant to be run on Windows NT 4.0. WinNT 4 (SP3) comes with ' DirectX 3 installed. However, since that service pack, the DirectX components in WinNT 4 ' have not be updated. ' ' NOTE : Because DirectX 8 integrats DirectSound and DirectMusic into DirectAudio more than DirectX 7, ' you can actually play .WAV, .MID, .RMI, and .SGT files all exactly the same using the ' DirectMusic sub-system. This allows you access to such DirectMusic features as special sound ' effects via the DirectSoundSecondaryBuffer8.SetFX method. ' ' WARNING : Make sure that you properly shut down this class module by setting it to NOTHING in the Form_Unload ' event. Failing to do so may result in your application crashing. ' ' See Also : The DirectX 8a SDK Samples & Documentation ' http://www.microsoft.com/directx ' http://msdn.microsoft.com/library/psdk/directx/DX8_VB/hh/directx8_vb/_dx_basic_steps_in_playing_sounds_dxaudio.htm ' http://msdn.microsoft.com/library/psdk/directx/DX8_VB/hh/directx8_vb/_dx_basic_concepts_of_directx_audio_dxaudio.htm ' http://msdn.microsoft.com/library/psdk/directx/DX8_VB/hh/directx8_vb/_dx_tutorial_1_playing_audio_files_dxaudio_vb.htm ' ' Example Use : ' ' Option Explicit ' Private DM As cDirectMusic8 ' Private DS As cDirectSound8 ' Private Sub Form_Load() ' Me.Show ' Set DS = New cDirectSound8 ' DS.Initialize Me.hWnd ' Set DM = New cDirectMusic8 ' DM.Initialize , DS.rDirectSound ' DS.Wave_LoadFile "C:\TEST.WAV" ' DM.MIDI_LoadFile "C:\TEST.MID" ' DS.Wave_Play 1 ' DM.MIDI_Play 1 ' While DM.CurrentTimeTicks(1) < DM.PlayLengthTicks(1) ' Loop until the MIDI has finished playing ' DoEvents ' Wend ' Unload Me ' End Sub ' ' Private Sub Form_Unload(Cancel As Integer) ' Set DS = Nothing ' Set DM = Nothing ' End Sub ' '============================================================================================================= ' ' LEGAL: ' ' You are free to use this code as long as you keep the above heading information intact and unchanged. Credit ' given where credit is due. Also, it is not required, but it would be appreciated if you would mention ' somewhere in your compiled program that that your program makes use of code written and distributed by ' Kevin Wilson (www.TheVBZone.com). Feel free to link to this code via your web site or articles. ' ' You may NOT take this code and pass it off as your own. You may NOT distribute this code on your own server ' or web site. You may NOT take code created by Kevin Wilson (www.TheVBZone.com) and use it to create products, ' utilities, or applications that directly compete with products, utilities, and applications created by Kevin ' Wilson, TheVBZone.com, or Wilson Media. You may NOT take this code and sell it for profit without first ' obtaining the written consent of the author Kevin Wilson. ' ' These conditions are subject to change at the discretion of the owner Kevin Wilson at any time without ' warning or notice. Copyright© by Kevin Wilson. All rights reserved. ' '============================================================================================================= ' Custom type that holds the information about each MIDI loaded Private Type MidiType Index As Integer Segmnt As DxVBLibA.DirectMusicSegment8 SegmntState As DxVBLibA.DirectMusicSegmentState8 FilePath As String ResName As String LoopPlay As Boolean State As Byte Tempo As Single dLength As Double sLength As String TimeSignature As String StartPoint As Long End Type ' MIDI Play States Private Enum MidiStates ms_None = 0 ms_Loaded = 1 ms_Playing = 2 ms_Paused = 3 ms_Stopped = 4 End Enum ' DirectX / DirectMusic Variables Private dX As DxVBLibA.DirectX8 Private DM_Perf As DxVBLibA.DirectMusicPerformance8 Private DM_Loader As DxVBLibA.DirectMusicLoader8 Private DM_Midi() As MidiType Private DM_Count As Integer Private DM_IndexCount As Integer ' Property Variables Private p_StartUpOK As Boolean Private p_InitOK As Boolean Private p_SearchDir As String 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX Private Sub Class_Initialize() On Error GoTo ErrorTrap ' Create a reference to the DirectX8 object Set dX = New DxVBLibA.DirectX8 ' Create a Loader object Set DM_Loader = dX.DirectMusicLoaderCreate ' Create a Performance object to control the audio performance Set DM_Perf = dX.DirectMusicPerformanceCreate ' Set the default search path p_SearchDir = CurDir If p_SearchDir = "" Then p_SearchDir = "C:\" If Right(p_SearchDir, 1) <> "\" Then p_SearchDir = p_SearchDir & "\" DM_Loader.SetSearchDirectory p_SearchDir p_StartUpOK = True Exit Sub ErrorTrap: On Error Resume Next Set dX = Nothing Set DM_Loader = Nothing Set DM_Perf = Nothing MsgBox "The following error occured while trying to initialize the DirectX and DirectMusic modules:" & Chr(13) & Chr(13) & "Error Number = " & CStr(Err.Number) & Chr(13) & "Error Description = " & Err.Description, vbOKOnly + vbExclamation, " Initialization Error" Err.Clear End Sub Private Sub Class_Terminate() On Error Resume Next ' Clear all the information about the files used MIDI_ClearAll ' Close down the performance object DM_Perf.CloseDown ' Set the DirectX objects to nothing Set dX = Nothing Set DM_Perf = Nothing Set DM_Loader = Nothing End Sub 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX ' Gets the current position of the playing MIDI in "ticks" Public Property Get CurrentTimeTicks(ByVal Index As Integer) As Long On Error Resume Next Dim TheIndex As Integer ' Make sure the index is valid TheIndex = FindArrayIndex(Index) If TheIndex = -1 Then Exit Property If DM_Midi(TheIndex).State = ms_Paused Or DM_Midi(TheIndex).State = ms_Playing Then CurrentTimeTicks = DM_Midi(TheIndex).SegmntState.GetSeek Else CurrentTimeTicks = 0 End If End Property ' Gets the current position of the playing MIDI in "seconds" Public Property Get CurrentTimeSecs(ByVal Index As Integer) As String On Error Resume Next Dim TheIndex As Integer Dim ElapsedTime As Double Dim Minutes As Integer Dim TimeCounter As Single ' Make sure the index is valid TheIndex = FindArrayIndex(Index) If TheIndex = -1 Then Exit Property ' If the MIDI is stopped, then return zero time If DM_Midi(TheIndex).State <> ms_Playing And DM_Midi(TheIndex).State <> ms_Paused Then CurrentTimeSecs = "00:00.0" Exit Property End If ' Get time in raw seconds ElapsedTime = ((DM_Midi(TheIndex).SegmntState.GetSeek / 768) * 60) / DM_Midi(TheIndex).Tempo ' Calculate minutes Minutes = 0 TimeCounter = ElapsedTime - 60 Do While TimeCounter >= 0 Minutes = Minutes + 1 TimeCounter = TimeCounter - 60 Loop ' Print out the time with the proper format CurrentTimeSecs = Format(Minutes, "00") & ":" & Format(Abs((ElapsedTime - (Minutes * 60))), "00.0") End Property ' Returns or sets the default directory. This is used to try to locate the specified ' MIDI file if a full path is not specified Public Property Get DefaultDirectory() As String On Error Resume Next If p_InitOK = False Or p_StartUpOK = False Then Exit Property DefaultDirectory = p_SearchDir End Property Public Property Let DefaultDirectory(ByVal NewValue As String) On Error Resume Next If p_InitOK = False Or p_StartUpOK = False Then Exit Property ' Make sure the directory is valid p_SearchDir = Trim(NewValue) If p_SearchDir = "" Then p_SearchDir = "C:\" If Right(p_SearchDir, 1) <> "\" Then p_SearchDir = p_SearchDir & "\" DM_Loader.SetSearchDirectory p_SearchDir End Property ' Returns the file path of the specified MIDI that has been loaded Public Property Get FilePath(ByVal Index As Integer) As String On Error Resume Next Dim TheIndex As Integer ' Make sure the index is valid TheIndex = FindArrayIndex(Index) If TheIndex = -1 Then Exit Property FilePath = DM_Midi(TheIndex).FilePath End Property ' Returns if this class module has been properly initialized Public Property Get InitOK() As Variant On Error Resume Next InitOK = p_InitOK End Property ' Returns or sets whether the specified MIDI file should loop it's play Public Property Get LoopPlay(ByVal Index As Integer) As Boolean On Error Resume Next Dim TheIndex As Integer ' Make sure the index is valid TheIndex = FindArrayIndex(Index) If TheIndex = -1 Then Exit Property LoopPlay = DM_Midi(TheIndex).LoopPlay End Property Public Property Let LoopPlay(ByVal Index As Integer, ByVal NewValue As Boolean) On Error Resume Next Dim TheIndex As Integer ' Make sure the index is valid TheIndex = FindArrayIndex(Index) If TheIndex = -1 Then Exit Property DM_Midi(TheIndex).LoopPlay = NewValue End Property ' Returns or sets the play position (in ticks) of the specified MIDI file Public Property Get StartPosition(ByVal Index As Integer) As Long On Error Resume Next Dim TheIndex As Integer ' Make sure the index is valid TheIndex = FindArrayIndex(Index) If TheIndex = -1 Then Exit Property StartPosition = DM_Midi(TheIndex).StartPoint End Property Public Property Let StartPosition(ByVal Index As Integer, ByVal NewValue As Long) On Error Resume Next Dim TheIndex As Integer ' Make sure the index is valid TheIndex = FindArrayIndex(Index) If TheIndex = -1 Then Exit Property DM_Midi(TheIndex).StartPoint = NewValue End Property ' Returns the resource name of the specified loaded MIDI file Public Property Get ResourceName(ByVal Index As Integer) As String On Error Resume Next Dim TheIndex As Integer ' Make sure the index is valid TheIndex = FindArrayIndex(Index) If TheIndex = -1 Then Exit Property ResourceName = DM_Midi(TheIndex).ResName End Property ' Returns the total play time of the specified MIDI file in "ticks" Public Property Get PlayLengthTicks(ByVal Index As Integer) As Double On Error Resume Next Dim TheIndex As Integer ' Make sure the index is valid TheIndex = FindArrayIndex(Index) If TheIndex = -1 Then Exit Property PlayLengthTicks = DM_Midi(TheIndex).dLength End Property ' Returns the total play time of the specified MIDI file in "seconds" Public Property Get PlayLengthSeconds(ByVal Index As Integer) As String On Error Resume Next Dim TheIndex As Integer ' Make sure the index is valid TheIndex = FindArrayIndex(Index) If TheIndex = -1 Then Exit Property PlayLengthSeconds = DM_Midi(TheIndex).sLength End Property ' Returns or sets the modification value of the tempo of all MIDI files that are played. ' This is specified in PERCENT : 100 = Normal speed, 50 = Half speed, 200 = Double speed. Public Property Get TempoModifier() As Single On Error Resume Next If p_InitOK = False Or p_StartUpOK = False Then Exit Property TempoModifier = DM_Perf.GetMasterTempo * 100 End Property Public Property Let TempoModifier(ByVal NewValue As Single) On Error Resume Next If p_InitOK = False Or p_StartUpOK = False Then Exit Property If NewValue < 1 Then NewValue = 1 If NewValue > 1000 Then NewValue = 1000 DM_Perf.SetMasterTempo NewValue / 100 End Property ' Returns the tempo of the specified MIDI file Public Property Get Tempo(ByVal Index As Integer) As Single On Error Resume Next Dim TheIndex As Integer ' Make sure the index is valid TheIndex = FindArrayIndex(Index) If TheIndex = -1 Then Exit Property Tempo = DM_Midi(TheIndex).Tempo End Property ' Returns the time signature of the specified MIDI file Public Property Get TimeSignature(ByVal Index As Integer) As String On Error Resume Next Dim TheIndex As Integer ' Make sure the index is valid TheIndex = FindArrayIndex(Index) If TheIndex = -1 Then Exit Property TimeSignature = DM_Midi(TheIndex).TimeSignature End Property ' Returns or sets the volume of all MIDI files that are played Public Property Get Volume() As Long On Error Resume Next If p_InitOK = False Or p_StartUpOK = False Then Exit Property Volume = (DM_Perf.GetMasterVolume + 3000) / 42 End Property Public Property Let Volume(ByVal NewValue As Long) On Error Resume Next If p_InitOK = False Or p_StartUpOK = False Then Exit Property DM_Perf.SetMasterVolume ((NewValue * 42) - 3000) End Property 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX '============================================================================================================= ' Initialize ' ' Initializes DirectMusic correctly. ' ' NOTE : You can initialize DirectMusic without specifying a form handle nor a DirectSound reference. ' However, it is highly recommended that you specify one or the other to improve performance and reduce ' the possibliity of problems. ' ' IMPORTANT : If you are using DirectSound along with DirectMusic, YOU MUST pass a reference to the ' DirectSound8 object you're using for DirectSound. ' ' Parameter: Use: ' -------------------------------------------------- ' CallingFormHandle Optional. Specifies the handle of the calling form. This parameter is ' ignored if the "rDirectSound" parameter is passed as well. ' rDirectSound Optional. Specifies a reference to a previously created DirectSound object. ' If specified, DirectSound and DirectMusic will work much better together. ' ' Return: ' ------- ' If successful, returns TRUE ' If failed, returns FALSE ' '============================================================================================================= Public Function Initialize(Optional ByVal CallingFormHandle As Long, _ Optional ByRef rDirectSound As DxVBLibA.DirectSound8) As Boolean On Error GoTo ErrorTrap Dim AudioParams As DxVBLibA.DMUS_AUDIOPARAMS If p_StartUpOK = False Then Exit Function ' Initialize the Preference If Not rDirectSound Is Nothing Then DM_Perf.InitAudio CallingFormHandle, DMUS_AUDIOF_ALL, AudioParams, rDirectSound, DMUS_APATH_DYNAMIC_STEREO, 128 Else DM_Perf.InitAudio CallingFormHandle, DMUS_AUDIOF_ALL, AudioParams, Nothing, DMUS_APATH_DYNAMIC_STEREO, 128 End If ' Set the performance object to download BANDs automatically DM_Perf.SetMasterAutoDownload True ' Set the initial volume DM_Perf.SetMasterVolume (50 * 42 - 3000) ' Set the initial tempo DM_Perf.SetMasterTempo 1 p_InitOK = True Exit Function ErrorTrap: Err.Clear End Function '============================================================================================================= ' MIDI_Clear ' ' Clears the specified MIDI file after it is loaded ' ' Parameter: Use: ' -------------------------------------------------- ' Index Specifies the index of the loaded MIDI. The "MIDI_LoadFile" and "MIDI_LoadRes" ' functions return this index when the MIDI is loaded. ' ' Return: ' ------- ' If successful, returns TRUE ' If failed, returns FALSE ' '============================================================================================================= Public Function MIDI_Clear(ByVal Index As Integer) As Boolean On Error Resume Next Dim TheIndex As Integer ' Make sure the index is valid TheIndex = FindArrayIndex(Index) If TheIndex = -1 Then Exit Function ' Set the start point to 0 (Avoids problems with internal caching) With DM_Midi(TheIndex) DM_Perf.StopEx .Segmnt, 0, 0 DM_Perf.StopEx .SegmntState, 0, 0 .Segmnt.SetStartPoint 0 ' Delete the wave information for the specified wave Set .Segmnt = Nothing Set .SegmntState = Nothing .Index = 0 .FilePath = "" .ResName = "" .dLength = 0 .sLength = "" .State = ms_None .Tempo = 0 .TimeSignature = "" .LoopPlay = False .StartPoint = 0 End With ' If the specified wave is the LAST one, redim to one smaller to delete it. If the specified wave is ' NOT last, replace it with the last one and redim one smaller to delete the one that replaced it. If TheIndex <> DM_Count Then With DM_Midi(TheIndex) Set .Segmnt = DM_Midi(DM_Count).Segmnt Set .SegmntState = DM_Midi(DM_Count).SegmntState .Index = DM_Midi(DM_Count).Index .FilePath = DM_Midi(DM_Count).FilePath .ResName = DM_Midi(DM_Count).ResName .dLength = DM_Midi(DM_Count).dLength .sLength = DM_Midi(DM_Count).sLength .State = DM_Midi(DM_Count).State .Tempo = DM_Midi(DM_Count).Tempo .TimeSignature = DM_Midi(DM_Count).TimeSignature .LoopPlay = DM_Midi(DM_Count).LoopPlay .StartPoint = DM_Midi(DM_Count).StartPoint End With End If DM_Count = DM_Count - 1 ReDim Preserve DM_Midi(DM_Count) As MidiType MIDI_Clear = True End Function '============================================================================================================= ' MIDI_ClearAll ' ' Clears ALL MIDI files that have been loaded ' ' Parameter: Use: ' -------------------------------------------------- ' None ' ' Return: ' ------- ' If successful, returns TRUE ' If failed, returns FALSE ' '============================================================================================================= Public Function MIDI_ClearAll() As Boolean On Error Resume Next Dim MyCounter As Integer ' If there are no files loaded, set the variables to their default values If DM_Count < 1 Then DM_Count = 0 DM_IndexCount = 0 Erase DM_Midi Exit Function End If ' Destroy the objects for each file For MyCounter = 1 To DM_Count DM_Perf.StopEx DM_Midi(MyCounter).Segmnt, 0, 0 DM_Perf.StopEx DM_Midi(MyCounter).SegmntState, 0, 0 DM_Midi(MyCounter).Segmnt.SetStartPoint 0 Set DM_Midi(MyCounter).Segmnt = Nothing Set DM_Midi(MyCounter).SegmntState = Nothing Next ' Destroy all info for the files DM_Count = 0 DM_IndexCount = 0 Erase DM_Midi MIDI_ClearAll = True End Function '============================================================================================================= ' MIDI_LoadFile ' ' Loads the MIDI file specified by the FilePath parameter ' ' Parameter: Use: ' -------------------------------------------------- ' FilePath Specifies the path to the MIDI file to load. If the "DefaultDirectory" property ' has been set to reflect the directory of the MIDI file, the full path does not have ' to be specified here, just the file name. ' Return_Index Optional. Returns the index number of the MIDI file once loaded. ' ' Return: ' ------- ' If successful, returns TRUE ' If failed, returns FALSE ' '============================================================================================================= Public Function MIDI_LoadFile(ByVal FilePath As String, _ Optional ByRef Return_Index As Integer) As Boolean On Error GoTo ErrorTrap Dim TimeSignature As DxVBLibA.DMUS_TIMESIGNATURE Dim lngTime As Long Dim sglTempo As Single Dim timSig As String Dim timLen As String Dim dLength As Double Dim Minutes As Integer Dim TimeCounter As Double Dim DeleteNew As Boolean ' Set the default return values MIDI_LoadFile = False Return_Index = -1 ' Reset the loader object to avoid caching problems Set DM_Loader = Nothing Set DM_Loader = dX.DirectMusicLoaderCreate ' Make sure parameters are valid If p_InitOK = False Or p_StartUpOK = False Then Exit Function FilePath = Trim(FilePath) If FilePath = "" Then Exit Function If InStr(FilePath, "\") > 0 Then If CheckFileExists(FilePath) = False Then Exit Function Else If CheckFileExists(p_SearchDir & FilePath) = False Then Exit Function End If ' Load a new sound DeleteNew = True DM_IndexCount = DM_IndexCount + 1 DM_Count = DM_Count + 1 ReDim Preserve DM_Midi(DM_Count) As MidiType ' Load the MIDI file from the resource Set DM_Midi(DM_Count).Segmnt = DM_Loader.LoadSegment(FilePath) ' Get the MIDI's information lngTime = DM_Midi(DM_Count).Segmnt.GetLength ' Play the midi long enough to get it's information DM_Midi(DM_Count).Segmnt.SetStartPoint lngTime - 1 DM_Perf.PlaySegmentEx DM_Midi(DM_Count).Segmnt, 0, 0 ' Get the MIDI's tempo sglTempo = CSng(Format(DM_Perf.GetTempo(lngTime - 1, 0), "00.00")) ' Get the MIDI's time signature DM_Perf.GetTimeSig lngTime - 1, 0, TimeSignature timSig = CStr(TimeSignature.beatsPerMeasure & "/" & TimeSignature.beat) ' Stop the midi DM_Perf.StopEx DM_Midi(DM_Count).Segmnt, 0, 0 DM_Midi(DM_Count).Segmnt.SetStartPoint 0 ' Get the MIDI's length Minutes = 0 dLength = (((DM_Midi(DM_Count).Segmnt.GetLength / 768) * 60) / sglTempo) TimeCounter = dLength - 60 Do While TimeCounter > 0 Minutes = Minutes + 1 TimeCounter = TimeCounter - 60 Loop timLen = Format(Minutes, "00") & ":" & Format((dLength - (Minutes * 60)), "00.0") ' Set the mode based on the file name If LCase(Right(FilePath, 4)) = ".mid" Or LCase(Right(FilePath, 5)) = ".midi" Then DM_Midi(DM_Count).Segmnt.SetStandardMidiFile DM_Midi(DM_Count).Index = DM_IndexCount DM_Midi(DM_Count).State = ms_Loaded DM_Midi(DM_Count).ResName = "" DM_Midi(DM_Count).FilePath = FilePath DM_Midi(DM_Count).dLength = lngTime DM_Midi(DM_Count).sLength = timLen DM_Midi(DM_Count).Tempo = sglTempo DM_Midi(DM_Count).TimeSignature = timSig DM_Midi(DM_Count).LoopPlay = False DM_Midi(DM_Count).StartPoint = 0 ' Function successfull Return_Index = DM_Count DM_Midi(DM_Count).State = ms_Loaded MIDI_LoadFile = True Exit Function ErrorTrap: MsgBox "The following error occured while trying to load the specified MIDI file:" & Chr(13) & Chr(13) & "Error Number = " & CStr(Err.Number) & Chr(13) & "Error Description = " & Err.Description, vbOKOnly + vbExclamation, " Initialization Error" Err.Clear If DeleteNew = True Then Set DM_Midi(DM_Count).Segmnt = Nothing Set DM_Midi(DM_Count).SegmntState = Nothing DM_IndexCount = DM_IndexCount - 1 DM_Count = DM_Count - 1 ReDim Preserve DM_Midi(DM_Count) As MidiType End If End Function '============================================================================================================= ' MIDI_LoadRes ' ' Loads the MIDI file specified by the "ResourceName" from the DLL or EXE specified by the "FilePath" ' parameter ' ' IMPORTANT : To load a MIDI file from a resource file, it must be stored under the resource section ' type named "DMSEG" ' ' Parameter: Use: ' -------------------------------------------------- ' ResourceName Specifies the name of the resource to load from the specified FilePath. ' FilePath Specifies the path to the resource file containing the MIDI file to load. If ' the "DefaultDirectory" property has been set to reflect the directory of the MIDI file, the full path does not have ' to be specified here, just the file name. ' Return_Index Optional. Returns the index number of the MIDI file once loaded. ' ' Return: ' ------- ' If successful, returns TRUE ' If failed, returns FALSE ' '============================================================================================================= Public Function MIDI_LoadRes(ByVal ResourceName As String, _ ByVal FilePath As String, _ Optional ByRef Return_Index As Integer) As Boolean On Error GoTo ErrorTrap Dim TimeSignature As DxVBLibA.DMUS_TIMESIGNATURE Dim lngTime As Long Dim sglTempo As Single Dim timSig As String Dim timLen As String Dim dLength As Double Dim Minutes As Integer Dim TimeCounter As Double Dim DeleteNew As Boolean ' Set the default return values MIDI_LoadRes = False Return_Index = -1 ' Make sure parameters are valid If p_InitOK = False Or p_StartUpOK = False Then Exit Function FilePath = Trim(FilePath) If FilePath = "" Then Exit Function If InStr(FilePath, "\") > 0 Then If CheckFileExists(FilePath) = False Then Exit Function Else If CheckFileExists(p_SearchDir & FilePath) = False Then Exit Function End If ' Load a new sound DeleteNew = True DM_IndexCount = DM_IndexCount + 1 DM_Count = DM_Count + 1 ReDim Preserve DM_Midi(DM_Count) As MidiType ' Load the MIDI file from the resource Set DM_Midi(DM_Count).Segmnt = DM_Loader.LoadSegmentFromResource(FilePath, ResourceName) ' Get the MIDI's information lngTime = DM_Midi(DM_Count).Segmnt.GetLength ' Play the midi long enough to get it's information DM_Perf.PlaySegmentEx DM_Midi(DM_Count).Segmnt, 0, lngTime - 1 ' Get the MIDI's tempo sglTempo = CSng(Format(DM_Perf.GetTempo(lngTime - 1, 0), "00.00")) ' Get the MIDI's time signature DM_Perf.GetTimeSig lngTime + 2000, 0, TimeSignature timSig = CStr(TimeSignature.beatsPerMeasure & "/" & TimeSignature.beat) ' Get the MIDI's length Minutes = 0 dLength = (((DM_Midi(DM_Count).Segmnt.GetLength / 768) * 60) / sglTempo) TimeCounter = dLength - 60 Do While TimeCounter > 0 Minutes = Minutes + 1 TimeCounter = TimeCounter - 60 Loop timLen = Format(Minutes, "00") & ":" & Format((dLength - (Minutes * 60)), "00.0") ' Set the mode based on the file name If LCase(Right(ResourceName, 4)) = ".mid" Or LCase(Right(ResourceName, 5)) = ".midi" Then DM_Midi(DM_Count).Segmnt.SetStandardMidiFile ' Stop the midi DM_Perf.StopEx DM_Midi(DM_Count).Segmnt, 0, 0 DM_Midi(DM_Count).Index = DM_IndexCount DM_Midi(DM_Count).State = ms_Loaded DM_Midi(DM_Count).ResName = ResourceName DM_Midi(DM_Count).FilePath = FilePath DM_Midi(DM_Count).dLength = dLength DM_Midi(DM_Count).sLength = timLen DM_Midi(DM_Count).Tempo = sglTempo DM_Midi(DM_Count).TimeSignature = timSig DM_Midi(DM_Count).LoopPlay = False DM_Midi(DM_Count).StartPoint = 0 ' Function successfull Return_Index = DM_Count DM_Midi(DM_Count).State = ms_Loaded MIDI_LoadRes = True Exit Function ErrorTrap: Err.Clear If DeleteNew = True Then Set DM_Midi(DM_Count).Segmnt = Nothing Set DM_Midi(DM_Count).SegmntState = Nothing DM_IndexCount = DM_IndexCount - 1 DM_Count = DM_Count - 1 ReDim Preserve DM_Midi(DM_Count) As MidiType End If End Function '============================================================================================================= ' MIDI_Pause ' ' Pauses the specified MIDI file if it is playing. ' ' Parameter: Use: ' -------------------------------------------------- ' Index Specifies the index of the loaded MIDI. The "MIDI_LoadFile" and "MIDI_LoadRes" ' functions return this index when the MIDI is loaded. ' ' Return: ' ------- ' If successful, returns TRUE ' If failed, returns FALSE ' '============================================================================================================= Public Function MIDI_Pause(ByVal Index As Integer) As Boolean On Error Resume Next Dim TheIndex As Integer ' Make sure the index is valid TheIndex = FindArrayIndex(Index) If TheIndex = -1 Then Exit Function ' Pause the MIDI With DM_Midi(TheIndex) .StartPoint = .SegmntState.GetSeek DM_Perf.StopEx .Segmnt, 0, 0 .State = ms_Paused End With MIDI_Pause = True End Function '============================================================================================================= ' MIDI_Play ' ' Plays the specified MIDI file ' ' Parameter: Use: ' -------------------------------------------------- ' Index Specifies the index of the loaded MIDI. The "MIDI_LoadFile" and "MIDI_LoadRes" ' functions return this index when the MIDI is loaded. ' ' Return: ' ------- ' If successful, returns TRUE ' If failed, returns FALSE ' '============================================================================================================= Public Function MIDI_Play(ByVal Index As Integer) As Boolean On Error Resume Next Dim TheIndex As Integer Dim bCancel As Boolean ' Make sure the index is valid TheIndex = FindArrayIndex(Index) If TheIndex = -1 Then Exit Function ' Play the MIDI With DM_Midi(TheIndex) ' Set loop playback If .LoopPlay = True Then .Segmnt.SetRepeats 65000 ' This is how many times the loop loops. This can be set higher, but I figure 65,000 would do. .Segmnt.SetLoopPoints 0, .Segmnt.GetLength - 1 Else .Segmnt.SetRepeats 0 .Segmnt.SetLoopPoints 0, 0 End If ' Set the play point to the start point, and play the MIDI (this allows for pause ability) .Segmnt.SetStartPoint .StartPoint Set .SegmntState = DM_Perf.PlaySegmentEx(.Segmnt, 0, 0) .State = ms_Playing End With MIDI_Play = True End Function '============================================================================================================= ' MIDI_Stop ' ' Stops the play of the specified MIDI file ' ' Parameter: Use: ' -------------------------------------------------- ' Index Specifies the index of the loaded MIDI. The "MIDI_LoadFile" and "MIDI_LoadRes" ' functions return this index when the MIDI is loaded. ' ' Return: ' ------- ' If successful, returns TRUE ' If failed, returns FALSE ' '============================================================================================================= Public Function MIDI_Stop(ByVal Index As Integer) As Boolean On Error Resume Next Dim TheIndex As Integer ' Make sure the index is valid TheIndex = FindArrayIndex(Index) If TheIndex = -1 Then Exit Function ' Stop the play and set the start point to 0 With DM_Midi(TheIndex) DM_Perf.StopEx .Segmnt, 0, 0 DM_Perf.StopEx .SegmntState, 0, 0 .State = ms_Stopped End With MIDI_Stop = True End Function 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX ' Checks to make sure the specified file exists Private Function CheckFileExists(ByVal FilePath As String) As Boolean On Error GoTo ExitOut Dim FileNum As Integer ' Make sure file path specified is valid FilePath = Trim(FilePath) If FilePath = "" Then Exit Function ' Check if file exists using the "Dir" command (this doesn't work on hidden files) If Dir(FilePath) <> "" Then CheckFileExists = True Exit Function End If ' Get an availble file number FileNum = FreeFile ' Open the file - If error occurs, file doesn't exist Open FilePath For Input As FileNum Close FileNum CheckFileExists = True ExitOut: Err.Clear End Function ' Finds the variable array index based on the file index Private Function FindArrayIndex(ByVal Index As Integer) As Integer On Error Resume Next Dim MyCounter As Integer ' Set the default return value FindArrayIndex = -1 If p_InitOK = False Or p_StartUpOK = False Then Exit Function ' Make sure that the index is valid If DM_Count < 1 Then Exit Function If Index < 1 Or Index > DM_IndexCount Then Exit Function ' Loop through all existing waves and look for the specified wave For MyCounter = 1 To DM_Count If DM_Midi(MyCounter).Index = Index Then If MyCounter <= DM_Count Then FindArrayIndex = MyCounter Exit Function End If Next End Function