[Aporte] Engine de sonido de IAO + Pasos

Lorwik

Destructor Lvl 3
Ex-Staff
#1
¡Buenas a todos! Hace tiempo que no aporto nada en AO y mucho más que no aporto un código, así que hoy os traigo algo que seguro que a mucho les va a gustar.
Como sabrán el engine de sonido de AO es una patata, el 3D es feo y cutre, el midi se bugea, el sistema de sonidos ambientales simple, etc... Y muchos quieren el engine de sonido que tiene IAO que como sabrán puede reproducir fácilmente MP3 y Midi, sonidos ambientales, un sonido 3D que nos permite calcular la distancia en la que se encuentra, etc...
Podríamos arreglar el de AO para que hiciera todas estas mierdas, pero es mas fácil sacarlo de IAO y decir "tengo el engine de sonido de IAO" y suena mas pro xD.

Así que bien, esta es la 2ª vez que lo saco (la primera fue para AODrag), y aun que no es difícil es un poco lió, así que empezamos por la parte donde extraemos el viejo.


IMPORTANTE:

- Voy a enseñar como eliminar el antiguo engine de sonido e implementar el nuevo, aun asi vais a necesitar un minimo de conocimientos en programación para afrontar los fallos y bugs. Yo parto desde un 0.13.3 que estoy optimizando, asi que en gran parte el codigo es casi igual al origianl excepto en ciertas cosas.

- En mi cliente tengo el sistema de lluvia eliminado, por tanto voy a omitir esta parte a la hora de eliminarlo del antiguo engine e implementarlo en el nuevo, pero aun así no es difícil.

- Recomiendo hacer un backup del código.

ELIMINANDO EL ANTIGUO ENGINE

Lo primero que vamos a eliminar es el clsAudio (es el modulo de sonido original)

Buscas y lo eliminas:

Código:
Public Audio As clsAudio
Donde aparezca este código, lo eliminas.

Código:
    Call Audio.MoveListener(UserPos.X, UserPos.Y)
En el Sub Main o en LoadInitialConfig (si estais usando 0.13.3) tiene que estar este codigo:

Código:
    'Inicializamos el sonido

    Call Audio.Initialize(DirectX, frmMain.hwnd, DirSound, DirMidi)
    'Enable / Disable audio
    Audio.MusicActivated = False
    Audio.SoundActivated = False
    Audio.SoundEffectsActivated = False config
Quizás no lo tengáis así exactamente por que yo lo edite, pero es así. El caso es que... lo elimináis.
Donde diga:

Código:
Call Audio.MusicMP3Play
Lo comentas, para así saber que ahí iniciaba un MP3 y luego reemplazarlo.
Lo mismo con:

Código:
    Call Audio.StopWave
Y lo mismo con:

