VERSION 1.0 CLASS BEGIN MultiUse = -1 'True Persistable = 0 'NotPersistable DataBindingBehavior = 0 'vbNone DataSourceBehavior = 0 'vbNone MTSTransactionMode = 0 'NotAnMTSObject END Attribute VB_Name = "cDirectSound8" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = True Attribute VB_PredeclaredId = False Attribute VB_Exposed = False Option Explicit '============================================================================================================= ' ' cDirectSound8 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 DirectSound components and functionality ' contained within DirectX 8a. One of the biggest advantages of using DirectSound over just ' the Win32 API for playing sounds is DirectSound automatically mixes sounds when multiple ' sounds 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 sounds to do what ' DirectSound 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 8a SDK Samples & Documentation ' http://www.microsoft.com/directx/ ' http://www.microsoft.com/directx/homeuser/downloads/default.asp ' http://msdn.microsoft.com/downloads/default.asp?URL=/code/sample.asp?url=/msdn-files/027/001/494/msdncompositedoc.xml ' http://msdn.microsoft.com/downloads/default.asp?URL=/code/sample.asp?url=/msdn-files/027/001/493/msdncompositedoc.xml ' http://msdn.microsoft.com/downloads/default.asp?URL=/code/sample.asp?url=/msdn-files/027/001/551/msdncompositedoc.xml ' http://msdn.microsoft.com/downloads/default.asp?URL=/code/sample.asp?url=/msdn-files/027/001/593/msdncompositedoc.xml ' ' Example Use : ' ' Option Explicit ' Private cDS As cDirectSound8 ' Private Sub Form_Load() ' Dim MyCounter As Long ' Set cDS = New cDirectSound8 ' cDS.Initialize Me.hWnd ' If cDS.InitOK = True Then ' Me.AutoRedraw = True ' For MyCounter = 1 To cDS.DeviceCount ' Me.Print "Device #" & CStr(MyCounter) & " = " & cDS.DeviceName(MyCounter) & " (" & cDS.DeviceDescription(MyCounter) & ")" ' Next ' Me.Show ' If cDS.Wave_LoadFile("C:\TEST.WAV") = True And cDS.Wave_LoadFile("C:\TEST1.WAV") = True And cDS.Wave_LoadFile("C:\TEST2.WAV") = True Then ' cDS.Wave_Play 1 ' DoEvents ' cDS.Wave_Play 2 ' DoEvents ' cDS.Wave_Play 3 ' DoEvents ' End If ' While cDS.Position(1) > 0 ' DoEvents ' Wend ' End If ' cDS.Wave_ClearAll ' Set cDS = Nothing ' Unload Me ' End Sub ' ' Private Sub Form_Unload(Cancel As Integer) ' Set cDS = 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 WAVE loaded Private Type WaveType Index As Integer WaveInfo As DxVBLibA.DirectSoundSecondaryBuffer8 BufferDesc As DxVBLibA.DSBUFFERDESC FilePath As String ResName As String State As Byte LastPos As Long LoopPlay As Boolean End Type ' Wave Play States Private Enum WaveStates ws_None = 0 ws_Loaded = 1 ws_Playing = 2 ws_Paused = 3 ws_Stopped = 4 End Enum ' DirectX / DirectSound Variables Private dX As DxVBLibA.DirectX8 Private DS As DxVBLibA.DirectSound8 Private DSE As DxVBLibA.DirectSoundEnum8 Private DS_Wave() As WaveType Private DS_Count As Integer Private DS_IndexCount As Integer ' Property Variables Private p_StartUpOK As Boolean Private p_InitOK As Boolean 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX Private Sub Class_Initialize() On Local Error GoTo ErrorTrap ' Create a reference to the DirectX8 object Set dX = New DxVBLibA.DirectX8 ' Create a reference to the DirectSound sub-system object Set DS = dX.DirectSoundCreate("") ' Create a reference to the sound device enumeration object Set DSE = dX.GetDSEnum p_StartUpOK = True Exit Sub ErrorTrap: On Error Resume Next Set dX = Nothing Set DS = Nothing Set DSE = Nothing MsgBox "The following error occured while trying to initialize the DirectSound drivers:" & Chr(13) & Chr(13) & _ "Error Number = " & CStr(Err.Number) & Chr(13) & _ "Error Description = " & Err.Description & Chr(13) & Chr(13) & _ "NOTE - This could be due to the fact that there is no sound card installed, or the sound card drivers are not correctly installed, or the sound card is currently in use by another application.", _ vbOKOnly + vbExclamation, " DirectSound Initialize Error" Err.Clear End Sub Private Sub Class_Terminate() On Error Resume Next ' Clear all the information about the files used Wave_ClearAll ' Clear the DirectX / DirectSound variables Set dX = Nothing Set DS = Nothing Set DSE = Nothing End Sub 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX ' Returns how many multimedia sound devices are currently installed on the user's computer. Public Property Get DeviceCount() As Long On Error Resume Next If p_InitOK = False Or p_StartUpOK = False Then Exit Property DeviceCount = DSE.GetCount End Property ' Gets the description of the specified multimedia sound device Public Property Get DeviceDescription(ByVal DeviceIndex As Long) As String On Error Resume Next If p_InitOK = False Or p_StartUpOK = False Then Exit Property If DeviceIndex < 1 Or DeviceIndex > DSE.GetCount Then Exit Property DeviceDescription = DSE.GetDescription(DeviceIndex) End Property ' Gets the name of the specified multimedia sound device (most of the time, the default device (Index = 1) ' does not have a name, and has the description "Primary Sound Driver". Public Property Get DeviceName(ByVal DeviceIndex As Long) As String On Error Resume Next If p_InitOK = False Or p_StartUpOK = False Then Exit Property If DeviceIndex < 1 Or DeviceIndex > DSE.GetCount Then Exit Property DeviceName = DSE.GetName(DeviceIndex) End Property ' Returns the file path set when a wave file is loaded using the "Wave_Load*" method 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 = DS_Wave(TheIndex).FilePath End Property ' Gets or sets the frequency of the wave file Public Property Get Frequency(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 Frequency = DS_Wave(TheIndex).WaveInfo.GetFrequency End Property Public Property Let Frequency(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 DS_Wave(TheIndex).WaveInfo.SetFrequency NewValue End Property ' Gets whether this class module was properly initialized Public Property Get InitOK() As Boolean On Error Resume Next InitOK = p_InitOK End Property ' Gets or sets whether the wave is to loop when played or not 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 = DS_Wave(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 DS_Wave(TheIndex).LoopPlay = NewValue End Property ' This controls where the volume of the LEFT and RIGHT to give a feeling like the sound is ' coming from the left side or right side. The "Volume" property can be faded to give the ' feeling of coming closer from a distance when the volume is faded in and out... thus giving ' you 3D sound. Public Property Get Pan(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 Pan = DS_Wave(TheIndex).WaveInfo.GetPan End Property Public Property Let Pan(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 DS_Wave(TheIndex).WaveInfo.SetPan NewValue End Property ' Gets or sets the current play position Public Property Get Position(ByVal Index As Integer) As Long On Error Resume Next Dim TempC As DxVBLibA.DSCURSORS Dim TheIndex As Integer ' Make sure the index is valid TheIndex = FindArrayIndex(Index) If TheIndex = -1 Then Exit Property DS_Wave(TheIndex).WaveInfo.GetCurrentPosition TempC Position = TempC.lPlay End Property Public Property Let Position(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 DS_Wave(TheIndex).WaveInfo.SetCurrentPosition NewValue End Property ' Returns a reference to the DirectSound sub-system object of this class module. ' This is used in conjunction with the cDirectMusic8 class module Initialize method ' to link DirectSound to DirectMusic so they can work together Public Property Get rDirectSound() As DxVBLibA.DirectSound8 On Error Resume Next If p_InitOK = False Or p_StartUpOK = False Then Exit Property Set rDirectSound = DS End Property ' Returns the resource name set when a wave file is loaded using the "Wave_Load*" method 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 = DS_Wave(TheIndex).ResName End Property ' Returns the current wave status Public Property Get Status(ByVal Index As Integer) As String On Error Resume Next Dim TheStatus As Integer Dim TheIndex As Integer ' Make sure the index is valid TheIndex = FindArrayIndex(Index) If TheIndex = -1 Then Exit Property TheStatus = CInt(DS_Wave(TheIndex).WaveInfo.GetStatus) Select Case TheStatus Case DSBSTATUS_BUFFERLOST Status = "Buffer Lost" Case DSBSTATUS_LOOPING Status = "Looping" Case DSBSTATUS_PLAYING Status = "Playing" End Select End Property ' Gets or sets the volume of the wave file ' NOTE - DirectSound DOES NOT amplify the sound of the volume, but can decrease it '------------------------- ' db is on log scale: ' 3 2 1 0 ' 100db 10db 1db 0 ' 10000 1000 100 0 '------------------------- Public Property Get Volume(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 Volume = DS_Wave(TheIndex).WaveInfo.GetVolume End Property Public Property Let Volume(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 If NewValue < -4000 Then NewValue = -10000 DS_Wave(TheIndex).WaveInfo.SetVolume NewValue End Property 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX '============================================================================================================= ' ChangeDevice ' ' This method changes the multimedia sound device that is used to play the sounds with. ' ' Parameter: Use: ' -------------------------------------------------- ' DeviceIndex Specifies the device index (1 based) ' ' Return: ' ------- ' If successful, returns TRUE ' If failed, returns FALSE ' '============================================================================================================= Public Function ChangeDevice(ByVal DeviceIndex As Long) As Boolean On Error GoTo ErrorTrap Dim TempDS As DxVBLibA.DirectSound8 ' Make sure that DirectX / DirectSound has properly been initialized If p_InitOK = False Or p_StartUpOK = False Then Exit Function If DeviceIndex < 0 Or DeviceIndex > DSE.GetCount Then Exit Function ' Attempt to initialize the specified device Set TempDS = dX.DirectSoundCreate(DSE.GetGuid(DeviceIndex)) If TempDS Is Nothing Or Err.Number <> 0 Then Exit Function ' Delete the old DirectSound reference and replace it with the newly created one Set DS = Nothing Set DS = TempDS ChangeDevice = True Exit Function ErrorTrap: Err.Clear Set TempDS = Nothing End Function '============================================================================================================= ' Wave_Clear ' ' Clears the specified wave file and the resources it took up ' ' Parameter: Use: ' -------------------------------------------------- ' Index Specifies the index (1 based) of the sound to clear. This index is returned when ' a call is made to the "Wave_LoadFile" or "Wave_LoadRes" method. ' ' Return: ' ------- ' If successful, returns TRUE ' If failed, returns FALSE ' '============================================================================================================= Public Function Wave_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 position back to normal (avoids problems with internal caching) DS_Wave(TheIndex).WaveInfo.SetCurrentPosition 0 ' Delete the wave information for the specified wave With DS_Wave(TheIndex) Set .WaveInfo = Nothing .FilePath = "" .ResName = "" .Index = 0 .State = ws_None .LastPos = 0 .LoopPlay = False .BufferDesc.lBufferBytes = 0 .BufferDesc.lFlags = 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 <> DS_Count Then With DS_Wave(TheIndex) .BufferDesc = DS_Wave(DS_Count).BufferDesc .FilePath = DS_Wave(DS_Count).FilePath .Index = DS_Wave(DS_Count).Index .LastPos = DS_Wave(DS_Count).LastPos .ResName = DS_Wave(DS_Count).ResName .State = DS_Wave(DS_Count).State Set .WaveInfo = DS_Wave(DS_Count).WaveInfo End With End If DS_Count = DS_Count - 1 ReDim Preserve DS_Wave(DS_Count) As WaveType Wave_Clear = True End Function '============================================================================================================= ' Wave_ClearAll ' ' Clears all loaded wave files and the resources they took up ' ' Parameter: Use: ' -------------------------------------------------- ' None ' ' Return: ' ------- ' If successful, returns TRUE ' If failed, returns FALSE ' '============================================================================================================= Public Function Wave_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 DS_Count < 1 Then DS_Count = 0 DS_IndexCount = 0 Erase DS_Wave Exit Function End If ' Destroy the objects for each file For MyCounter = 1 To DS_Count DS_Wave(MyCounter).WaveInfo.STOP DS_Wave(MyCounter).WaveInfo.SetCurrentPosition 0 Set DS_Wave(MyCounter).WaveInfo = Nothing Next ' Destroy all info for the files DS_Count = 0 DS_IndexCount = 0 Erase DS_Wave Wave_ClearAll = True End Function '============================================================================================================= ' Initialize ' ' Initializes DirectSound correctly. ' ' By calling this method, DirectX makes sure that each application does not gain access to the device in the ' wrong way or at the wrong time. Therefore, calling this method is required before anything else can be called. ' ' The default cooperative level is set to DSSCL_PRIORITY for best sound quality: ' ŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻ ' Normal Cooperative Level = At the normal cooperative level, the application cannot set the format of the primary sound buffer, write to the primary buffer, or compact the on-board memory of the device. All applications at this cooperative level use a primary buffer format of 22 kHz, stereo sound, and 8-bit samples, so that the device can switch between applications as smoothly as possible. ' Priority Cooperative Level = When using a DirectSound device with the priority cooperative level, the application has first rights to hardware resources, such as hardware mixing, and can set the format of the primary sound buffer and compact the on-board memory of the device. ' Exclusive Cooperative Level = At the exclusive cooperative level, the application has all the privileges of the priority level. In addition, when the application is in the foreground, its buffers are the only ones that are audible. ' Write-primary Cooperative Level = NOT USED (Only used when writing - this class plays) ' ' Parameter: Use: ' -------------------------------------------------- ' CallingFormHandle Specifies the handle of the calling form/window ' PriorityLevel Optional. Specifies the cooperative level of the device ' ' Return: ' ------- ' If successful, returns TRUE ' If failed, returns FALSE ' '============================================================================================================= Public Function Initialize(ByVal CallingFormHandle As Long, _ Optional PriorityLevel As DxVBLibA.CONST_DSSCLFLAGS = DSSCL_PRIORITY) As Boolean On Error Resume Next If p_StartUpOK = False Then Exit Function If CallingFormHandle = 0 Then Exit Function DS.SetCooperativeLevel CallingFormHandle, PriorityLevel p_InitOK = True End Function '============================================================================================================= ' Wave_LoadFile ' ' Loads the specified wave given it's file location ' ' Parameter: Use: ' -------------------------------------------------- ' FilePath Specifies the location of the file to load ' Return_Index Optional. Returns the index of the newly loaded file. This number is used by other ' methods and properties to access or change this file or it's behavior. ' ' Return: ' ------- ' If successful, returns TRUE ' If failed, returns FALSE ' '============================================================================================================= Public Function Wave_LoadFile(ByVal FilePath As String, _ Optional ByRef Return_Index As Integer) As Boolean On Error GoTo ErrorTrap Dim DeleteNew As Boolean ' Set the default return values Wave_LoadFile = False Return_Index = -1 If p_InitOK = False Or p_StartUpOK = False Then Exit Function ' Make sure parameters are valid FilePath = Trim(FilePath) If CheckFileExists(FilePath) = False Then Exit Function ' Load a new sound DeleteNew = True DS_IndexCount = DS_IndexCount + 1 DS_Count = DS_Count + 1 ReDim Preserve DS_Wave(DS_Count) As WaveType DS_Wave(DS_Count).Index = DS_IndexCount DS_Wave(DS_Count).State = ws_None DS_Wave(DS_Count).ResName = "" DS_Wave(DS_Count).FilePath = FilePath ' Set the buffer description DS_Wave(DS_Count).BufferDesc.lFlags = DSBCAPS_STATIC Or DSBCAPS_CTRLVOLUME Or DSBCAPS_CTRLFREQUENCY Or DSBCAPS_CTRLPAN ' Load a file into the buffer With DS_Wave(DS_Count) Set .WaveInfo = DS.CreateSoundBufferFromFile(FilePath, .BufferDesc) End With ' Function successfull Return_Index = DS_IndexCount DS_Wave(DS_Count).State = ws_Loaded Wave_LoadFile = True Exit Function ErrorTrap: Err.Clear If DeleteNew = True Then Set DS_Wave(DS_Count).WaveInfo = Nothing DS_IndexCount = DS_IndexCount - 1 DS_Count = DS_Count - 1 ReDim Preserve DS_Wave(DS_Count) As WaveType End If End Function '============================================================================================================= ' Wave_LoadRes ' ' Loads the specified wave from the project's resource, or a specified DLL resource ' ' Parameter: Use: ' -------------------------------------------------- ' ResourceName Specifies the name of the resource to get the wave file from. ' FilePath Specifies the location of the DLL, EXE, or other file to extract the wave from. ' Return_Index Optional. Returns the index of the newly loaded file. This number is used by other ' methods and properties to access or change this file or it's behavior. ' ' Return: ' ------- ' If successful, returns TRUE ' If failed, returns FALSE ' '============================================================================================================= Public Function Wave_LoadRes(ByVal ResourceName As String, _ ByVal FilePath As String, _ Optional ByRef Return_Index As Integer) As Boolean On Error GoTo ErrorTrap Dim DeleteNew As Boolean ' Set the default return values Wave_LoadRes = False Return_Index = -1 If p_InitOK = False Or p_StartUpOK = False Then Exit Function ' Make sure parameters are valid FilePath = Trim(FilePath) If FilePath <> "" Then If CheckFileExists(FilePath) = False Then Exit Function ' Load a new sound DeleteNew = True DS_IndexCount = DS_IndexCount + 1 DS_Count = DS_Count + 1 ReDim Preserve DS_Wave(DS_Count) As WaveType DS_Wave(DS_Count).Index = DS_IndexCount DS_Wave(DS_Count).State = ws_None DS_Wave(DS_Count).ResName = ResourceName DS_Wave(DS_Count).FilePath = FilePath ' Set the buffer description DS_Wave(DS_Count).BufferDesc.lFlags = DSBCAPS_STATIC Or DSBCAPS_CTRLVOLUME Or DSBCAPS_CTRLFREQUENCY Or DSBCAPS_CTRLPAN ' Load a file into the buffer With DS_Wave(DS_Count) Set .WaveInfo = DS.CreateSoundBufferFromResource(FilePath, ResourceName, .BufferDesc) End With ' Function successfull Return_Index = DS_IndexCount DS_Wave(DS_Count).State = ws_Loaded Wave_LoadRes = True Exit Function ErrorTrap: Err.Clear If DeleteNew = True Then Set DS_Wave(DS_Count).WaveInfo = Nothing DS_IndexCount = DS_IndexCount - 1 DS_Count = DS_Count - 1 ReDim Preserve DS_Wave(DS_Count) As WaveType End If End Function '============================================================================================================= ' Wave_Pause ' ' Pauses the play back of the specifies wave file ' ' Parameter: Use: ' -------------------------------------------------- ' Index Specifies the index (1 based) of the sound to clear. This index is returned when ' a call is made to the "Wave_LoadFile" or "Wave_LoadRes" method. ' ' Return: ' ------- ' If successful, returns TRUE ' If failed, returns FALSE ' '============================================================================================================= Public Function Wave_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 DS_Wave(TheIndex).WaveInfo.STOP DS_Wave(TheIndex).State = ws_Paused Wave_Pause = True End Function '============================================================================================================= ' Wave_Play ' ' Plays the specifies wave file. You can play multiple wave files simotaniously this way. ' ' Parameter: Use: ' -------------------------------------------------- ' Index Specifies the index (1 based) of the sound to clear. This index is returned when ' a call is made to the "Wave_LoadFile" or "Wave_LoadRes" method. ' ' Return: ' ------- ' If successful, returns TRUE ' If failed, returns FALSE ' '============================================================================================================= Public Function Wave_Play(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 If DS_Wave(TheIndex).State <> ws_Paused Then DS_Wave(TheIndex).WaveInfo.SetCurrentPosition 0 If DS_Wave(TheIndex).LoopPlay = True Then DS_Wave(TheIndex).WaveInfo.play DSBPLAY_LOOPING Else DS_Wave(TheIndex).WaveInfo.play DSBPLAY_DEFAULT End If DS_Wave(TheIndex).State = ws_Playing Wave_Play = True End Function '============================================================================================================= ' Wave_Stop ' ' Stops the play back of the specifies wave file. ' ' Parameter: Use: ' -------------------------------------------------- ' Index Specifies the index (1 based) of the sound to clear. This index is returned when ' a call is made to the "Wave_LoadFile" or "Wave_LoadRes" method. ' ' Return: ' ------- ' If successful, returns TRUE ' If failed, returns FALSE ' '============================================================================================================= Public Function Wave_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 DS_Wave(TheIndex).WaveInfo.STOP DS_Wave(TheIndex).State = ws_Stopped Wave_Stop = True End Function '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 DS_Count < 1 Then Exit Function If Index < 1 Or Index > DS_IndexCount Then Exit Function ' Loop through all existing waves and look for the specified wave For MyCounter = 1 To DS_Count If DS_Wave(MyCounter).Index = Index Then If MyCounter <= DS_Count Then FindArrayIndex = MyCounter Exit Function End If Next End Function