Baixei a engine + source pokemon baseada em eo 2.0 porém os mapas não carregam as músicas, alguém poderia ajudar a resolver isso ? Onde está grifado de preto é onde estava escrito Music.

Posta o link da engine pra darmos uma olhada mais a fundo no que pode ser

Código:

Option Explicit



Private Sub CheckCustomStats_Click()
EditPokemons(scrlPokeNum).Custom = CheckCustomStats.Value
End Sub

Private Sub Form_Load()
    Dim X As Long
    Dim Y As Long
    Dim i As Long
    txtName.text = Trim$(map.Name)
    txtUp.text = CStr(map.Up)
    txtDown.text = CStr(map.Down)
    txtLeft.text = CStr(map.Left)
    txtRight.text = CStr(map.Right)
    cmbMoral.ListIndex = map.Moral
    scrlMusic.Value = map.music
    txtBootMap.text = CStr(map.BootMap)
    txtBootX.text = CStr(map.BootX)
    txtBootY.text = CStr(map.BootY)

    For X = 1 To MAX_MAP_NPCS
        cmbNpc(X).AddItem "No NPC"
    Next

    For Y = 1 To MAX_NPCS
        For X = 1 To MAX_MAP_NPCS
            cmbNpc(X).AddItem Y & ": " & Trim$(NPC(Y).Name)
        Next
    Next

    For i = 1 To MAX_MAP_NPCS
        cmbNpc(i).ListIndex = map.NPC(i)
    Next

    lblMap.Caption = "Current map: " & GetPlayerMap(MyIndex)
    txtMaxX.text = map.MaxX
    txtMaxY.text = map.MaxY
    'POKEMON (GOLF)
    loadAllPokemons
    scrlPokeNum.Max = MAX_MAP_POKEMONS
    scrlPokemonDataNum.Max = MAX_POKEMONS
    loadPokemons (1)
End Sub

Private Sub scrlChance_Change()
Dim percent As Double
If scrlChance.Value = 0 Then
Else
percent = 1 / scrlChance.Value
percent = percent * 100
End If

lblChance.Caption = "Chance: 1 out of " & scrlChance.Value & "    (" & percent & "%)"
EditPokemons(scrlPokeNum).Chance = scrlChance.Value
End Sub

Sub loadAllPokemons()
Dim i As Long
For i = 1 To MAX_MAP_POKEMONS
EditPokemons(i) = map.Pokemon(i)
Next
End Sub

Private Sub scrlMusic_Change()
    lblMusic.Caption = CStr(scrlMusic.Value)
    'Call DirectMusic_PlayMidi(scrlMusic.Value, 1)
End Sub

