VERSION 1.0 CLASS BEGIN MultiUse = -1 'True END Attribute VB_Name = "cDirectMusic7" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = True Attribute VB_PredeclaredId = False Attribute VB_Exposed = False Option Explicit '============================================================================================================= ' ' cDirectMusic7 Class Module ' -------------------------- ' ' Created By : Kevin Wilson ' http://www.TheVBZone.com ( The VB Zone ) ' ' Last Update : May 07, 2001 ' ' VB Versions : 5.0 / 6.0 ' ' Requires : Windows 95/98/ME/2000 with Microsoft DirectX 7a (or better) installed [See Note For WinNT4] ' DX7VB.DLL (Microsoft DirectX 7a library for Visual Basic) ' ' Description : This class module gives you easy access to the DirectMusic components and functionality ' contained within DirectX 7a. 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. ' ' 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 7a 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 cDirectMusic7 ' Private DS As cDirectSound7 ' Private Sub Form_Load() ' Me.Show ' Set DS = New cDirectSound7 ' DS.Initialize Me.hWnd ' Set DM = New cDirectMusic7 ' 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 ' '============================================================================================================= ' Custom type that holds the information about each MIDI loaded Private Type MidiType Index As Integer Segmnt As DxVBLib.DirectMusicSegment SegmntState As DxVBLib.DirectMusicSegmentState 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 DxVBLib.DirectX7 Private DM_Perf As DxVBLib.DirectMusicPerformance Private DM_Loader As DxVBLib.DirectMusicLoader 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 DirectX7 object Set dX = New DxVBLib.DirectX7 ' 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 ' DirectSound 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 DxVBLib.DirectSound) As Boolean On Error GoTo ErrorTrap If p_StartUpOK = False Then Exit Function ' Initialize the Preference If rDirectSound Is Nothing Then DM_Perf.Init Nothing, CallingFormHandle Else DM_Perf.Init rDirectSound, 0 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 ' Sets the performance object to use the default port with 80 channel groups Call DM_Perf.SetPort(-1, 80) 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.Stop .Segmnt, .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.Stop DM_Midi(MyCounter).Segmnt, 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 DxVBLib.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_Perf.PlaySegment 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.Stop DM_Midi(DM_Count).Segmnt, Nothing, 0, 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 DxVBLib.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.PlaySegment 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.Stop DM_Midi(DM_Count).Segmnt, Nothing, 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.Stop .Segmnt, Nothing, 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.PlaySegment(.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.Stop .Segmnt, .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