Código:
Call Audio.PlayMIDI(
Buscais el "DoFogataFX" y el DoPasosFX y lo eliminas completamente.

Buscais:

Código:
Audio.MusicActivated = Not Audio.MusicActivated
Código:
Audio.SoundActivated = Not Audio.SoundActivated
Código:
Audio.SoundEffectsActivated = Not Audio.SoundEffectsActivated
Y lo comentáis, ya que eso lo reemplazaremos mas adelante.
Si tienes 0.13.3 tendrías que tener (no se si también en otras versiones):

Código:
Set Audio = New clsAudio
Lo eliminas.
Buscas y borras:

Código:
Set Audio = Nothing
Busca y comenta:

Código:
If UserEstado = 0 Then Call DoPasosFx(CharIndex)
Busca "RenderSounds" y lo eliminas completamente, y lo mismo con el "Call RenderSounds"

Buscas:

Código:
Public IsPlaying As Byte
Y lo eliminas

Buscas:

Código:
Call DoPasosFx(CharIndex)
Y lo comentas

Si tenéis 0.12, 0.13, buscáis el HandlePlayMIDI (en otras versiones no se como sera), pero comentáis la parte donde llama al engine de sonido.
Ya solo queda ir al form de opciones y eliminar todo lo relacionado con el sonido (controles incluidos)

Llegados a este punto intenta compilar, si compila bien solo te quedara guardar y listo (prueba el juego si quieres).


IMPLEMENTANDO EL NUEVO ENGINE

Empezaremos, lo voy a dejar adaptado al AO original para que no tire errores extraños.

Primero crearemos 2 nuevos modulos clase al que llamaremos "clsSoundEngine" y "clsBufferMan"

clsSoundEngine:

Código:
'*****************************************************************
'clsSoundEngine - ImperiumAO - v1.4.5 R5
'
'Sound frmMain.Engine.
'
'*****************************************************************
'Respective portions copyrighted by contributors listed below.
'
'This library is free software; you can redistribute it and/or
'modify it under the terms of the GNU Lesser General Public
'License as published by the Free Software Foundation version 2.1 of
'the License
'
'This library is distributed in the hope that it will be useful,
'but WITHOUT ANY WARRANTY; without even the implied warranty of
'MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
'Lesser General Public License for more details.
'
'You should have received a copy of the GNU Lesser General Public
'License along with this library; if not, write to the Free Software
'Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
'*****************************************************************

'*****************************************************************
'Augusto José Rando ([email protected])
'   - First Relase
'*****************************************************************

Option Explicit

Private Const MapExt As Byte = 0

Private dX As DirectX8

'**** Direct Sound ********
Private DS As DirectSound8
Private DS_Enum As DirectSoundEnum8

'**** Direct Music ********
Private dmLoader As DirectMusicLoader8
Private dmPerf As DirectMusicPerformance8
Private dmSeg As DirectMusicSegment8
Private dmSegState As DirectMusicSegmentState8
Private dmPath As DirectMusicAudioPath8

'**** MP3 ********
Dim IMC   As IMediaControl
Dim IBA   As IBasicAudio
Dim IME   As IMediaEvent
Dim IMPos As IMediaPosition

'**** AMBIENT ********
Dim ambient_buffer As DirectSoundSecondaryBuffer8
Dim ambient_rain_buffer As DirectSoundSecondaryBuffer8
Dim ambient_rain_int_buffer As DirectSoundSecondaryBuffer8
Dim ambient_fire_buffer As DirectSoundSecondaryBuffer8

Private mAmbienteActual As Integer
Private mMusActual As String
Private WavPath As String
Private MidiPath As String
Private MP3Path As String

'¿Está el engine iniciado?
Private Engine_Initialized As Boolean

'Manejador de buffers
Private Buffers As clsBufferMan
Private Buffers_Sec As clsBufferMan
Private Buffers_Ter As clsBufferMan

'El volúmen actual real (sonidos)
Private mEffectsVolume As Long

'El volúmen actual real (ambientes)
Private mEffectsVolumeAmbient As Long

'El volúmen actual real (música)
Private mMusicVolume As Long

'El volúmen máximo en la configuración (sonidos)
Private mEffectsVolumeMax As Long

'El volúmen máximo en la configuración (ambientes)
Private mAmbientVolumeMax As Long

'El volúmen máximo en la configuración (música)
Private mMusicVolumeMax As Long

'¿Estamos haciendo efecto fade?
Private mFadingStatus As Byte
Private mFadingMusicMod As Long

'¿Próximo MP3 o MIDI?
Private mNextMusic As String
Private mLastMusic As String

'Playing flags
Private play_fire As Boolean

'Midi de mapa
Private mLastMapMusic As Integer

Private INTERIOR_VOLUME As Long
Private EXTERIOR_VOLUME As Long

Private TimeElapsed As Long
Private mInvert_Sound As Boolean

Private Const VOLUME_DISTANCE_MOD As Long = 24
Private Const PAN_MOD As Long = 600

Private lastMid As Boolean

Private Property Let SetWavPath(ByVal inString As String)
'**************************************************************
'Author: Augusto José Rando ([email protected])
'Last Modify Date: 2/08/2006
'**************************************************************

WavPath = inString

End Property

Private Property Let SetMP3Path(ByVal inString As String)
'**************************************************************
'Author: Augusto José Rando ([email protected])
'Last Modify Date: 2/08/2006
'**************************************************************

MP3Path = inString
End Property

Private Property Let SetMidiPath(ByVal inString As String)
'**************************************************************
'Author: Augusto José Rando ([email protected])
'Last Modify Date: 2/08/2006
'**************************************************************

MidiPath = inString
End Property

Public Property Get Engine_Running() As Boolean
'**************************************************************
'Author: Augusto José Rando ([email protected])
'Last Modify Date: 2/08/2006
'**************************************************************

Engine_Running = Engine_Initialized

End Property

Public Function Engine_DeInitialize()
'**************************************************************
'Author: Augusto José Rando ([email protected])
'Last Modify Date: 2/08/2006
'**************************************************************

'Destroy all buffers
If Not Buffers Is Nothing Then
    Call Buffers.BorrarTodo
    Set Buffers = Nothing
End If

If Not Buffers_Sec Is Nothing Then
    Call Buffers_Sec.BorrarTodo
    Set Buffers_Sec = Nothing
End If

If Not Buffers_Ter Is Nothing Then
    Call Buffers_Ter.BorrarTodo
    Set Buffers_Ter = Nothing
End If

Call Music_Empty

Set dmSegState = Nothing

If Not dmPath Is Nothing Then
    Call dmPath.Activate(False)
    Set dmPath = Nothing
End If

If Not dmPerf Is Nothing Then
    dmPerf.CloseDown
    Set dmPerf = Nothing
End If

Set dmLoader = Nothing
Set dmSeg = Nothing

Set DS_Enum = Nothing
Set DS = Nothing
Set dX = Nothing

End Function

Public Function Initialize_Engine(ByVal main_hwnd As String, ByVal Set_Wav_Path As String, ByVal Set_MP3_Path As String, ByVal Set_Midi_Path As String, Optional ByVal Play_only_on_focus As Boolean = True, Optional ByVal Initialize_Sounds As Boolean = True, Optional ByVal Initialize_Music As Boolean = True, Optional ByVal sound_volume As Long, Optional ByVal music_volume As Long, Optional ByVal invert_snd As Boolean) As Boolean
'**************************************************************
'Author: Augusto José Rando ([email protected])
'Last Modify Date: 2/08/2006
'**************************************************************

On Error GoTo ErrHandler

Dim dmA As DMUS_AUDIOPARAMS

If Initialize_Sounds Or Initialize_Music Then
    Set dX = New DirectX8

    If Initialize_Sounds Then
        SetWavPath = Set_Wav_Path
        Set DS_Enum = dX.GetDSEnum
        Set DS = dX.DirectSoundCreate(DS_Enum.GetGuid(1))
  
        Set Buffers = New clsBufferMan
        Set Buffers_Sec = New clsBufferMan
        Set Buffers_Ter = New clsBufferMan
  
        Buffers.Path = Set_Wav_Path
        Buffers_Sec.Path = Set_Wav_Path
        Buffers_Ter.Path = Set_Wav_Path
  
        Call Buffers.Init(DS, 400)
        Call Buffers_Sec.Init(DS, 200)
        Call Buffers_Ter.Init(DS, 100)
  
        If Play_only_on_focus Then
            DS.SetCooperativeLevel main_hwnd, DSSCL_NORMAL
        Else
            DS.SetCooperativeLevel main_hwnd, DSSCL_PRIORITY
        End If

        VolumenActual = sound_volume
        mInvert_Sound = invert_snd
  
    End If

    Sound.VolumenActualAmbient_set Opciones.AmbientVol

    If Initialize_Music Then
        SetMidiPath = Set_Midi_Path
        SetMP3Path = Set_MP3_Path
        VolumenActualMusicMax = music_volume
        Set dmLoader = dX.DirectMusicLoaderCreate
        Set dmPerf = dX.DirectMusicPerformanceCreate
        dmPerf.InitAudio main_hwnd, DMUS_AUDIOF_ENVIRON + DMUS_AUDIOF_BUFFERS + DMUS_AUDIOF_3D + DMUS_AUDIOF_EAX + DMUS_AUDIOF_DMOS, dmA
        dmPerf.SetMasterVolume (music_volume)
        Set dmPath = dmPerf.CreateStandardAudioPath(DMUS_APATH_DYNAMIC_3D, 64, True)
    End If

    Engine_Initialized = True
    Initialize_Engine = True
Else
    Engine_Initialized = False
    Initialize_Engine = True
End If

Call Ambient_General_Load(mEffectsVolumeAmbient)

Exit Function

ErrHandler:
    If Len(Trim$(Err.Description)) Then
        Engine_Initialized = False
        Initialize_Engine = False
    End If

End Function

Public Property Get AmbienteActual() As Integer
'**************************************************************
'Author: Augusto José Rando ([email protected]m.ar)
'Last Modify Date: 2/08/2006
'**************************************************************

AmbienteActual = mAmbienteActual
End Property

Public Property Get MusicActual() As String
'**************************************************************
'Author: Augusto José Rando ([email protected])
'Last Modify Date: 2/08/2006
'**************************************************************

MusicActual = mMusActual
End Property

Public Property Let MusicActual(ByVal vNewValue As String)
'**************************************************************
'Author: Augusto José Rando ([email protected])
'Last Modify Date: 2/08/2006
'**************************************************************

mMusActual = vNewValue
End Property

Public Property Let Fading(ByVal vNewValue As Long)
'**************************************************************
'Author: Augusto José Rando ([email protected])
'Last Modify Date: 2/08/2006
'**************************************************************

mFadingMusicMod = vNewValue
TimeElapsed = GetTickCount
End Property

Public Property Get Fading() As Long
'**************************************************************
'Author: Augusto José Rando ([email protected])
'Last Modify Date: 2/08/2006
'**************************************************************

Fading = mFadingMusicMod
End Property

Public Property Get VolumenActual() As Long
'**************************************************************
'Author: Augusto José Rando ([email protected])
'Last Modify Date: 2/08/2006
'**************************************************************

VolumenActual = mEffectsVolumeMax
End Property

Public Property Get VolumenActualAmbient() As Long
'**************************************************************
'Author: Augusto José Rando ([email protected])
'Last Modify Date: 2/08/2006
'**************************************************************

VolumenActualAmbient = mEffectsVolumeAmbient
End Property

Public Sub VolumenActualAmbient_set(ByVal vNewValue As Long)
    mEffectsVolumeAmbient = vNewValue
End Sub

Public Property Let VolumenActual(ByVal vNewValue As Long)
'**************************************************************
'Author: Augusto José Rando ([email protected])
'Last Modify Date: 2/08/2006
'**************************************************************

Dim sglVolume As Single

If vNewValue > 0 Then vNewValue = 0
If vNewValue < -4000 Then vNewValue = -4000

mEffectsVolumeMax = vNewValue
Buffers.ModificarVolumenTodo (vNewValue)
Buffers_Sec.ModificarVolumenTodo (vNewValue)
Buffers_Ter.ModificarVolumenTodo (vNewValue)

sglVolume = ((vNewValue - 1) * 100) / -4000

End Property


Public Property Get InvertirSonido() As Boolean
'**************************************************************
'Author: Augusto José Rando ([email protected])
'Last Modify Date: 2/08/2006
'**************************************************************

InvertirSonido = mInvert_Sound
End Property

Public Property Let InvertirSonido(ByVal vNewValue As Boolean)
'**************************************************************
'Author: Augusto José Rando ([email protected])
'Last Modify Date: 2/08/2006
'**************************************************************

mInvert_Sound = vNewValue
End Property

Public Property Let VolumenActualMusicMax(ByVal vNewValue As Long)
'**************************************************************
'Author: Augusto José Rando ([email protected])
'Last Modify Date: 2/08/2006
'**************************************************************

If vNewValue > 0 Then vNewValue = 0
If vNewValue < -4000 Then vNewValue = -4000

mMusicVolumeMax = vNewValue

End Property

Public Property Get VolumenActualMusicMax() As Long
'**************************************************************
'Author: Augusto José Rando ([email protected])
'Last Modify Date: 2/08/2006
'**************************************************************

VolumenActualMusicMax = mMusicVolumeMax
End Property

Public Property Get VolumenActualMusic() As Long
'**************************************************************
'Author: Augusto José Rando ([email protected])
'Last Modify Date: 2/08/2006
'**************************************************************

VolumenActualMusic = mMusicVolume
End Property

Public Property Get LastMapMusic() As Integer
'**************************************************************
'Author: Augusto José Rando ([email protected])
'Last Modify Date: 2/08/2006
'**************************************************************

LastMapMusic = mLastMapMusic
End Property

Public Property Let LastMapMusic(ByVal vNewValue As Integer)
'**************************************************************
'Author: Augusto José Rando ([email protected])
'Last Modify Date: 2/08/2006
'**************************************************************

mLastMapMusic = vNewValue
End Property

Public Property Let VolumenActualMusic(ByVal vNewValue As Long)
'**************************************************************
'Author: Augusto José Rando ([email protected])
'Last Modify Date: 2/08/2006
'**************************************************************

mMusicVolume = vNewValue
End Property

Public Property Let NextMusic(ByVal vNewValue As String)
'**************************************************************
'Author: Augusto José Rando ([email protected])
'Last Modify Date: 2/08/2006
'**************************************************************

If mFadingStatus <> 2 And LenB(vNewValue) > 0 Then 'Si no estamos en fade up ya...
    mNextMusic = vNewValue
Else
    mNextMusic = vNewValue
    mFadingStatus = 0
End If

End Property

Public Function Sound_Stop_All() As Boolean
'**************************************************************
'Author: Augusto José Rando ([email protected])
'Last Modify Date: 2/08/2006
'**************************************************************

On Error GoTo Error_Handl

Buffers.DetenerTodo
Buffers_Sec.DetenerTodo
Buffers_Ter.DetenerTodo

'Ambient_Stop

Sound_Stop_All = True

Exit Function

Error_Handl:
    Sound_Stop_All = False

End Function

Public Function Sound_Play(ByVal Sound_File As Integer, Optional ByVal Do_Loop As Boolean = False, Optional ByVal Volume As Long = 0, Optional ByVal pan As Long = 0) As Boolean
'**************************************************************
'Author: Augusto José Rando ([email protected])
'Last Modify Date: 2/08/2006
'**************************************************************

On Error GoTo Error_Handl

    If (Sound_File <= 0) Or (Opciones.Audio = 0) Or (Engine_Initialized = False) Then Exit Function

    If Volume = 0 Then Volume = mEffectsVolumeMax

    If Not Buffers.Reproducir(Sound_File, IIf(Do_Loop, DSBPLAY_LOOPING, DSBPLAY_DEFAULT), Volume, pan) Then _
        If Not Buffers_Sec.Reproducir(Sound_File, IIf(Do_Loop, DSBPLAY_LOOPING, DSBPLAY_DEFAULT), Volume, pan) Then _
            Call Buffers_Ter.Reproducir(Sound_File, IIf(Do_Loop, DSBPLAY_LOOPING, DSBPLAY_DEFAULT), Volume, pan)

    Sound_Play = True

    Exit Function

Error_Handl:
    Sound_Play = False
End Function

Public Function Sound_Stop(ByVal Sound_File As Integer) As Boolean
'**************************************************************
'Author: Augusto José Rando ([email protected])
'Last Modify Date: 2/08/2006
'**************************************************************

On Error GoTo Error_Handl

    If (Sound_File <= 0) Or (Opciones.Audio = 0) Or (Engine_Initialized = False) Then Exit Function

    Call Buffers.Detener(Sound_File)
    Call Buffers_Sec.Detener(Sound_File)
    Call Buffers_Ter.Detener(Sound_File)

    Sound_Stop = True

    Exit Function

Error_Handl:
    Sound_Stop = False

End Function

Public Function Music_Empty() As Boolean
'**************************************************************
'Author: Augusto José Rando ([email protected])
'Last Modify Date: 2/08/2006
'**************************************************************

    On Error GoTo Error_Handl

    Dim ret As Long

    If (Opciones.sMusica = CONST_DESHABILITADA) Or (Engine_Initialized = False) Then Exit Function

    If lastMid = False Then
        If ObjPtr(IMC) > 0 Then
            IMC.Stop
        End If
  
        Set IBA = Nothing
        Set IME = Nothing
        Set IMPos = Nothing
        Set IMC = Nothing
    Else
        If Not dmSeg Is Nothing Then
            dmPerf.StopEx dmSeg, 0, 0
            Set dmSeg = Nothing
        End If
    End If

    Music_Empty = True
    Exit Function

Error_Handl:
    Music_Empty = False
End Function

Public Function Music_Load(ByVal file_str As String, Optional ByVal Volume As Long = 0, Optional ByVal balance As Long = 0) As Boolean '**** Loads a MP3 *****
'**************************************************************
'Author: Augusto José Rando ([email protected])
'Last Modify Date: 2/08/2006
'**************************************************************

    On Error GoTo Error_Handl

    Dim ret As Long

    If (LenB(file_str) <= 0) Or (Opciones.sMusica = CONST_DESHABILITADA) Or (Engine_Initialized = False) Then Exit Function

    If Opciones.sMusica = CONST_MP3 Then
        If Extract_File(MP3, MP3Path, file_str & ".mp3", Windows_Temp_Dir, False) Then
            If Not Music_Empty() = True Then GoTo Error_Handl
            Set IMC = New FilgraphManager
            IMC.RenderFile Windows_Temp_Dir & file_str & ".mp3"
            Kill Windows_Temp_Dir & file_str & ".mp3"
            lastMid = False
        ElseIf Extract_File(Midi, MidiPath, file_str & ".mid", Windows_Temp_Dir, False) Then
            If Not Music_Empty() = True Then GoTo Error_Handl
            Set dmSeg = dmLoader.LoadSegment(Windows_Temp_Dir & file_str & ".mid")
            dmSeg.SetStandardMidiFile
            dmSeg.Download dmPath
            lastMid = True
        Else
            GoTo Error_Handl
        End If
    ElseIf Opciones.sMusica = CONST_MIDI Then
        If Extract_File(Midi, MidiPath, file_str & ".mid", Windows_Temp_Dir, False) Then
            If Not Music_Empty() = True Then GoTo Error_Handl
            Set dmSeg = dmLoader.LoadSegment(Windows_Temp_Dir & file_str & ".mid")
            dmSeg.SetStandardMidiFile
            dmSeg.Download dmPath
            lastMid = True
        End If
    Else
        GoTo Error_Handl
    End If

    If Volume < -4000 Then Volume = -4000
    If balance > 5000 Then balance = 5000
    If balance < -5000 Then balance = -5000

    If lastMid = False Then
        Set IBA = IMC
        IBA.Volume = Volume
        IBA.balance = balance
  
        Set IME = IMC
  
        Set IMPos = IMC
        If ObjPtr(IMPos) Then IMPos.Rate = 1#
        IMPos.CurrentPosition = 0
    Else
        Call dmSeg.SetRepeats(-1)
    End If

    mMusActual = file_str
    Music_Load = True
    Exit Function

Error_Handl:
    Music_Load = False
End Function
Public Function Music_Play() As Boolean
'**************************************************************
'Author: Augusto José Rando ([email protected])
'Last Modify Date: 2/08/2006
'**************************************************************

    On Error GoTo Error_Handl

    Dim ret As Long

    If (Opciones.sMusica = CONST_DESHABILITADA) Or (Engine_Initialized = False) Then Exit Function

    If lastMid = False Then
        IMC.Run
    Else
        Set dmSegState = dmPerf.PlaySegmentEx(dmSeg, 0, 0, Nothing, dmPath)
    End If

    Music_Play = True
    Exit Function

Error_Handl:
    Music_Play = False
End Function

Public Function Music_GetLoop() As Boolean
'**************************************************************
'Author: Augusto José Rando ([email protected])
'Last Modify Date: 2/08/2006
'**************************************************************

    On Error GoTo Error_Handl

    If (Opciones.sMusica = CONST_DESHABILITADA) Or (Engine_Initialized = False) Then Exit Function

    If lastMid = False Then
        If IMPos Is Nothing Then Exit Function
        If IMPos.StopTime = IMPos.CurrentPosition Then
            Music_Stop
            Music_Play
            Music_GetLoop = True
        End If
    End If

    Exit Function

Error_Handl:
    Music_GetLoop = False
End Function

Public Function Music_Stop() As Boolean
'**************************************************************
'Author: Augusto José Rando ([email protected])
'Last Modify Date: 2/08/2006
'**************************************************************

    On Error GoTo Error_Handl

    Dim ret As Long

    If (Opciones.sMusica = CONST_DESHABILITADA) Or (Engine_Initialized = False) Then Exit Function

    If lastMid = False Then
        IMC.Stop
        IMPos.CurrentPosition = 0
    Else
        dmPerf.StopEx dmSeg, 0, 0
    End If
  
    Music_Stop = True
    Exit Function

Error_Handl:
    Music_Stop = False
End Function

Public Function Music_Pause() As Boolean
'**************************************************************
'Author: Augusto José Rando ([email protected])
'Last Modify Date: 2/08/2006
'**************************************************************

    On Error GoTo Error_Handl

    If (Opciones.sMusica = CONST_DESHABILITADA) Or (Engine_Initialized = False) Then Exit Function

    IMC.Pause

    Music_Pause = True
    Exit Function

Error_Handl:
    Music_Pause = False
End Function

Public Function Music_Volume_Set(ByVal sound_volume As Long) As Boolean
'**************************************************************
'Author: Augusto José Rando ([email protected])
'Last Modify Date: 2/08/2006
'**************************************************************

    On Error GoTo Error_Handl

    If (Opciones.sMusica = CONST_DESHABILITADA) Or (Engine_Initialized = False) Then Exit Function
    If IBA Is Nothing Then Exit Function

    If sound_volume > 0 Then sound_volume = 0
    If sound_volume < -4000 Then sound_volume = -4000

    If lastMid = False Then
        IBA.Volume = sound_volume
    Else
        dmPerf.SetMasterVolume (sound_volume)
    End If

    Music_Volume_Set = True
    Exit Function

Error_Handl:
    Music_Volume_Set = False

End Function

Public Function Ambient_Load(ByVal file_name As Integer, Optional ByVal Volume As Long = 0)
'**************************************************************
'Author: Augusto José Rando ([email protected])
'Last Modify Date: 2/08/2006
'**************************************************************

    On Error GoTo Error_Handl

    If (file_name <= 0) Or (Opciones.Ambient = 0) Or (Engine_Initialized = False) Then Exit Function

    Call Buffers.GetBuffer(file_name, ambient_buffer, Ambient)

    If Volume < -4000 Then Volume = -4000
    ambient_buffer.SetVolume Volume

    Ambient_Load = True
    Exit Function

Error_Handl:
    Ambient_Load = False

End Function

Public Function Ambient_General_Load(ByVal Volume As Long)
'**************************************************************
'Author: Augusto José Rando ([email protected])
'Last Modify Date: 2/08/2006
'**************************************************************

    On Error GoTo Error_Handl

    If (Opciones.Ambient = 0) Or (Engine_Initialized = False) Then Exit Function

    'Lorwik> No hay lluvia de momento.
    'Call Buffers.GetBuffer(SND_LLUVIAIN, ambient_rain_int_buffer)
    'Call Buffers.GetBuffer(SND_LLUVIAOUT, ambient_rain_buffer)
    Call Buffers.GetBuffer(SND_FUEGO, ambient_fire_buffer, Ambient)

    If Volume < -4000 Then Volume = -4000
    'ambient_rain_buffer.SetVolume Volume
    'ambient_rain_int_buffer.SetVolume Volume

    Ambient_General_Load = True
    Exit Function

Error_Handl:
    Ambient_General_Load = False

End Function

Public Function Ambient_Play() As Boolean
'**************************************************************
'Author: Augusto José Rando ([email protected])
'Last Modify Date: 2/08/2006
'**************************************************************

    On Error GoTo Error_Handl

    If (Opciones.Ambient = 0) Or (Engine_Initialized = False) Then Exit Function
    ambient_buffer.Play DSBPLAY_LOOPING

    Ambient_Play = True
    Exit Function

Error_Handl:
    Ambient_Play = False
End Function

Public Function Ambient_Rain_Play() As Boolean
'**************************************************************
'Author: Augusto José Rando ([email protected])
'Last Modify Date: 2/08/2006
'**************************************************************

    On Error GoTo Error_Handl

    If (Opciones.Ambient = 0) Or (Engine_Initialized = False) Then Exit Function
    ambient_rain_buffer.SetVolume mEffectsVolumeAmbient
    ambient_rain_buffer.Play DSBPLAY_LOOPING

    Ambient_Rain_Play = True
    Exit Function

Error_Handl:
    Ambient_Rain_Play = False
End Function

Public Function Ambient_Rain_Int_Play() As Boolean
'**************************************************************
'Author: Augusto José Rando ([email protected])
'Last Modify Date: 2/08/2006
'**************************************************************

    On Error GoTo Error_Handl

    If (Opciones.Ambient = 0) Or (Engine_Initialized = False) Then Exit Function
    ambient_rain_int_buffer.SetVolume mEffectsVolumeAmbient
    ambient_rain_int_buffer.Play DSBPLAY_LOOPING

    Ambient_Rain_Int_Play = True
    Exit Function

Error_Handl:
    Ambient_Rain_Int_Play = False
End Function

Public Function Ambient_Stop() As Boolean
'**************************************************************
'Author: Augusto José Rando ([email protected])
'Last Modify Date: 2/08/2006
'**************************************************************

    On Error GoTo Error_Handl

    If (Opciones.Ambient = 0) Or (Engine_Initialized = False) Then Exit Function

    If Not ambient_buffer Is Nothing Then ambient_buffer.Stop
    'ambient_rain_int_buffer.Stop
    'ambient_rain_buffer.Stop
    'ambient_fire_buffer.Stop

    play_fire = False
    mAmbienteActual = 0

    Ambient_Stop = True
    Exit Function

Error_Handl:
    Ambient_Stop = False
End Function

Public Function Ambient_Volume_Set(ByVal sound_volume As Long) As Boolean
'**************************************************************
'Author: Augusto José Rando ([email protected])
'Last Modify Date: 2/08/2006
'**************************************************************

    On Error GoTo Error_Handl

    If (Opciones.Ambient = 0) Or (Engine_Initialized = False) Then Exit Function

    If sound_volume > 0 Then sound_volume = 0
    If sound_volume < -4000 Then sound_volume = -4000

    If Not ambient_buffer Is Nothing Then ambient_buffer.SetVolume sound_volume
    'ambient_rain_int_buffer.SetVolume sound_volume
    'ambient_rain_buffer.SetVolume sound_volume

    Ambient_Volume_Set = True
    Exit Function

Error_Handl:
    Ambient_Volume_Set = False
End Function

Public Function Sound_Render()
'**************************************************************
'Author: Augusto José Rando ([email protected])
'Last Modify Date: 17/08/2005
'**************************************************************

On Error Resume Next

Dim TiempoActual As Long, X As Integer, Y As Integer, mAmb As Integer

Static under_roof As Boolean
Static Sound_Buffer As DirectSoundSecondaryBuffer8

If Engine_Initialized Then

    TiempoActual = GetTickCount

    EXTERIOR_VOLUME = Opciones.AmbientVol - 300
    INTERIOR_VOLUME = Opciones.AmbientVol - 1000

    If UserMap > 0 Then
        under_roof = bTecho
        If MapExt Then
            mAmb = Ambient_Calculate
          
            If mAmbienteActual <> mAmb Then
                Call Ambient_Stop
                mAmbienteActual = mAmb
                Call Ambient_Load(mAmbienteActual, mEffectsVolumeAmbient)
                Call Ambient_Play
            End If
          
            If under_roof Then 'En los interiores el sonido es más suave :)
                If mEffectsVolumeAmbient <> INTERIOR_VOLUME Then
                    Call Ambient_Volume_Set(INTERIOR_VOLUME)
                    mEffectsVolumeAmbient = INTERIOR_VOLUME
                End If
            Else
                If mEffectsVolumeAmbient <> EXTERIOR_VOLUME Then
                    Call Ambient_Volume_Set(EXTERIOR_VOLUME)
                    mEffectsVolumeAmbient = EXTERIOR_VOLUME
                End If
            End If
          
        Else 'CurrentUser.MapExt = 0
      
            If mEffectsVolumeAmbient <> INTERIOR_VOLUME Then
                Call Ambient_Volume_Set(EXTERIOR_VOLUME)
                mEffectsVolumeAmbient = EXTERIOR_VOLUME
            End If
      
            mAmb = Ambient_Calculate
      
            If mAmbienteActual <> mAmb Then
                Call Ambient_Stop
                mAmbienteActual = mAmb
                Call Ambient_Load(mAmbienteActual, mEffectsVolumeAmbient)
                Call Ambient_Play
            End If
      
        End If

        If Map_Item_Grh_In_Current_Area(GRH_FOGATA, X, Y) Then
            If Not play_fire Then
                ambient_fire_buffer.SetVolume Calculate_Volume(X, Y)
                ambient_fire_buffer.SetPan Calculate_Pan(X, Y)
                ambient_fire_buffer.Play DSBPLAY_LOOPING
                play_fire = True
            ElseIf charlist(UserCharIndex).moved Then
                ambient_fire_buffer.SetVolume Calculate_Volume(X, Y)
                ambient_fire_buffer.SetPan Calculate_Pan(X, Y)
            End If
        ElseIf play_fire Then
            play_fire = False
            ambient_fire_buffer.Stop
        End If
          
    End If
      
    If mFadingMusicMod <> 0 And Opciones.sMusica <> CONST_DESHABILITADA Then
  
        '¿Fade up or fade down? Primero fade down, después fade up
        If TimeElapsed + 60 < TiempoActual Then
      
            TimeElapsed = TiempoActual
      
            'Fade down
            If mMusicVolume > mMusicVolumeMax Then
          
                mMusicVolume = mMusicVolumeMax
          
                If mFadingStatus = 0 Then
                    mFadingStatus = 1
                    mFadingMusicMod = mFadingMusicMod * (-1)
                Else
                    'TERMINAMOS!!!
                    mFadingMusicMod = 0
                    mFadingStatus = 0
                End If
            'Fade up
            ElseIf mMusicVolume < -4000 Then
                mFadingStatus = 2
                mMusicVolume = -4000
                mFadingMusicMod = mFadingMusicMod * (-1)
            End If
      
            mMusicVolume = mMusicVolume + mFadingMusicMod
      
            If Val(mNextMusic) > 0 And mFadingStatus = 2 Then
                If Music_Load(mNextMusic, mMusicVolume) Then
                    'Music_Stop
                    Music_Play
                End If
                mNextMusic = 0
            Else
                Music_Volume_Set mMusicVolume
            End If
        End If
    Else
        mMusicVolume = mMusicVolumeMax
    End If

    If Opciones.sMusica <> CONST_DESHABILITADA Then Call Music_GetLoop
    If UserCharIndex > 0 Then charlist(UserCharIndex).moved = False

End If

End Function

Public Function Sound_Load(ByVal file_num As Integer) As Boolean
'**************************************************************
'Author: Augusto José Rando
'Last Modify Date: 7/16/2005
'**************************************************************

    If (Opciones.Audio = 0) Or (Engine_Initialized = False) Then Exit Function

    If Buffers.CargarBuffer(file_num, Wav) Then
        Sound_Load = True
    End If

End Function

Public Function Calculate_Pan(ByVal map_x As Integer, ByVal map_y As Integer) As Long
'**************************************************************
'Author: Augusto José Rando
'Last Modify Date: 7/16/2005
'**************************************************************

    Dim total_distance As Integer, position_sgn As Integer, curr_x As Integer, curr_y As Integer

    If Char_Pos_Get(UserCharIndex, curr_x, curr_y) Then
        total_distance = General_Distance_Get(map_x, map_y, curr_x, curr_y)
  
        If mInvert_Sound = False Then
            If map_x < curr_x Then
                position_sgn = -1
            Else
                position_sgn = 1
            End If
        Else
            If map_x > curr_x Then
                position_sgn = -1
            Else
                position_sgn = 1
            End If
        End If
  
        If (total_distance = 0) Or (map_x = curr_x) Then
            Calculate_Pan = 0
        ElseIf total_distance < 9 Then
            Calculate_Pan = position_sgn * (total_distance * PAN_MOD)
        Else
            Calculate_Pan = position_sgn * (PAN_MOD * 9)
        End If
    End If

End Function

Public Function Calculate_Volume(ByVal map_x As Integer, ByVal map_y As Integer) As Long
'**************************************************************
'Author: Augusto José Rando
'Last Modify Date: 7/16/2005
'**************************************************************

    Dim total_distance As Integer, curr_x As Integer, curr_y As Integer

    If (Opciones.Audio = 0) Or (Engine_Initialized = False) Then Exit Function

    If Char_Pos_Get(UserCharIndex, curr_x, curr_y) Then
        total_distance = General_Distance_Get(map_x, map_y, curr_x, curr_y)
  
        If (total_distance = 0) Then
            Calculate_Volume = mEffectsVolumeMax
        ElseIf total_distance < 9 Then
            Calculate_Volume = mEffectsVolumeMax - (total_distance * VOLUME_DISTANCE_MOD)
        Else
            Calculate_Volume = mEffectsVolumeMax - (VOLUME_DISTANCE_MOD * 9)
        End If
    End If

    If Calculate_Volume < -4000 Then Calculate_Volume = -4000

End Function

Public Sub BorraTimer()
'**************************************************************
'Author: Augusto José Rando ([email protected])
'Last Modify Date: 2/08/2006
'**************************************************************

If Buffers Is Nothing Then Exit Sub
Buffers.BorraTimerProc

If Buffers_Sec Is Nothing Then Exit Sub
Buffers_Sec.BorraTimerProc

If Buffers_Ter Is Nothing Then Exit Sub
Buffers_Ter.BorraTimerProc

End Sub

Private Function Ambient_Calculate() As Integer

Dim intSound As Integer

If MapInfo.Ambient = "" Then MapInfo.Ambient = 0

intSound = MapInfo.Ambient

'If MapExt > 0 And intSound <> 73 Then
'    If Val(MapDat.battle_mode) = 0 Then
'        Ambient_Calculate = SND_AMBIENTE_NOCHE
'    Else
'        Ambient_Calculate = SND_AMBIENTE_NOCHE_CIU
'    End If
'Else
'   If intSound = 73 Then intSound = 75
    Ambient_Calculate = intSound
'End If

End Function
(Los códigos relacionados con la lluvia los deje comentados, asi que solo tendreis que echarle un vistazo y arreglar eso)

clsBufferMan

Código:
'*****************************************************************
'CBufferMan - ImperiumAO - v1.4.5 R5
'
'Sound buffer manager based on Maraxus's texture manager.
'
'*****************************************************************
'Respective portions copyrighted by contributors listed below.
'
'This library is free software; you can redistribute it and/or
'modify it under the terms of the GNU Lesser General Public
'License as published by the Free Software Foundation version 2.1 of
'the License
'
'This library is distributed in the hope that it will be useful,
'but WITHOUT ANY WARRANTY; without even the implied warranty of
'MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
'Lesser General Public License for more details.
'
'You should have received a copy of the GNU Lesser General Public
'License along with this library; if not, write to the Free Software
'Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

'*****************************************************************
'Maraxus (Juan Martín Sotuyo Dodero - [email protected])
'   - First Relase (as CTextureMan)
'Barrin (Augusto José Rando - [email protected])
'   - Modified to use sound buffers
'   - Modified to copy buffers when already streaming (multi-buffering)
'*****************************************************************

Option Explicit


Private Type WAV_DB_ENTRY
    FileName As Integer
    UltimoAcceso As Long
    buffer As DirectSoundSecondaryBuffer8
End Type

Private Type WAVETYPE
    strHead As String * 12
    strFormatID As String * 4
    lngChunkSize As Long
    intFormat As Integer
    intChannels As Integer
    lngSamplesPerSec As Long
    lngAvgBytesPerSec As Long
    intBlockAlign As Integer
    intBitsPerSample As Integer
End Type

Private mBuffers() As WAV_DB_ENTRY
Private mDS As DirectSound8

Private mMaxEntries As Integer
Private mCantidadBuffers As Integer

Private WavPath As String

Private Declare Function GetTickCount Lib "kernel32" () As Long
Private Declare Sub CopyMem Lib "kernel32" Alias "RtlMoveMemory" (destination As Any, source As Any, ByVal length As Long)

Private Sub Class_Initialize()
'**************************************************************
'Author: Juan Martín Sotuyo Dodero
'Modified by Augusto José Rando
'Last Modify Date: 5/04/2005
'
'**************************************************************

End Sub

Private Sub Class_Terminate()
'**************************************************************
'Author: Juan Martín Sotuyo Dodero
'Last Modify Date: 5/04/2005
'
'**************************************************************
On Error Resume Next
    Dim i As Long
    Dim j As Long

    For i = 1 To mCantidadBuffers
        Set mBuffers(i).buffer = Nothing
    Next i

    Erase mBuffers

End Sub

Public Property Let Path(ByVal inString As String)
'**************************************************************
'Author: Juan Martín Sotuyo Dodero
'Last Modify Date: 5/04/2005
'
'**************************************************************
    WavPath = inString
End Property

Public Sub GetBuffer(ByVal FileName As Integer, ByRef tBuff As DirectSoundSecondaryBuffer8, TIPO As resource_file_type)
'**************************************************************
'Author: Juan Martín Sotuyo Dodero
'Modified by Augusto José Rando
'Last Modify Date: 9/05/2005
'
'**************************************************************

    Dim IndiceObtenido As Integer
    'Dim tCap As DSBCAPS
    IndiceObtenido = ObtenerIndice(FileName)

    If IndiceObtenido > 0 Then
      
        If Not mBuffers(IndiceObtenido).buffer Is Nothing Then
            'If mBuffers(IndiceObtenido).buffer.GetStatus = DSBSTATUS_PLAYING Then
                'Call mBuffers(IndiceObtenido).buffer.GetCaps(tCap)
                'Call CopyMemory(ObjPtr(tBuff), ByVal ObjPtr(mBuffers(IndiceObtenido).buffer), tCap.lBufferBytes)
                'Set tBuff = mDS.DuplicateSoundBuffer(ByVal mBuffers(IndiceObtenido).buffer)
          
                'Call tBuff.GetCaps(tCap)
                'Debug.Print tCap.lBufferBytes
          
            'Else
                'Devuelvo un buffer con el sonido cargado
                Set tBuff = mBuffers(IndiceObtenido).buffer
            'End If
        Else
            If CreateBufferFromFile_Ex(FileName, IndiceObtenido, TIPO) Then
                Set tBuff = mBuffers(IndiceObtenido).buffer
            End If
        End If
          
        'Ultimo acceso
        mBuffers(IndiceObtenido).UltimoAcceso = GetTickCount
      
    Else    'Sonido no cargado
        GoTo CrearNuevoBuffer
    End If

Exit Sub

CrearNuevoBuffer:
    'Vemos si puedo agregar uno a la lista
    If mMaxEntries = mCantidadBuffers Then
        'Sacamos el que hace más que no usamos, y utilizamos el slot
        IndiceObtenido = CrearBuffer(FileName, BorraMenosUsado(), TIPO)
        Set tBuff = mBuffers(IndiceObtenido).buffer
    Else
        'Agrego un buffer nueva a la lista
        IndiceObtenido = CrearBuffer(FileName, IndiceObtenido, TIPO)
        Set tBuff = mBuffers(IndiceObtenido).buffer
    End If

End Sub

Private Function ObtenerIndice(ByVal FileName As Integer) As Integer
'**************************************************************
'Author: Juan Martín Sotuyo Dodero
'Last Modify Date: 5/04/2005
'Busqueda binaria para hallar el buffer deseado
'**************************************************************
    Dim max As Integer  'Max index
    Dim min As Integer  'Min index
    Dim mid As Integer  'Middle index

    min = 1
    mid = 1
    max = mCantidadBuffers

    Do While min <= max
        mid = (min + max) / 2
        If FileName < mBuffers(mid).FileName Then
            'El índice no existe
            max = mid - 1
        ElseIf FileName > mBuffers(mid).FileName Then
            'El índice no existe
            min = mid + 1
        Else
            ObtenerIndice = mid
            Exit Function
        End If
    Loop

    'Maraxus - usado para binary insertion
    ObtenerIndice = Not mid

End Function

Public Function Init(ByRef DS8 As DirectSound8, ByVal MaxEntries As Integer) As Boolean
'**************************************************************
'Author: Juan Martín Sotuyo Dodero
'Last Modify Date: 5/04/2005
'
'**************************************************************

    mMaxEntries = MaxEntries

    If mMaxEntries < 1 Then 'por lo menos 1 sonido
        Exit Function
    End If

    mCantidadBuffers = 0

    'Seteamos el objeto
    Set mDS = DS8

    Init = True
End Function

Public Sub BorrarTodo()
'**************************************************************
'Author: Juan Martín Sotuyo Dodero
'Last Modify Date: 5/04/2005
'Vacia la lista de sonidos
'**************************************************************
    Dim i As Long, j As Long

    For i = 1 To mCantidadBuffers
        Set mBuffers(i).buffer = Nothing
    Next i

    ReDim mBuffers(0)
    mCantidadBuffers = 0
End Sub

Public Sub DetenerTodo()
'**************************************************************
'Author: Augusto José Rando
'Last Modify Date: 5/04/2005
'Detiene todos los sonidos
'**************************************************************
    Dim i As Long
    Dim j As Long

    For i = 1 To mCantidadBuffers
        If Not mBuffers(i).buffer Is Nothing Then
            If (mBuffers(i).buffer.GetStatus = DSBSTATUS_PLAYING + DSBSTATUS_LOOPING) Or (mBuffers(i).buffer.GetStatus = DSBSTATUS_PLAYING) Then
                mBuffers(i).buffer.Stop
                mBuffers(i).buffer.SetCurrentPosition 0
            End If
        End If
          
    Next i

End Sub

Public Sub ModificarVolumenTodo(ByVal Volume As Long)
'**************************************************************
'Author: Augusto José Rando
'Last Modify Date: 5/04/2005
'Detiene todos los sonidos
'**************************************************************
    Dim i As Long
    Dim j As Long

    For i = 1 To mCantidadBuffers
        If Not mBuffers(i).buffer Is Nothing Then
            If (mBuffers(i).buffer.GetStatus = DSBSTATUS_LOOPING + DSBSTATUS_PLAYING) Or (mBuffers(i).buffer.GetStatus = DSBSTATUS_PLAYING) Then
                mBuffers(i).buffer.SetVolume Volume
            End If
        End If
    Next i

End Sub

Public Function Borrar(ByVal FileName As Integer) As Integer
'**************************************************************
'Author: Juan Martín Sotuyo Dodero
'Last Modify Date: 5/04/2005
'Borra un sonido
'**************************************************************
    Dim indice As Long

    'Obtenemos el ìndice
    indice = ObtenerIndice(FileName)
    If indice < 0 Then Exit Function

    'Lo eliminamos
    With mBuffers(indice)
        Set .buffer = Nothing
        .FileName = 0
        .UltimoAcceso = 0
    End With

    'Actualizamos el número de sonidos
    mCantidadBuffers = mCantidadBuffers - 1

    'Movemos para atrás el resto de la lista
    For indice = indice To mCantidadBuffers
        mBuffers(indice) = mBuffers(indice + 1)
    Next indice

    'Redimencionamos la lista
    ReDim Preserve mBuffers(1 To mCantidadBuffers)
End Function

Private Function CrearBuffer(ByVal Archivo As Integer, ByVal Index As Integer, ByVal TIPO As resource_file_type) As Integer
'**************************************************************
'Author: Juan Martín Sotuyo Dodero
'Last Modify Date: 5/04/2005
'
'**************************************************************
On Error GoTo ErrHandler
  
    If Index < 0 Then
        Index = Not Index   ' Obtenemos el índice donde debe ser insertado
        ReDim Preserve mBuffers(1 To mCantidadBuffers + 1) As WAV_DB_ENTRY    ' Incrementamos la lista
        If Index < mCantidadBuffers + 1 Then
            Dim i As Long
            For i = mCantidadBuffers To Index Step -1
                mBuffers(i + 1) = mBuffers(i)
            Next i
        End If
    End If

    With mBuffers(Index)
        'Nombre
        .FileName = Archivo
  
        'Ultimo acceso
        .UltimoAcceso = GetTickCount
  
        Call CreateBufferFromFile_Ex(Archivo, Index, TIPO)
  
    End With

    'Aumentamos la cantidad de sonidos
    mCantidadBuffers = mCantidadBuffers + 1
  
    'Devolvemos el ìndice en que lo cargamos
    CrearBuffer = Index
Exit Function

ErrHandler:

End Function

Private Function CreateBufferFromFile(ByVal file_name As Integer, ByVal buffer_index As Integer, Optional ByVal Ambient As Boolean = False) As Boolean
'**************************************************************
'Author: Augusto José Rando
'Last Modify Date: 3/04/2007
'Creación de buffers desde archivo (despreciado)
'**************************************************************

Dim dsbd As DSBUFFERDESC, dsbcap As DSBCAPS

dsbd.lFlags = DSBCAPS_CTRLFREQUENCY Or DSBCAPS_CTRLPAN Or DSBCAPS_CTRLVOLUME
dsbd.fxFormat.nFormatTag = WAVE_FORMAT_PCM
dsbd.fxFormat.nChannels = 2
dsbd.fxFormat.lSamplesPerSec = 22050
dsbd.fxFormat.nBitsPerSample = 16
dsbd.fxFormat.nBlockAlign = dsbd.fxFormat.nBitsPerSample / 8 * dsbd.fxFormat.nChannels
dsbd.fxFormat.lAvgBytesPerSec = dsbd.fxFormat.lSamplesPerSec * dsbd.fxFormat.nBlockAlign

If Ambient = False Then
    If Extract_File(Wav, WavPath, file_name & ".wav", Windows_Temp_Dir, False) Then
        Set mBuffers(buffer_index).buffer = mDS.CreateSoundBufferFromFile(Windows_Temp_Dir & file_name & ".wav", dsbd)
        Delete_File Windows_Temp_Dir & file_name & ".wav"
        CreateBufferFromFile = True
    End If
Else
    If Extract_File(Ambient, WavPath, file_name & ".amb", Windows_Temp_Dir, False) Then
        Set mBuffers(buffer_index).buffer = mDS.CreateSoundBufferFromFile(Windows_Temp_Dir & file_name & ".wav", dsbd)
        Delete_File Windows_Temp_Dir & file_name & ".amb"
        CreateBufferFromFile = True
    End If
End If
Exit Function

ErrHandler:
    If Ambient = False Then
        'Ocurrió un error, la causa más probable es que el archivo no exista
        If FileExist(Windows_Temp_Dir & file_name & ".wav", vbNormal) Then
            Delete_File Windows_Temp_Dir & file_name & ".wav"
        End If
    Else
        'Ocurrió un error, la causa más probable es que el archivo no exista
        If FileExist(Windows_Temp_Dir & file_name & ".amb", vbNormal) Then
            Delete_File Windows_Temp_Dir & file_name & ".amb"
        End If
    End If

End Function

Private Function CreateBufferFromFile_Ex(ByVal file_name As Integer, ByVal buffer_index, ByVal TIPO As resource_file_type) As Boolean
'**************************************************************
'Author: Augusto José Rando
'Last Modify Date: 3/04/2007
'Creación de buffers desde memoria
'**************************************************************

On Error GoTo ErrorHandler

Dim extension As String

Dim btArr() As Byte, gudtHeader As WAVETYPE

Dim i As Long, lngChunkSize As Long

Dim tB(1 To 4) As Byte

Dim glngChunkSize As Long
Dim lngOffset As Long

Dim udtBufferDesc As DSBUFFERDESC

If TIPO = Ambient Then
    extension = ".amb"
Else
    extension = ".wav"
End If

If TIPO = Ambient Then Debug.Print "Tipo: " & TIPO & " Extension: " & extension & " WavPath: " & WavPath & " file_Name: " & file_name

If Extract_File_Ex(TIPO, WavPath, file_name & extension, btArr) Then

    lngOffset = LenB(gudtHeader)

    Call CopyMemory(gudtHeader, btArr(0), lngOffset)

    'Only PCM
    If gudtHeader.intFormat <> WAVE_FORMAT_PCM Then Exit Function

    lngOffset = 36

    For i = lngOffset To UBound(btArr)
        tB(1) = btArr(i)
        tB(2) = btArr(i + 1)
        tB(3) = btArr(i + 2)
        tB(4) = btArr(i + 3)
  
        If StrConv(tB(), vbUnicode) = "data" Then
            Exit For
        End If
  
    Next i

    lngOffset = i + 4

    Call CopyMemory(ByVal VarPtr(glngChunkSize), btArr(lngOffset), ByVal 4)

    lngOffset = lngOffset + 4

    'Set the Wave Format
    With udtBufferDesc.fxFormat
        .nFormatTag = gudtHeader.intFormat
        .nChannels = gudtHeader.intChannels
        .lSamplesPerSec = gudtHeader.lngSamplesPerSec
        .nBitsPerSample = gudtHeader.intBitsPerSample
        .nBlockAlign = gudtHeader.intBlockAlign
        .lAvgBytesPerSec = gudtHeader.lngAvgBytesPerSec
        .nsize = gudtHeader.lngChunkSize
    End With
      
    'Create the buffer
    udtBufferDesc.lBufferBytes = glngChunkSize
    udtBufferDesc.lFlags = DSBCAPS_CTRLPAN Or DSBCAPS_CTRLVOLUME

    Set mBuffers(buffer_index).buffer = mDS.CreateSoundBuffer(udtBufferDesc)
          
    'Load the buffer with data
    mBuffers(buffer_index).buffer.WriteBuffer 0, glngChunkSize, btArr(lngOffset), DSBLOCK_ENTIREBUFFER
  
    CreateBufferFromFile_Ex = True
End If

Exit Function

ErrorHandler:
    'Ocurrió un error, la causa más probable es que el archivo no exista
    'If General_File_Exists(Windows_Temp_Dir & file_name & ".wav", vbNormal) Then
    '    Delete_File Windows_Temp_Dir & file_name & ".wav"
    'End If

End Function
Private Function BorraMenosUsado() As Integer
'**************************************************************
'Author: Juan Martín Sotuyo Dodero
'Last Modify Date: 5/04/2005
'Borra el sonido menos usado. Devuelve el index del borrado para ser reutilizado
'NO redimenciona la lista, estamos forzando a sacar uno para meter otro en su lugar
'**************************************************************
    Dim Valor As Long
    Dim i As Long

    'Inicializamos todo
    Valor = mBuffers(1).UltimoAcceso
    BorraMenosUsado = 1

    'Buscamos cual es el que lleva más tiempo sin ser utilizado
    For i = 1 To mCantidadBuffers
        If mBuffers(i).UltimoAcceso < Valor And (Not PlayingCheck(0, i)) Then
            Valor = mBuffers(i).UltimoAcceso
            BorraMenosUsado = i
        End If
    Next i

    'Disminuimos el contador
    mCantidadBuffers = mCantidadBuffers - 1

    'Borramos los buffers
    Set mBuffers(BorraMenosUsado).buffer = Nothing

    mBuffers(BorraMenosUsado).FileName = 0
    mBuffers(BorraMenosUsado).UltimoAcceso = 0

    ' Redimensionamos el array
    ReDim Preserve mBuffers(mCantidadBuffers)

End Function

Public Property Get MaxEntries() As Integer
'**************************************************************
'Author: Juan Martín Sotuyo Dodero
'Last Modify Date: 5/04/2005
'
'**************************************************************
    MaxEntries = mMaxEntries
End Property

Public Property Let MaxEntries(ByVal vNewValue As Integer)
'**************************************************************
'Author: Juan Martín Sotuyo Dodero
'Last Modify Date: 5/04/2005
'
'**************************************************************
    mMaxEntries = vNewValue
End Property

Public Property Get CantidadBuffers() As Integer
'**************************************************************
'Author: Juan Martín Sotuyo Dodero
'Last Modify Date: 5/04/2005
'
'**************************************************************
    CantidadBuffers = mCantidadBuffers
End Property

Public Sub BorraTimerProc()
'**************************************************************
'Author: Juan Martín Sotuyo Dodero
'Last Modify Date: 5/04/2005
'Cada un minuto revisamos que buffers se pueden eliminar
'**************************************************************
    On Error Resume Next

    Dim loopc As Long
    Dim offset As Integer
    Dim TiempoActual As Long

    TiempoActual = GetTickCount

    For loopc = 1 To mCantidadBuffers
        'Revisar cuales usamos
        If mBuffers(loopc).UltimoAcceso > TiempoActual - 60000 Then
            'Si el offset está seteado, movemos para atrás la lista
            If offset Then
                mBuffers(loopc - offset) = mBuffers(loopc)
            End If
        Else
            'Eliminar de memoria
            Set mBuffers(loopc).buffer = Nothing
      
            'Clear variables
            mBuffers(loopc).FileName = 0
            mBuffers(loopc).UltimoAcceso = 0
      
            offset = offset + 1
        End If
    Next loopc

    'Actualizar el número de sonidos
    mCantidadBuffers = mCantidadBuffers - offset
End Sub

Public Function CargarBuffer(ByVal FileName As Integer, ByVal TIPO As resource_file_type) As Boolean
'**************************************************************
'Author: Augusto José Rando
'Last Modify Date: 17/08/2005
'
'**************************************************************

    Dim Index As Integer
    Index = ObtenerIndice(FileName)

    If Index > 0 Then
        CargarBuffer = True
    Else    'Sonido no cargado
        'Vemos si puedo agregar uno a la lista
        If mMaxEntries = mCantidadBuffers Then
            'Sacamos el que hace más que no usamos, y utilizamos el slot
            Call CrearBuffer(FileName, BorraMenosUsado(), TIPO)
            CargarBuffer = True
        Else
            'Agrego un buffer nueva a la lista
            Call CrearBuffer(FileName, Index, TIPO)
            CargarBuffer = True
        End If
    End If

End Function

Public Function Reproducir(ByVal file_name As Integer, play_format As CONST_DSBPLAYFLAGS, ByVal Volume As Long, ByVal pan As Long) As Boolean
'**************************************************************
'Author: Augusto José Rando
'Last Modify Date: 17/08/2005
'
'**************************************************************

Static Sound_Buffer As DirectSoundSecondaryBuffer8

On Error GoTo ErrorHandler

    Call GetBuffer(file_name, Sound_Buffer, Wav)
    If Sound_Buffer Is Nothing Then Exit Function

    'Esto solo debería pasar si ya hay MAX_BUFFERS en reproducción
    If Sound_Buffer.GetStatus = DSBSTATUS_PLAYING Then Exit Function

    Sound_Buffer.SetPan pan
    Sound_Buffer.SetVolume Volume
      
    Sound_Buffer.Play play_format

    Reproducir = True

    Exit Function

ErrorHandler:
    Reproducir = False

End Function

Public Function Detener(ByVal file_name As Integer) As Boolean
'**************************************************************
'Author: Augusto José Rando
'Last Modify Date: 17/08/2005
'
'**************************************************************

On Error GoTo ErrorHandler

Dim IndiceObtenido As Integer, i As Long

    IndiceObtenido = ObtenerIndice(file_name)
    If IndiceObtenido < 0 Then Exit Function

    If Not mBuffers(IndiceObtenido).buffer Is Nothing Then
        mBuffers(IndiceObtenido).buffer.Stop
        mBuffers(IndiceObtenido).buffer.SetCurrentPosition 0
    End If
  
    Detener = True

    Exit Function

ErrorHandler:
    Detener = False

End Function

Public Function CambiarVolumen(ByVal file_name As Integer, ByVal volumen As Long) As Boolean
'**************************************************************
'Author: Augusto José Rando
'Last Modify Date: 17/08/2005
'Returns true if successfully changed volume of a playing buffer
'**************************************************************

On Error GoTo ErrorHandler

Dim IndiceObtenido As Integer, i As Long, bFlag As Boolean

    IndiceObtenido = ObtenerIndice(file_name)
    If IndiceObtenido < 0 Then Exit Function

    If Not mBuffers(IndiceObtenido).buffer Is Nothing Then
        mBuffers(IndiceObtenido).buffer.SetVolume volumen
        If (mBuffers(IndiceObtenido).buffer.GetStatus = DSBSTATUS_PLAYING Or mBuffers(IndiceObtenido).buffer.GetStatus = DSBSTATUS_PLAYING + DSBSTATUS_LOOPING) Then bFlag = True
    End If
  
    CambiarVolumen = bFlag

    Exit Function

ErrorHandler:
    CambiarVolumen = False

End Function

Public Function CambiarPan(ByVal file_name As Integer, ByVal pan As Long) As Boolean
'**************************************************************
'Author: Augusto José Rando
'Last Modify Date: 17/08/2005
'Returns true if successfully changed pan of a playing buffer
'**************************************************************

On Error GoTo ErrorHandler

Dim IndiceObtenido As Integer, i As Long, bFlag As Boolean

    IndiceObtenido = ObtenerIndice(file_name)
    If IndiceObtenido < 0 Then Exit Function

    If Not mBuffers(IndiceObtenido).buffer Is Nothing Then
        mBuffers(IndiceObtenido).buffer.SetPan pan
        If (mBuffers(IndiceObtenido).buffer.GetStatus = DSBSTATUS_PLAYING Or mBuffers(IndiceObtenido).buffer.GetStatus = DSBSTATUS_PLAYING + DSBSTATUS_LOOPING) Then bFlag = True
    End If
  
    CambiarPan = bFlag

    Exit Function

ErrorHandler:
    CambiarPan = False

End Function

Public Function PlayingCheck(ByVal file_name As Integer, Optional ByVal IndiceObtenido As Integer = -1) As Boolean
'**************************************************************
'Author: Augusto José Rando
'Last Modify Date: 17/08/2005
'Returns true if playing
'**************************************************************

On Error GoTo ErrorHandler

Dim i As Long, bFlag As Boolean

    If IndiceObtenido = -1 Then
        IndiceObtenido = ObtenerIndice(file_name)
        If IndiceObtenido < 0 Then Exit Function
    End If

    If Not mBuffers(IndiceObtenido).buffer Is Nothing Then
        If (mBuffers(IndiceObtenido).buffer.GetStatus = DSBSTATUS_PLAYING + DSBSTATUS_LOOPING) Or (mBuffers(IndiceObtenido).buffer.GetStatus = DSBSTATUS_PLAYING) Then
            PlayingCheck = True
            Exit Function
        End If
    End If

    Exit Function

ErrorHandler:
    PlayingCheck = False

End Function

En el mod declaraciones ponemos:


Código:
Public Enum E_SISTEMA_MUSICA
    CONST_DESHABILITADA = 0
    CONST_MIDI = 1
    CONST_MP3 = 2
End Enum

Public sMusica As E_SISTEMA_MUSICA

'No poner boolean, da problemas.
Private Type tOptions
    Ambient As Byte
    AmbientVol As Long
    Audio As Byte
    FxNavega As Long
    InvertirSonido As Byte
    FXVolume As Long
    sMusica As E_SISTEMA_MUSICA
End Type

Public Opciones as tOptions
Seguimos en declaraciones y buscan la parte donde declaran los sonidos y añades:

Código:
Public Const SND_FUEGO As Integer = 79
Public Const GRH_FOGATA As Integer = 1521

Continuamos en declaraciones, ¿recuerdan la parte donde eliminamos el Public audio as New...? pues ahi ponemos:

Código:
Public Sound As clsSoundEngine
Y en el mismo modulo:

Código:
'CopyMemory Kernel Function
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)