Private Sub cmdOk_Click()
    Dim i As Long
    Dim sTemp As Long
    Dim X As Long, x2 As Long
    Dim Y As Long, y2 As Long
    Dim tempArr() As TileRec
    Dim a As Long
    If Not IsNumeric(txtMaxX.text) Then txtMaxX.text = map.MaxX
    If Val(txtMaxX.text) < MAX_MAPX Then txtMaxX.text = MAX_MAPX
    If Val(txtMaxX.text) > MAX_BYTE Then txtMaxX.text = MAX_BYTE
    If Not IsNumeric(txtMaxY.text) Then txtMaxY.text = map.MaxY
    If Val(txtMaxY.text) < MAX_MAPY Then txtMaxY.text = MAX_MAPY
    If Val(txtMaxY.text) > MAX_BYTE Then txtMaxY.text = MAX_BYTE

    With map
        .Name = Trim$(txtName.text)
        .Up = Val(txtUp.text)
        .Down = Val(txtDown.text)
        .Left = Val(txtLeft.text)
        .Right = Val(txtRight.text)
        .Moral = cmbMoral.ListIndex
        .music = scrlMusic.Value
        .BootMap = Val(txtBootMap.text)
        .BootX = Val(txtBootX.text)
        .BootY = Val(txtBootY.text)
        
        For i = 1 To MAX_MAP_NPCS
            If cmbNpc(i).ListIndex > 0 Then
                sTemp = InStr(1, Trim$(cmbNpc(i).text), ":", vbTextCompare)

                If Len(Trim$(cmbNpc(i).text)) = sTemp Then
                    cmbNpc(i).ListIndex = 0
                End If
            End If
        Next

        For i = 1 To MAX_MAP_NPCS
            .NPC(i) = cmbNpc(i).ListIndex
        Next
        
        For a = 1 To MAX_MAP_POKEMONS
        Select Case EditPokemons(a).Custom
        Case 0
        map.Pokemon(a).PokemonNumber = EditPokemons(a).PokemonNumber
        map.Pokemon(a).LevelFrom = EditPokemons(a).LevelFrom
        map.Pokemon(a).LevelTo = EditPokemons(a).LevelTo
        map.Pokemon(a).Custom = 0
        map.Pokemon(a).ATK = EditPokemons(a).ATK
        map.Pokemon(a).DEF = EditPokemons(a).DEF
        map.Pokemon(a).SPATK = EditPokemons(a).SPATK
        map.Pokemon(a).SPDEF = EditPokemons(a).SPDEF
        map.Pokemon(a).SPD = EditPokemons(a).ATK
        map.Pokemon(a).HP = EditPokemons(a).HP
        map.Pokemon(a).Chance = EditPokemons(a).Chance
        Case 1
        map.Pokemon(a) = EditPokemons(a)
        End Select
        Next
        
        
        
        ' set the data before changing it
        tempArr = map.Tile
        x2 = map.MaxX
        y2 = map.MaxY
        ' change the data
        .MaxX = Val(txtMaxX.text)
        .MaxY = Val(txtMaxY.text)
        ReDim map.Tile(0 To .MaxX, 0 To .MaxY)

        If x2 > .MaxX Then x2 = .MaxX
        If y2 > .MaxY Then y2 = .MaxY

        For X = 0 To x2
            For Y = 0 To y2
                .Tile(X, Y) = tempArr(X, Y)
            Next
        Next

        ClearTempTile
    End With

    Call UpdateDrawMapName
    Unload Me
End Sub

Private Sub cmdCancel_Click()
    Unload Me
End Sub

Private Sub scrlPokemonDataNum_Change()
lblpokenum.Caption = "Pokemon Number:" & scrlPokemonDataNum.Value
If scrlPokemonDataNum.Value = 0 Then
lblPokeName.Caption = "None"
Else
lblPokeName.Caption = Trim$(Pokemon(scrlPokemonDataNum.Value).Name)
End If