En vuestro modulo de engine (no importa que engine uséis):

Código:
Public Function Map_Item_Grh_In_Current_Area(ByVal grh_index As Long, ByRef x_pos As Integer, ByRef y_pos As Integer) As Boolean
'*****************************************************************
'Author: Augusto José Rando
'Co-Author: Lorwik
'*****************************************************************
    On Error GoTo ErrorHandler

    Dim map_x As Integer
    Dim map_y As Integer
    Dim X As Integer, Y As Integer

    Call Char_Pos_Get(UserCharIndex, map_x, map_y)

    If Map_In_Bounds(map_x, map_y) Then
        For Y = map_y - MinYBorder + 1 To map_y + MinYBorder - 1
          For X = map_x - MinXBorder + 1 To map_x + MinXBorder - 1
                If Y < 1 Then Y = 1
                If X < 1 Then X = 1
                If MapData(X, Y).ObjGrh.GrhIndex = grh_index Then
                    x_pos = X
                    y_pos = Y
                    Map_Item_Grh_In_Current_Area = True
                    Exit Function
                End If
          Next X
        Next Y
    End If

    Exit Function

ErrorHandler:
    Map_Item_Grh_In_Current_Area = False

End Function

Public Function Char_Pos_Get(ByVal char_index As Integer, ByRef map_x As Integer, ByRef map_y As Integer) As Boolean
'*****************************************************************
'Author: Aaron Perkins
'Co-Author: Lorwik
'*****************************************************************
   'Make sure it's a legal char_index
    If Char_Check(char_index) Then
        map_x = charlist(char_index).Pos.X
        map_y = charlist(char_index).Pos.Y
        Char_Pos_Get = True
    End If