imgpoke.Picture = LoadPicture(App.Path & "\Data Files\graphics\pokemonsprites\" & scrlPokemonDataNum.Value & ".gif")
EditPokemons(scrlPokeNum.Value).PokemonNumber = scrlPokemonDataNum.Value
End Sub

Private Sub scrlPokeNum_Change()
Label3.Caption = "Pokemon:" & scrlPokeNum.Value
loadPokemons (scrlPokeNum.Value)
End Sub

Sub loadPokemons(ByVal pokeslot As Long)
With EditPokemons(pokeslot)
scrlPokemonDataNum.Value = .PokemonNumber
txtfrom.text = .LevelFrom
txtto.text = .LevelTo
If .Custom = 1 Then
CheckCustomStats.Value = 1
Else
CheckCustomStats.Value = 0
End If
txtAtk.text = .ATK
txtDef.text = .DEF
txtSpAtk.text = .SPATK
txtSpDef.text = .SPDEF
txtSpd.text = .SPD
txtHP.text = .HP
scrlChance.Value = .Chance
imgpoke.Picture = LoadPicture(App.Path & "\Data Files\graphics\pokemonsprites\" & .PokemonNumber & ".gif")

End With


End Sub

Private Sub txtAtk_Change()
EditPokemons(scrlPokeNum).ATK = Val(txtAtk.text)
End Sub

Private Sub txtDef_Change()
EditPokemons(scrlPokeNum).DEF = Val(txtDef.text)
End Sub

Private Sub txtfrom_Change()
EditPokemons(scrlPokeNum).LevelFrom = Val(txtfrom.text)
End Sub

Private Sub txtHP_Change()
EditPokemons(scrlPokeNum).HP = Val(txtHP.text)
End Sub

Private Sub txtSpAtk_Change()
EditPokemons(scrlPokeNum).SPATK = Val(txtSpAtk.text)
End Sub

Private Sub txtSpd_Change()
EditPokemons(scrlPokeNum).SPD = Val(txtSpd.text)
End Sub

Private Sub txtSpDef_Change()
EditPokemons(scrlPokeNum).SPDEF = Val(txtSpDef.text)
End Sub

Private Sub txtto_Change()
EditPokemons(scrlPokeNum).LevelTo = Val(txtto.text)
End Sub


 Esse é meu frmMapProperties

Código:



Public Performance As DirectMusicPerformance
Public Segment As DirectMusicSegment
Public Loader As DirectMusicLoader

Public DS As DirectSound

Public Const SOUND_BUFFERS = 50

Private Type BufferCaps
    Volume As Boolean
    Frequency As Boolean
    Pan As Boolean
End Type

Private Type SoundArray
    DSBuffer As DirectSoundBuffer
    DSCaps As BufferCaps
    DSSourceName As String
End Type

Private Sound(1 To SOUND_BUFFERS) As SoundArray

' Contains the current sound index.
Public SoundIndex As Long

Public Music_On As Boolean
Public Music_Playing As String

Public Sound_On As Boolean
Private SEngineRestart As Boolean

Private Const DefaultVolume As Long = 100

Public Sub InitMusic()

    Set Loader = DX7.DirectMusicLoaderCreate
    Set Performance = DX7.DirectMusicPerformanceCreate
  
    Performance.Init Nothing, frmMainGame.hwnd
    Performance.SetPort -1, 80
  
    ' adjust volume 0-100
    Performance.SetMasterVolume DefaultVolume * 42 - 3000
    Performance.SetMasterAutoDownload True
  
End Sub

Public Sub InitSound()

    'Make the DirectSound object
    Set DS = DX7.DirectSoundCreate(vbNullString)
  
    'Set the DirectSound object's cooperative level (Priority gives us sole control)
    DS.SetCooperativeLevel frmMainGame.hwnd, DSSCL_PRIORITY
  
End Sub

Private Function GetState(ByVal Index As Integer) As String
    'Returns the current state of the given sound
    GetState = Sound(Index).DSBuffer.GetStatus
End Function

Public Sub SoundStop(ByVal Index As Integer)

    'Stop the buffer and reset to the beginning
    Sound(Index).DSBuffer.Stop
    Sound(Index).DSBuffer.SetCurrentPosition 0
  
End Sub

Private Sub SoundLoad(ByVal file As String)
Dim DSBufferDescription As DSBUFFERDESC
Dim DSFormat As WAVEFORMATEX

    ' Set the sound index one higher for each sound.
    SoundIndex = SoundIndex + 1
  
    ' Reset the sound array if the array height is reached.
    If SoundIndex > UBound(Sound) Then
        SEngineRestart = True
        SoundIndex = 1
    End If
  
    ' Remove the sound if it exists (needed for re-loop).
    If SEngineRestart Then
        If GetState(SoundIndex) = DSBSTATUS_PLAYING Then
            SoundStop SoundIndex
            SoundRemove SoundIndex
        End If
    End If
  
    ' Load the sound array with the data given.
    With Sound(SoundIndex)
        .DSSourceName = file            'What is the name of the source?
        .DSCaps.Pan = True              'Is this sound to have Left and Right panning capabilities?
        .DSCaps.Volume = True           'Is this sound capable of altered volume settings?
    End With
  
    'Set the buffer description according to the data provided
    With DSBufferDescription
        If Sound(SoundIndex).DSCaps.Pan Then
            .lFlags = .lFlags Or DSBCAPS_CTRLPAN
        End If
        If Sound(SoundIndex).DSCaps.Volume Then
            .lFlags = .lFlags Or DSBCAPS_CTRLVOLUME
        End If
    End With
  
    'Set the Wave Format
    With DSFormat
        .nFormatTag = WAVE_FORMAT_PCM
        .nChannels = 2
        .lSamplesPerSec = 22050
        .nBitsPerSample = 16
        .nBlockAlign = .nBitsPerSample / 8 * .nChannels
        .lAvgBytesPerSec = .lSamplesPerSec * .nBlockAlign
    End With
  
    Set Sound(SoundIndex).DSBuffer = DS.CreateSoundBufferFromFile(App.Path & SOUND_PATH & Sound(SoundIndex).DSSourceName, DSBufferDescription, DSFormat)
  
End Sub

Public Sub SoundRemove(ByVal Index As Integer)
    'Reset all the variables in the sound array
    With Sound(Index)
        Set .DSBuffer = Nothing
        .DSCaps.Frequency = False
        .DSCaps.Pan = False
        .DSCaps.Volume = False
        .DSSourceName = vbNullString
    End With
End Sub

Private Sub SetVolume(ByVal Index As Integer, ByVal Vol As Long)
    'Check to make sure that the buffer has the capability of altering its volume
    If Not Sound(Index).DSCaps.Volume Then Exit Sub

    'Alter the volume according to the Vol provided
    If Vol > 0 Then
        Sound(Index).DSBuffer.SetVolume (60 * Vol) - 6000
    Else
        Sound(Index).DSBuffer.SetVolume -6000
    End If
End Sub

Private Sub SetPan(ByVal Index As Integer, ByVal Pan As Long)
    'Check to make sure that the buffer has the capability of altering its pan
    If Not Sound(Index).DSCaps.Pan Then Exit Sub

    'Alter the pan according to the pan provided
    Select Case Pan
        Case 0
            Sound(Index).DSBuffer.SetPan -10000
        Case 100
            Sound(Index).DSBuffer.SetPan 10000
        Case Else
            Sound(Index).DSBuffer.SetPan (100 * Pan) - 5000
    End Select
End Sub

Public Sub PlayMidi(ByVal FileName As String, ByVal repeats As Long)
Dim Splitmusic() As String

    Splitmusic = Split(FileName, ".", , vbTextCompare)
  
    If Performance Is Nothing Then Exit Sub
    If LenB(Trim$(FileName)) < 1 Then Exit Sub
    If UBound(Splitmusic) <> 1 Then Exit Sub
    If Splitmusic(1) <> "mid" Then Exit Sub
    If Not FileExist(App.Path & MUSIC_PATH & FileName, True) Then Exit Sub
  
    If Not Music_On Then Exit Sub
  
    If Music_Playing = FileName Then Exit Sub
  
    Set Segment = Nothing
    Set Segment = Loader.LoadSegment(App.Path & MUSIC_PATH & FileName)
  
    ' repeat midi file
    Segment.SetLoopPoints 0, 0
    Segment.SetRepeats 100
    Segment.SetStandardMidiFile
  
    Performance.PlaySegment Segment, 0, 0
  
    Music_Playing = FileName
  
End Sub

Public Sub StopMidi()
    If Not (Performance Is Nothing) Then Performance.Stop Segment, Nothing, 0, 0
    Music_Playing = vbNullString
End Sub

Public Sub PlaySound(ByVal file As String, Optional ByVal Volume As Long = 100, Optional ByVal Pan As Long = 50)
    
    ' Check to see if DirectSound was successfully initalized.
    If Not Sound_On Or Not FileExist(App.Path & SOUND_PATH & file, True) Then Exit Sub
    
    If Options.PlayMusic = 0 Then
    If file = "Choose.wav" Then
    Else
    Exit Sub
    End If
    End If
    
    ' Loads our sound into memory.
    SoundLoad file
  
    ' Sets the volume for the sound.
    SetVolume SoundIndex, Volume
  
    ' Sets the pan for the sound.
    SetPan SoundIndex, Pan
  
    ' Play the sound.
    
    Sound(SoundIndex).DSBuffer.Play DSBPLAY_DEFAULT
    
End Sub

Function GetSoundPosition(ByVal Index As Long) As Long
Dim curr As DSCURSORS

GetSoundPosition = curr.lWrite
End Function

Public Sub PlayMusic(ByVal file As String)
PlaySound file
MusicIndex = SoundIndex
End Sub

Public Sub StopMusic()
Call SoundStop(MusicIndex)
End Sub



E esse meu modSound

Código:

Dim PlayerIsPlaying As Boolean  'determine when the player is playing
Dim Player As FilgraphManager  'Reference to our player
Dim PlayerPos As IMediaPosition 'Reference to determine media position
Dim PlayerAU As IBasicAudio    'Reference to determine Audio Volume
Dim i As Integer                'Icon index
Sub GoranPlay(ByVal file As String)
If Options.PlayMusic = 0 Then Exit Sub 'Music isnt allowed :/
Dim CurState As Long
 'check player
 If Not Player Is Nothing Then
    'Get the state
    Player.GetState X, CurState
     
    If CurState = 1 Then
      PausePlay
      Exit Sub
    End If
 End If
 
 StartPlay (file) 'Start playing the file

End Sub

Sub PlayMapMusic(ByVal music As String)
StopPlay
If FileExist(App.Path & "\Data Files\music\" & music, True) And InMapEditor = False Then
GoranPlay (App.Path & "\Data Files\music\" & music)
End If
End Sub

Sub StartPlay(ByVal file As String)

On Error GoTo error                  'Handle Error
  'Set objects
  Set Player = New FilgraphManager  'Player
  Set PlayerPos = Player            'Position
  Set PlayerAU = Player              'Volume
 
  Player.RenderFile file  'Load file
  Player.Run                        'Run player
 
  PlayerIsPlaying = True 'We are playing
  If Not Player Is Nothing Then
    'if g_objMediaControl has been assigned

      'PlayerAU.Volume = GetVolume

    End If


Exit Sub
error:                                'Handle error
StopPlay                            'Stop player
End Sub

Function GetPlayerDuration() As Long
On Error Resume Next
GetPlayerDuration = PlayerPos.Duration
End Function

Function GetPlayerPosition() As Long
On Error Resume Next
GetPlayerPosition = PlayerPos.CurrentPosition
End Function

Function IsMusicOver() As Boolean
If GetPlayerPosition >= GetPlayerDuration Then
IsMusicOver = True
End If
End Function

Sub StopPlay()

  If Player Is Nothing Then Exit Sub 'Not playing nothing to stop!
          'No timer after stop
 
  'Stop playing
  Player.Stop
  'Set time and status label
 
   
End Sub

Sub PausePlay()
 
Static Paused As Boolean                'If paused
Dim CurState As Long                    'Current state of the player

  If Player Is Nothing Then Exit Sub    'Not playing nothing to pause!
   
    'Get player state
    Player.GetState X, CurState
   
    If CurState = 2 Then
      'Is playing, pause it
      Paused = True
      Player.Pause
     
    Else
      'Is paused, run again
      Paused = False
      Player.Run
     
    End If
   
End Sub



 Esse é um mod que está adicionado também e aparece no meu VB6 modGoranSound

Sua engine usa a Quarts Dll.

Feita na base do Goran /o/ Um gringo que faz muitos códigos "errados".......

O Código todo de transição e inicio das musicas teriam de ser debugados para saber o que está passando... 

A solução seria buscar suporte de alguém que possa entrar em Conferencia para ajudar ou postar a sourcer para que alguem possa fazer a correção e lhe repassar.

Alguém aí faria isso? Tem algumas coisas que quero modificar no jogo e tirar alguns bugs. Posso pagar pelo serviço.

Posso lhe prestar auxilio em algumas correções. 

Me contate pelo Pm enviando alguma maneira de falar com você mais fácil,seja discord, face ou zap.

Apos consertamos você posta a solução achada para a aldeia ;3

Att