End Function
En el "Type Char" debajo de donde dice "Pos as Position" pones:

Código:
moved As Boolean
En el Mod_General:

Código:
Public Function General_Distance_Get(ByVal X1 As Integer, ByVal Y1 As Integer, ByVal X2 As Integer, ByVal Y2 As Integer) As Integer
'**************************************************************
'Author: Augusto José Rando
'Co-AUthor: Lorwik
'Last Modify Date: Unknown
'
'**************************************************************

General_Distance_Get = Abs(X1 - X2) + Abs(Y1 - Y2)

End Function
En el "Type MapInfo" pones:

Código:
    Ambient As String
Bien, vamos al "Sub Main" en donde antes iniciaba el antiguo engine y ponemos:

Código:
    If Sound.Initialize_Engine(frmMain.hwnd, App.Path & "\Recursos", App.Path & "\Recursos", App.Path & "\Recursos", False, (Opciones.Audio > 0), (Opciones.sMusica <> CONST_DESHABILITADA), Opciones.FXVolume, False, Opciones.InvertirSonido) Then
        'frmCargando.picLoad.Width = 300
    Else
        MsgBox "¡No se ha logrado iniciar el engine de DirectSound! Reinstale los últimos controladores de DirectX. No habrá soporte de audio en el juego.", vbCritical, "Advertencia"
        frmOpciones.Frame2.Enabled = False
    End If


    If Opciones.sMusica <> CONST_DESHABILITADA Then
        Sound.NextMusic = MUS_Inicio
        Sound.Fading = 350
        Sound.Sound_Render
    End If
Buscan la variables que se llama MP3_Inicio, la eliminan y en su lugar ponen:

Código:
Public Const MUS_Inicio As String = "6"
Public Const MUS_CrearPersonaje As String = "7"
Public Const MUS_VolverInicio As String = "53"
En el "Sub Main", al principio:

Código:
Set Sound = New clsSoundEngine
Vamos al frmMain, donde decia eso de "Audio.MusicActivated = Not Audio.MusicActivated" que dije que recordarais bien, pues en su lugar vamos a poner:

Código:
                If Opciones.sMusica = CONST_MP3 Then
                    Sound.Music_Stop
                    Opciones.sMusica = CONST_DESHABILITADA
                Else
                    Opciones.sMusica = CONST_MP3
                End If
El del FX:

Código:
        If FxNavega = 1 Then
            FxNavega = 0
        Else
            FxNavega = 1
        End If
Y el otro no se como seria (esta parte la estoy haciendo en el foro xD).

Ahora hay que buscar las llamadas que comentamos, empezando por

Código:
'Call Audio.PlayWave(
y las vamos reemplazando por:

Código:
Call Sound.Sound_Play(

Excepto en el paquete del Wav (HandlePlayWave), ahi tenemos que reemplazarlo por:

Código:
Call Sound.Sound_Play(wave, , Sound.Calculate_Volume(srcX, srcY), Sound.Calculate_Pan(srcX, srcY))
Lo mismo con:

Código:
'Call Audio.StopWave
lo reemplazamos por:

Código:
Call Sound.StopWave
En el "Sub ResetAllInfo":

Código:
    'Stop audio
    Sound.Sound_Stop_All
    Sound.Ambient_Stop
Si en ese Sub teneis esto:

Código:
    'Stop audio
    Call Sound.StopWave
    frmMain.IsPlaying = PlayLoop.plNone
Lo podéis eliminar.

¿Recordais que eliminamos el DoPasosFX? Pues ahora esta de vuelta con una cierta mejora, asi que despues del "Sub RenderScreen" poneis:

Código:
Sub DoPasosFx(ByVal CharIndex As Integer)
Static TerrenoDePaso As TipoPaso

    With charlist(CharIndex)
        If Not UserNavegando Then
            If Not .muerto And EstaPCarea(CharIndex) And (.priv = 0 Or .priv > 5) Then
                .pie = Not .pie
             
                    If Not Char_Big_Get(CharIndex) Then
                        TerrenoDePaso = GetTerrenoDePaso(.Pos.X, .Pos.Y)
                    Else
                        TerrenoDePaso = CONST_PESADO
                    End If
             
                    If .pie = 0 Then
                        Call Sound.Sound_Play(Pasos(TerrenoDePaso).Wav(1), , Sound.Calculate_Volume(.Pos.X, .Pos.Y), Sound.Calculate_Pan(.Pos.X, .Pos.Y))
                    Else
                        Call Sound.Sound_Play(Pasos(TerrenoDePaso).Wav(2), , Sound.Calculate_Volume(.Pos.X, .Pos.Y), Sound.Calculate_Pan(.Pos.X, .Pos.Y))
                    End If
            End If
        Else
    ' TODO : Actually we would have to check if the CharIndex char is in the water or not....
            If Opciones.FxNavega = 1 Then Call Sound.Sound_Play(SND_NAVEGANDO)
        End If
    End With
End Sub

Private Function GetTerrenoDePaso(ByVal X As Byte, ByVal Y As Byte) As TipoPaso
    With MapData(X, Y).Graphic(1)
        If .GrhIndex >= 6000 And .GrhIndex <= 6307 Then
            GetTerrenoDePaso = CONST_BOSQUE
            Exit Function
        ElseIf .GrhIndex >= 7501 And .GrhIndex <= 7507 Or .GrhIndex >= 7508 And .GrhIndex <= 2508 Then
            GetTerrenoDePaso = CONST_DUNGEON
            Exit Function
        'ElseIf (TerrainFileNum >= 5000 And TerrainFileNum <= 5004) Then
        '    GetTerrenoDePaso = CONST_NIEVE
        '    Exit Function
        Else
            GetTerrenoDePaso = CONST_PISO
        End If
    End With
End Function

Public Function Char_Big_Get(ByVal CharIndex As Integer) As Boolean
'*****************************************************************
'Author: Augusto José Rando
'*****************************************************************
   On Error GoTo ErrorHandler


   'Make sure it's a legal char_index
    If Char_Check(CharIndex) Then
        Char_Big_Get = (GrhData(charlist(CharIndex).Body.Walk(charlist(CharIndex).Heading).GrhIndex).TileWidth > 4)
    End If

    Exit Function

ErrorHandler:

End Function
(Esto añade el sonido de los pasos según el terreno y si el bicho es grande o chico)

En el mod general:

Código:
Public Sub CargarPasos()

    ReDim Pasos(1 To NUM_PASOS) As tPaso

    Pasos(CONST_BOSQUE).CantPasos = 2
    ReDim Pasos(CONST_BOSQUE).Wav(1 To Pasos(CONST_BOSQUE).CantPasos) As Integer
    Pasos(CONST_BOSQUE).Wav(1) = 201
    Pasos(CONST_BOSQUE).Wav(2) = 202

    Pasos(CONST_NIEVE).CantPasos = 2
    ReDim Pasos(CONST_NIEVE).Wav(1 To Pasos(CONST_NIEVE).CantPasos) As Integer
    Pasos(CONST_NIEVE).Wav(1) = 199
    Pasos(CONST_NIEVE).Wav(2) = 200

    Pasos(CONST_CABALLO).CantPasos = 2
    ReDim Pasos(CONST_CABALLO).Wav(1 To Pasos(CONST_CABALLO).CantPasos) As Integer
    Pasos(CONST_CABALLO).Wav(1) = 23
    Pasos(CONST_CABALLO).Wav(2) = 24

    Pasos(CONST_DUNGEON).CantPasos = 2
    ReDim Pasos(CONST_DUNGEON).Wav(1 To Pasos(CONST_DUNGEON).CantPasos) As Integer
    Pasos(CONST_DUNGEON).Wav(1) = 23
    Pasos(CONST_DUNGEON).Wav(2) = 24

    Pasos(CONST_DESIERTO).CantPasos = 2
    ReDim Pasos(CONST_DESIERTO).Wav(1 To Pasos(CONST_DESIERTO).CantPasos) As Integer
    Pasos(CONST_DESIERTO).Wav(1) = 197
    Pasos(CONST_DESIERTO).Wav(2) = 198

    Pasos(CONST_PISO).CantPasos = 2
    ReDim Pasos(CONST_PISO).Wav(1 To Pasos(CONST_PISO).CantPasos) As Integer
    Pasos(CONST_PISO).Wav(1) = 23
    Pasos(CONST_PISO).Wav(2) = 24

    Pasos(CONST_PESADO).CantPasos = 3
    ReDim Pasos(CONST_PESADO).Wav(1 To Pasos(CONST_PESADO).CantPasos) As Integer
    Pasos(CONST_PESADO).Wav(1) = 220
    Pasos(CONST_PESADO).Wav(2) = 221
    Pasos(CONST_PESADO).Wav(3) = 222

End Sub
(Tendreis que editar el numero de los Wav)

En el sub main, antes de cargar el engine de sonido poneis:

Código:
Call CargarPasos
En declaraciones:

Código:
Public Enum TipoPaso
    CONST_BOSQUE = 1
    CONST_NIEVE = 2
    CONST_CABALLO = 3
    CONST_DUNGEON = 4
    CONST_PISO = 5
    CONST_DESIERTO = 6
    CONST_PESADO = 7
End Enum

Public Type tPaso
    CantPasos As Byte
    Wav() As Integer
End Type

Public Const NUM_PASOS As Byte = 7
Public Pasos() As tPaso
En el "HandleDisconnect" o en el paquete donde desconectas:

Código:
    If Opciones.sMusica <> CONST_DESHABILITADA Then
        If Opciones.sMusica <> CONST_DESHABILITADA Then
            Sound.NextMusic = MUS_VolverInicio
            Sound.Fading = 200
        End If
    End If

(os preguntareis por que el If esta duplicado, yo también me lo pregunto, así que lo dejo así por que creo que no funciona si eliminas 1)

En el paquete donde cambias de mapa (HandleChangeMap) debajo de la llamada al SwitchMap poneis:

Código:
        Call SwitchMap(UserMap, MapFile)
        If Opciones.sMusica <> CONST_DESHABILITADA Then
            If Opciones.sMusica <> CONST_DESHABILITADA Then
                Sound.NextMusic = MapInfo.Music
                Sound.Fading = 200
            End If
        End If
En el paquete que hace la llamada al Midi (HandlePlayMidi) poneis:

Código:
    If currentMidi Then
        If Opciones.sMusica <> CONST_DESHABILITADA Then
            If Opciones.sMusica <> CONST_DESHABILITADA Then
                Sound.NextMusic = currentMidi
                Sound.Fading = 200
            End If
        End If
    Else
        'Remove the bytes to prevent errors
        Call incomingData.ReadInteger
    End If
En el frmcrearpersonaje, en el boton volver:

Código:
    Call Sound.Sound_Play(SND_CLICK)
    Unload Me

    If Opciones.sMusica <> CONST_DESHABILITADA Then
        If Opciones.sMusica <> CONST_DESHABILITADA Then
            Sound.NextMusic = MUS_VolverInicio
            Sound.Fading = 200
        End If
    End If
En el boton para ir al crearpersonaje poneis:

Código:
    If Opciones.sMusica <> CONST_DESHABILITADA Then
        If Opciones.sMusica <> CONST_DESHABILITADA Then
            Sound.NextMusic = MUS_CrearPersonaje
            Sound.Fading = 500
        End If
    End If

Buscais el "Do While prgRun" y antes de que termine el "If EngineRun Then" poneis:

Código:
If (Opciones.Audio = 1 Or Opciones.sMusica <> CONST_DESHABILITADA) Then Call Sound.Sound_Render
Finalmente queda hacer panel de opciones que para ello crean 3 HScrollBar con nombre:

scrVolume
scrAmbient
scrMidi

Tambien crean 5 CheckBox con nombre chkop

Código:
Private Sub chkop_Click(Index As Integer)
Call Sound.Sound_Play(SND_CLICK)

    Select Case Index
        Case 0
             
            If chkop(Index).value = vbUnchecked Then
                Sound.Music_Stop
                Opciones.sMusica = CONST_DESHABILITADA
                scrMidi.Enabled = False
            Else
                Opciones.sMusica = CONST_MP3
                scrMidi.Enabled = True
            End If
 
        Case 1

            If chkop(Index).value = vbUnchecked Then
                chkop(2).Enabled = False
                'scrAmbient.Enabled = False
                scrVolume.Enabled = False
                Opciones.Audio = 0
            Else
                Opciones.Audio = 1
                chkop(2).Enabled = True
                scrVolume.Enabled = True
            End If

        Case 2

            If chkop(Index).value = vbUnchecked Then
                Opciones.FxNavega = 0
            Else
                Opciones.FxNavega = 1
            End If
     
        Case 3
     
            If chkop(Index).value = vbUnchecked Then
                Opciones.Ambient = 0
                Call Sound.Sound_Stop_All
            Else
                Opciones.Ambient = 1
                scrAmbient.Enabled = True
                Call Sound.Ambient_Load(Sound.AmbienteActual, Opciones.AmbientVol)
                Call Sound.Ambient_Play
            End If
    End Select
End Sub

Private Sub scrMidi_Change()

    If Opciones.sMusica <> CONST_DESHABILITADA Then
        Sound.Music_Volume_Set scrMidi.value
        Sound.VolumenActualMusicMax = scrMidi.value
        Opciones.MusicVolume = Sound.VolumenActualMusicMax
    End If

End Sub

Private Sub scrAmbient_Change()
    If Opciones.Ambient = 1 Then
        Sound.VolumenActualAmbient_set scrAmbient.value
        Opciones.AmbientVol = Sound.VolumenActualAmbient
    End If
End Sub

Private Sub scrVolume_Change()

If Opciones.Audio = 1 Then
    Sound.VolumenActual = scrVolume.value
    Opciones.FXVolume = Sound.VolumenActual
End If

End Sub


Bien, esto es todo, a mi me funciona perfectamente, aunque en algunos momentos tuve que improvisar un poco por que no sabia para que servían X cosas, por ejemplo "MapExt", si se fijan lo deje declarado con una constante valor 0. Ademas, el cliente de IAO de donde extraje el engine estaba algo incompleto y tuve que ir completándolo según me fue pareciendo (use la que tienen liberada en su SourceForge).
Es posible que no os funcione de primera y tengáis que tocar alguna cosa, pero aun así tenéis todo el codigo, tampoco os lo iba a dejar todo perfecto.

Si encontráis algún error (seguro) o encontráis alguna parte que se puede mejorar os agradecería que aportarais la solución.

PD: El sistema lee Sonidos, Musica y Ambient comprimidos, es vuestra elección se queréis que siga así.

PD2: También debéis de hacer la carga de las opciones, eso depende de como lo tengáis. El archivo de opciones seria algo asi:

Código:
[AUDIO]
Musica=0
Sonido=1
FXSound=1
Ambient=0
VolMusica=0
VolAudio=-635
VolAmbient=-715
 
Última edición:
C

Crip

Invitado
#2
Oie tio tu eres el puto amo
@Lorwik Acuerdate que te di el archivo de las opciones.... Espero que logres arreglarlo...
 
Última edición por un moderador:

Shak

Policia malo
Miembro del equipo
Developer
Especialista de Argentum
#3
Mira que bien lorwik. Pero que diferencia tiene ? Para que no me ponga a leer ambos modulos, tenes ahi para anotar las diferencias entre un sonido y el otro? Además de la configuracion.. Algo de 3d diferente? Mejor hecho?
 

Lorwik

Destructor Lvl 3
Ex-Staff
#4
Mira que bien lorwik. Pero que diferencia tiene ? Para que no me ponga a leer ambos modulos, tenes ahi para anotar las diferencias entre un sonido y el otro? Además de la configuracion.. Algo de 3d diferente? Mejor hecho?
Algunas de las diferencias mas notables son.

- El 3D de AO solo se basa en que escuchas por la izquierda o por la derecha. Sin embargo el 3D de IAO ademas de escuchar por la izquierda por la derecha puedes oír los pasos según la distancia que se encuentran, por
ejemplo si estas en DV matando bichitos y alguien se acerca, puedes escuchar como se va acercando poco a poco.
- Ademas combina Midi y MP3, puedes elegir si tener solo midi o MP3 y también puedes combinarlo, por ejemplo puedes poner mapas con midi y mapas con MP3 y el engine detecta cual debe reproducir (esto es una pavada).
- El midi de AO se bugea y empieza a sonar muy raro.
- Tiene sonidos ambientales.
- Puedes invertir los canales L/R.

Y alguna cosa mas...
 

Lareo

Me Against The World
#7
Saben como arreglar los Checks de Habilitar y deshabilitar sonido o música? .Gracias xd
Dudo que puedas, tenes un mod compression? tenes los recursos necesarios comprimidos? ademas lorwik inicio mal el engine de sonido y lo cierra mal.. por eso el bug de memoria en los sonidos.

Saludos. Si necesitas recursos chifla!!
 

miqueas150

The Prophet
Ex-Staff
#8
y si tranquilamente puede poner para que lea los recursos de audio sueltos como vienen en ao por defecto, no hace falta el modcompresion o lo que sea

y tendrian que destruir el objeto publico que crea en el sub main en el closeclient...
 

Lareo

Me Against The World
#9
y si tranquilamente puede poner para que lea los recursos de audio sueltos como vienen en ao por defecto, no hace falta el modcompresion o lo que sea

y tendrian que destruir el objeto publico que crea en el sub main en el closeclient...
Nigga me hiciste acordar de que lo ponga como debe ser.

primero que nada busquen esto del sub main() y borrenlo

Código:
 If Sound.Initialize_Engine(frmMain.hwnd, App.Path & "\Recursos", App.Path & "\Recursos", App.Path & "\Recursos", False, (Opciones.Audio > 0), (Opciones.sMusica <> CONST_DESHABILITADA), Opciones.FXVolume, False, Opciones.InvertirSonido) Then
        'frmCargando.picLoad.Width = 300
    Else
        MsgBox "¡No se ha logrado iniciar el engine de DirectSound! Reinstale los últimos controladores de DirectX. No habrá soporte de audio en el juego.", vbCritical, "Advertencia"
        frmOpciones.Frame2.Enabled = False
    End If
despues..

busquen

Código:
Public Function InitTileEngine
y en ese mismo sub buscan
Código:
Call CargarFxs
y abajo de eso ponen

Código:
 If Sound.Initialize_Engine(frmMain.hwnd, App.path & "\Recursos", App.path & "\Recursos", App.path & "\Recursos", False, (Opciones.Audio > 0), (Opciones.sMusica <> CONST_DESHABILITADA), Opciones.FXVolume, False, Sound.InvertirSonido) Then
    'frmCargando.picLoad.Width = 300
Else
    MsgBox "¡No se ha logrado iniciar el engine de DirectSound! Reinstale los últimos controladores de DirectX desde www.imperiumao.com.ar. No habrá soporte de audio en el juego.", vbCritical, "Advertencia"
    'frmOpciones.Frame1(0).Enabled = False
End If
busquen en el sub main
Código:
Do While prgRun
y abajo de esto
Código:
Call ShowNextFrame(frmMain.Top, frmMain.Left, frmMain.MouseX, frmMain.MouseY)
meten esto
Código:
If (Opciones.sMusica <> CONST_DESHABILITADA) Then Call Sound.Sound_Render
y en el Sub ShowNextFrame

busquen esto
Código:
If EngineRun Then
y abajo de eso.
meten
Código:
If (Opciones.Audio = 1 Or Opciones.sMusica <> CONST_DESHABILITADA) Then Call Sound.Sound_Render
y en el closeclient donde destruye los objetos publicos ponen

Código:
Sound.Music_Stop
Sound.Sound_Stop_All
 Set Sound = Nothing
 

Lareo

Me Against The World
#13
Creo que falta Extract_File_Ex :p
Este es un engine de sonido editado por lorwik, te paso a explicar.
Este es el engine de sonido de IAO 1.4.
Y los ambients en el IAO 1.4 los lee desde los sounds.IAO no desde Ambient.IAO.
Osea lo modifico para que lea desde Ambient.IAO los sonidos ambientales y para lea los archivos .amb.
No se si me llego a explicar!
Es el de IAO 1.4. Pero le agrego la lectura de .AMB.. y Ambient.IAO.
PD: Y le limpio algunas cosas y lo adapto a AO.
 
Arriba