Sistema de Voar Completo!

Nome: Sistema Voar Completo
Nivel de Dificuldade : 5/5
Utiliza: VisualBasic 6.0

Como funciona : Ao apertar F2, Seu player começa a voar. Ultrapassa tudo, não pega item no solo, não ataca Npc's no solo e também não ataca Players que não esteja voando como você.

Server ~ Side

No ModDatabase, Na Sub AddChar procure por :

Código:

Player(Index).Char(CharNum).Level = 1

Abaixo adicione :

Código:

Player(Index).Char(CharNum).Voar = 0

No ModGameLogic, Procure por :

Código:

Function CanAttackNpc(ByVal Attacker As Long, ByVal MapNpcNum As Long) As Boolean

Substitua a Function toda por :

Código:

Function CanAttackNpc(ByVal Attacker As Long, ByVal MapNpcNum As Long) As Boolean
    Dim MapNum As Long, NpcNum As Long
    Dim AttackSpeed As Long
    Dim x As Long
    Dim y As Long

    If GetPlayerWeaponSlot(Attacker) > 0 Then
        AttackSpeed = Item(GetPlayerInvItemNum(Attacker, GetPlayerWeaponSlot(Attacker))).AttackSpeed
    Else
        AttackSpeed = 0
    End If

    CanAttackNpc = False

    ' Checar por subscript out of range
    If IsPlaying(Attacker) = False Or MapNpcNum <= 0 Or MapNpcNum > MAX_MAP_NPCS Then
        Exit Function
    End If

    ' Checar por subscript out of range (de novo? aff)
    If MapNpc(GetPlayerMap(Attacker), MapNpcNum).num <= 0 Then
        Exit Function
    End If
   
    ' Checar se está voando
    If GetPlayerVoar(Attacker) = 1 Then
    Exit Function
    End If

    MapNum = GetPlayerMap(Attacker)
    NpcNum = MapNpc(MapNum, MapNpcNum).num

    ' Ter certeza que o npc não morreu
    If MapNpc(MapNum, MapNpcNum).HP <= 0 Then
        Exit Function
    End If

    ' Ter certeza que estão no mesmo mapa
    If IsPlaying(Attacker) Then
        If NpcNum > 0 And GetTickCount > Player(Attacker).AttackTimer + AttackSpeed Then

            ' Check if at same coordinates
            x = DirToX(GetPlayerX(Attacker), GetPlayerDir(Attacker))
            y = DirToY(GetPlayerY(Attacker), GetPlayerDir(Attacker))

            If (MapNpc(MapNum, MapNpcNum).y = y) And (MapNpc(MapNum, MapNpcNum).x = x) Then
                If Npc(NpcNum).Behavior <> NPC_BEHAVIOR_FRIENDLY And Npc(NpcNum).Behavior <> NPC_BEHAVIOR_SHOPKEEPER Then
                    CanAttackNpc = True
                Else

                    If Trim$(Npc(NpcNum).AttackSay) <> vbNullString Then
                        Call PlayerMsg(Attacker, Trim$(Npc(NpcNum).Name) & " : " & Trim$(Npc(NpcNum).AttackSay), Green)
                    End If

                    If Npc(NpcNum).Speech <> 0 Then
                        Call SendDataTo(Attacker, "STARTSPEECH" & SEP_CHAR & Npc(NpcNum).Speech & SEP_CHAR & 0 & SEP_CHAR & NpcNum & END_CHAR)
                    End If
                End If
            End If
        End If
    End If

End Function

Agora procure por :

Código:

Function CanAttackNpcWithArrow(ByVal Attacker As Long, ByVal MapNpcNum As Long) As Boolean

E substitua a Function toda por :

Código:

Function CanAttackNpcWithArrow(ByVal Attacker As Long, ByVal MapNpcNum As Long) As Boolean
    Dim MapNum As Long, NpcNum As Long
    Dim AttackSpeed As Long
    Dim Dir As Long

    If GetPlayerWeaponSlot(Attacker) > 0 Then
        AttackSpeed = Item(GetPlayerInvItemNum(Attacker, GetPlayerWeaponSlot(Attacker))).AttackSpeed
    Else
        AttackSpeed = 0
    End If

    CanAttackNpcWithArrow = False

    ' Checar por subscript out of range
    If IsPlaying(Attacker) = False Or MapNpcNum <= 0 Or MapNpcNum > MAX_MAP_NPCS Then
        Exit Function
    End If

    ' Checar se está voando
    If GetPlayerVoar(Attacker) = 1 Then
    Exit Function
    End If

    ' Checar por subscript out of range
    If MapNpc(GetPlayerMap(Attacker), MapNpcNum).num <= 0 Then
        Exit Function
    End If

    MapNum = GetPlayerMap(Attacker)
    NpcNum = MapNpc(MapNum, MapNpcNum).num

    ' Ter certeza que o NPC não morreu
    If MapNpc(MapNum, MapNpcNum).HP <= 0 Then
        Exit Function
    End If

    ' Ter certeza que estão no mesmo mapa
    If IsPlaying(Attacker) Then
        If NpcNum > 0 And GetTickCount > Player(Attacker).AttackTimer + AttackSpeed Then
            If Npc(NpcNum).Behavior <> NPC_BEHAVIOR_FRIENDLY And Npc(NpcNum).Behavior <> NPC_BEHAVIOR_SHOPKEEPER Then
                CanAttackNpcWithArrow = True
            Else

                If Trim$(Npc(NpcNum).AttackSay) <> vbNullString Then
                    Call PlayerMsg(Attacker, Trim$(Npc(NpcNum).Name) & " : " & Trim$(Npc(NpcNum).AttackSay), Green)
                End If

                If Npc(NpcNum).Speech <> 0 Then

                    For Dir = 0 To 3

                        If DirToX(GetPlayerX(Attacker), Dir) = MapNpc(MapNum, MapNpcNum).x And DirToY(GetPlayerY(Attacker), Dir) = MapNpc(MapNum, MapNpcNum).y Then
                            Call SendDataTo(Attacker, "STARTSPEECH" & SEP_CHAR & Npc(NpcNum).Speech & SEP_CHAR & 0 & SEP_CHAR & NpcNum & END_CHAR)
                        End If

                    Next Dir

                End If
            End If
        End If
    End If

End Function

Agora Procure por :

Código:

Function CanAttackPlayer(ByVal Attacker As Long, ByVal Victim As Long) As Boolean

Substitua a Function toda por :

Código:

Function CanAttackPlayer(ByVal Attacker As Long, ByVal Victim As Long) As Boolean
    Dim AttackSpeed As Long
    Dim x As Long
    Dim y As Long

    If GetPlayerWeaponSlot(Attacker) > 0 Then
        AttackSpeed = Item(GetPlayerInvItemNum(Attacker, GetPlayerWeaponSlot(Attacker))).AttackSpeed
    Else
        AttackSpeed = 0
    End If

    CanAttackPlayer = False

    ' Checar por Subscript out of range
    If IsPlaying(Attacker) = False Or IsPlaying(Victim) = False Then
        Exit Function
    End If

    ' Ter certeza que não tem 0 de HP
    If GetPlayerHP(Victim) <= 0 Then
        Exit Function
    End If

    ' Ter certeza que não estamos atacando enquanto ele troca de mapa
    If Player(Victim).GettingMap = YES Then
        Exit Function
    End If
   
    ' Ter certeza que os 2 estão voando ou não
    If GetPlayerVoar(Attacker) <> GetPlayerVoar(Victim) Then
    Exit Function
    End If

    ' Ter certeza que estão no mesmo mapa
    If (GetPlayerMap(Attacker) = GetPlayerMap(Victim)) And (GetTickCount > Player(Attacker).AttackTimer + AttackSpeed) Then
        x = DirToX(GetPlayerX(Attacker), GetPlayerDir(Attacker))
        y = DirToY(GetPlayerY(Attacker), GetPlayerDir(Attacker))

        If (GetPlayerY(Victim) = y) And (GetPlayerX(Victim) = x) Then
            If Map(GetPlayerMap(Victim)).Tile(x, y).Type <> TILE_TYPE_ARENA And Map(GetPlayerMap(Attacker)).Tile(GetPlayerX(Attacker), GetPlayerY(Attacker)).Type <> TILE_TYPE_ARENA Then

                ' Ter certeza que eles não tem acesso
                If GetPlayerAccess(Attacker) > ADMIN_MONITER Then
                    Call PlayerMsg(Attacker, "Você não pode atacar um jogador sendo um administrador!", BrightBlue)
                Else

                    ' Checar se a vitima não é um administrador
                    If GetPlayerAccess(Victim) > ADMIN_MONITER Then
                        Call PlayerMsg(Attacker, "Você não pode atacar " & GetPlayerName(Victim) & "!", BrightRed)
                    Else

                        ' Checar se o mapa é atacavel
                        If Map(GetPlayerMap(Attacker)).Moral = MAP_MORAL_NONE Or Map(GetPlayerMap(Attacker)).Moral = MAP_MORAL_NO_PENALTY Or GetPlayerPK(Victim) = YES Then

                            ' Ter certeza que se possui level suficiente
                            If GetPlayerLevel(Attacker) < 10 Then
                                Call PlayerMsg(Attacker, "Você está abaixo do nível 10, portanto, você não pode atacar um jogador!", BrightRed)
                            Else

                                If GetPlayerLevel(Victim) < 10 Then
                                    Call PlayerMsg(Attacker, GetPlayerName(Victim) & " está abaixo do nível 10, portanto não pode ser atacado!", BrightRed)
                                Else

                                    If Trim$(GetPlayerGuild(Attacker)) <> vbNullString And GetPlayerGuild(Victim) <> vbNullString Then
                                        If Trim$(GetPlayerGuild(Attacker)) <> Trim$(GetPlayerGuild(Victim)) Then
                                            CanAttackPlayer = True
                                        Else
                                            Call PlayerMsg(Attacker, "Você não pode atacar um jogador do seu clã!", BrightRed)
                                        End If

                                    Else
                                        CanAttackPlayer = True
                                    End If
                                End If
                            End If

                        Else
                            Call PlayerMsg(Attacker, "Esta é uma zona segura!", BrightRed)
                        End If
                    End If
                End If

            ElseIf Map(GetPlayerMap(Victim)).Tile(x, y).Type = TILE_TYPE_ARENA And Map(GetPlayerMap(Attacker)).Tile(GetPlayerX(Attacker), GetPlayerY(Attacker)).Type = TILE_TYPE_ARENA Then
                CanAttackPlayer = True
            End If
        End If
    End If

End Function

Agora procure por :

Código:

Function CanAttackPlayerWithArrow(ByVal Attacker As Long, ByVal Victim As Long) As Boolean

Substitua a Function toda por :

Código:

Function CanAttackPlayerWithArrow(ByVal Attacker As Long, ByVal Victim As Long) As Boolean
    CanAttackPlayerWithArrow = False

    ' Checar por subscript of range
    If IsPlaying(Attacker) = False Or IsPlaying(Victim) = False Then
        Exit Function
    End If

    ' Ter certeza que não se tem menos de 0 HP
    If GetPlayerHP(Victim) <= 0 Then
        Exit Function
    End If

    ' Ter certeza que não estão atacando o jogador se ele está trocando de mapas
    If Player(Victim).GettingMap = YES Then
        Exit Function
    End If

    ' Ter certeza que os 2 estão voando ou não
    If GetPlayerVoar(Attacker) <> GetPlayerVoar(Victim) Then
    Exit Function
    End If

    ' Ter certeza que estão no mesmo mapa.
    If GetPlayerMap(Attacker) = GetPlayerMap(Victim) Then
        If Map(GetPlayerMap(Victim)).Tile(GetPlayerX(Victim), GetPlayerY(Victim)).Type <> TILE_TYPE_ARENA And Map(GetPlayerMap(Attacker)).Tile(GetPlayerX(Attacker), GetPlayerY(Attacker)).Type <> TILE_TYPE_ARENA Then

            ' Ter certeza quanto ao acesso
            If GetPlayerAccess(Attacker) > ADMIN_MONITER Then
                Call PlayerMsg(Attacker, "Você não pode atacar um jogador sendo um administrador!", BrightBlue)
            Else

                ' Check to make sure the victim isn't an admin
                If GetPlayerAccess(Victim) > ADMIN_MONITER Then
                    Call PlayerMsg(Attacker, "Você não pode atacar " & GetPlayerName(Victim) & "!", BrightRed)
                Else

                    ' Check if map is attackable
                    If Map(GetPlayerMap(Attacker)).Moral = MAP_MORAL_NONE Or Map(GetPlayerMap(Attacker)).Moral = MAP_MORAL_NO_PENALTY Or GetPlayerPK(Victim) = YES Then

                        ' Make sure they are high enough level
                        If GetPlayerLevel(Attacker) < 10 Then
                            Call PlayerMsg(Attacker, "Você está abaixo do nível 10, portanto, você não pode atacar um jogador!", BrightRed)
                        Else

                            If GetPlayerLevel(Victim) < 10 Then
                                Call PlayerMsg(Attacker, GetPlayerName(Victim) & " está abaixo do nível 10, portanto não pode ser atacado!", BrightRed)
                            Else

                                If Trim$(GetPlayerGuild(Attacker)) <> vbNullString And GetPlayerGuild(Victim) <> vbNullString Then
                                    If Trim$(GetPlayerGuild(Attacker)) <> Trim$(GetPlayerGuild(Victim)) Then
                                        CanAttackPlayerWithArrow = True
                                    Else
                                        Call PlayerMsg(Attacker, "Você não pode atacar um jogador do seu clã!", BrightRed)
                                    End If

                                Else
                                    CanAttackPlayerWithArrow = True
                                End If
                            End If
                        End If

                    Else
                        Call PlayerMsg(Attacker, "Esta é uma zona segura!", BrightRed)
                    End If
                End If
            End If

        ElseIf Map(GetPlayerMap(Victim)).Tile(GetPlayerX(Victim), GetPlayerY(Victim)).Type = TILE_TYPE_ARENA And Map(GetPlayerMap(Attacker)).Tile(GetPlayerX(Attacker), GetPlayerY(Attacker)).Type = TILE_TYPE_ARENA Then
            CanAttackPlayerWithArrow = True
        End If
    End If

End Function

Agora Procure por :

Código:

Function CanNpcAttackPlayer(ByVal MapNpcNum As Long, ByVal Index As Long) As Boolean

Substitua a Function por :

Código:

Function CanNpcAttackPlayer(ByVal MapNpcNum As Long, ByVal Index As Long) As Boolean
    Dim MapNum As Long, NpcNum As Long
    Dim x As Long
    Dim y As Long

    CanNpcAttackPlayer = False

    ' Checar por subscript of range
    If MapNpcNum <= 0 Or MapNpcNum > MAX_MAP_NPCS Or IsPlaying(Index) = False Then
        Exit Function
    End If

    ' Checar por subscript of range
    If MapNpc(GetPlayerMap(Index), MapNpcNum).num <= 0 Then
        Exit Function
    End If

    MapNum = GetPlayerMap(Index)
    NpcNum = MapNpc(MapNum, MapNpcNum).num

    ' Ter certeza que o NPC morreu
    If MapNpc(MapNum, MapNpcNum).HP <= 0 Then
        Exit Function
    End If

    ' Ter certeza que os npcs não vão atacar mais de uma vez por segundo
    If GetTickCount < MapNpc(MapNum, MapNpcNum).AttackTimer + 1000 Then
        Exit Function
    End If

    ' Ter certeza que não se está trocando os mapas
    If Player(Index).GettingMap = YES Then
        Exit Function
    End If
   
    ' Ter certeza que o player não está voando
    If GetPlayerVoar(Index) = 1 Then
    Exit Function
    End If

    MapNpc(MapNum, MapNpcNum).AttackTimer = GetTickCount

    ' Ter certeza que está no mesmo mapa
    If IsPlaying(Index) Then
        If NpcNum > 0 Then
            x = DirToX(MapNpc(MapNum, MapNpcNum).x, MapNpc(MapNum, MapNpcNum).Dir)
            y = DirToY(MapNpc(MapNum, MapNpcNum).y, MapNpc(MapNum, MapNpcNum).Dir)

            ' Checar as coordenadas
            If (GetPlayerY(Index) = y) And (GetPlayerX(Index) = x) Then
                CanNpcAttackPlayer = True
            End If
        End If
    End If

End Function

Agora procure por :

Código:

Sub PlayerMove(ByVal Index As Long, _
  ByVal Dir As Long, _
  ByVal Movement As Long)

Substitua a Sub toda por :

Código:

Sub PlayerMove(ByVal Index As Long, _
  ByVal Dir As Long, _
  ByVal Movement As Long)
    Dim Packet As String
    Dim MapNum As Long
    Dim x As Long
    Dim y As Long
    Dim oldx As Long
    Dim oldy As Long
    Dim OldMap As Long
    Dim Moved As Byte

    ' Tentaram nos hackear!!!! =/
    'If Moved = NO Then
    'Call HackingAttempt(index, "Modificação de Posição")
    'Exit Sub
    'End If
    ' Checar por subscript out of range
    If IsPlaying(Index) = False Or Dir < DIR_UP Or Dir > DIR_RIGHT Or Movement < 1 Or Movement > 2 Then
        Exit Sub
    End If

    Call SetPlayerDir(Index, Dir)
    Moved = NO
    x = DirToX(GetPlayerX(Index), Dir)
    y = DirToY(GetPlayerY(Index), Dir)
    Call TakeFromGrid(GetPlayerMap(Index), GetPlayerX(Index), GetPlayerY(Index))

    ' Mover o pet do jogador se precisar
    If Player(Index).Pet.Alive = YES Then
        If Player(Index).Pet.Map = GetPlayerMap(Index) And Player(Index).Pet.x = x And Player(Index).Pet.y = y Then
            If Grid(GetPlayerMap(Index)).Loc(DirToX(x, Dir), DirToY(y, Dir)).Blocked = False Then
                Call UpdateGrid(Player(Index).Pet.Map, Player(Index).Pet.x, Player(Index).Pet.y, Player(Index).Pet.Map, DirToX(x, Dir), DirToY(y, Dir))
                Player(Index).Pet.y = DirToY(y, Dir)
                Player(Index).Pet.x = DirToX(x, Dir)
                Packet = "PETMOVE" & SEP_CHAR & Index & SEP_CHAR & DirToX(x, Dir) & SEP_CHAR & DirToY(y, Dir) & SEP_CHAR & Dir & SEP_CHAR & Movement & END_CHAR
                Call SendDataToMap(Player(Index).Pet.Map, Packet)
            End If
        End If
    End If

    ' Checar por boundries (WTF?)
    If IsValid(x, y) Then

            ' Ter certeza se a tile requer uma chave e se está aberta
            If (Map(GetPlayerMap(Index)).Tile(x, y).Type <> TILE_TYPE_KEY Or Map(GetPlayerMap(Index)).Tile(x, y).Type <> TILE_TYPE_DOOR) Or ((Map(GetPlayerMap(Index)).Tile(x, y).Type = TILE_TYPE_DOOR Or Map(GetPlayerMap(Index)).Tile(x, y).Type = TILE_TYPE_KEY) And TempTile(GetPlayerMap(Index)).DoorOpen(x, y) = YES) Then
                Call SetPlayerX(Index, x)
                Call SetPlayerY(Index, y)
                Packet = "PLAYERMOVE" & SEP_CHAR & Index & SEP_CHAR & x & SEP_CHAR & y & SEP_CHAR & Dir & SEP_CHAR & Movement & END_CHAR
                Call SendDataToMapBut(Index, GetPlayerMap(Index), Packet)
                Moved = YES
            End If
    Else

        ' Checar para ver se podemos move-la para outro mapa
        If Map(GetPlayerMap(Index)).Up > 0 And Dir = DIR_UP Then
            Call PlayerWarp(Index, Map(GetPlayerMap(Index)).Up, GetPlayerX(Index), MAX_MAPY)
            Moved = YES
        End If

        If Map(GetPlayerMap(Index)).Down > 0 And Dir = DIR_DOWN Then
            Call PlayerWarp(Index, Map(GetPlayerMap(Index)).Down, GetPlayerX(Index), 0)
            Moved = YES
        End If

        If Map(GetPlayerMap(Index)).Left > 0 And Dir = DIR_LEFT Then
            Call PlayerWarp(Index, Map(GetPlayerMap(Index)).Left, MAX_MAPX, GetPlayerY(Index))
            Moved = YES
        End If

        If Map(GetPlayerMap(Index)).Right > 0 And Dir = DIR_RIGHT Then
            Call PlayerWarp(Index, Map(GetPlayerMap(Index)).Right, 0, GetPlayerY(Index))
            Moved = YES
        End If
    End If

    If Moved = NO Then Call SendPlayerXY(Index)
    If GetPlayerX(Index) < 0 Or GetPlayerY(Index) < 0 Or GetPlayerX(Index) > MAX_MAPX Or GetPlayerY(Index) > MAX_MAPY Or GetPlayerMap(Index) <= 0 Then
        Call HackingAttempt(Index, vbNullString)
        Exit Sub
    End If

    ' Código das tiles que recuperam
    If Map(GetPlayerMap(Index)).Tile(GetPlayerX(Index), GetPlayerY(Index)).Type = TILE_TYPE_HEAL Then
        If GetPlayerHP(Index) < GetPlayerMaxHP(Index) Then
        If GetPlayerVoar(Index) = 0 Then
            Call SetPlayerHP(Index, GetPlayerMaxHP(Index))
            Call SendHP(Index)
            Call PlayerMsg(Index, "Você sente uma rejuvenação no seu corpo!", BrightGreen)
        End If
    End If
    End If

    'Check for kill tile, and if so kill them
    If Map(GetPlayerMap(Index)).Tile(GetPlayerX(Index), GetPlayerY(Index)).Type = TILE_TYPE_KILL Then
    If GetPlayerVoar(Index) = 0 Then
        Call SetPlayerHP(Index, 0)
        Call PlayerMsg(Index, "Você sente calafrios, pois a morte se aproxima. Nada pôde ser feito, agora você está morto.", BrightRed)

        ' Teleportar jogador
        If SCRIPTING = 1 Then
            MyScript.ExecuteStatement "Scripts\Principal.txt", "OnDeath " & Index
        Else
            Call PlayerWarp(Index, START_MAP, START_X, START_Y)
        End If

        Call SetPlayerHP(Index, GetPlayerMaxHP(Index))
        Call SetPlayerMP(Index, GetPlayerMaxMP(Index))
        Call SetPlayerSP(Index, GetPlayerMaxSP(Index))
        Call SendHP(Index)
        Call SendMP(Index)
        Call SendSP(Index)
        Moved = YES
    End If
    End If

    If IsValid(x, y) Then
    If GetPlayerVoar(Index) = 0 Then
        If Map(GetPlayerMap(Index)).Tile(x, y).Type = TILE_TYPE_DOOR Then
            If TempTile(GetPlayerMap(Index)).DoorOpen(x, y) = NO Then
                TempTile(GetPlayerMap(Index)).DoorOpen(x, y) = YES
                TempTile(GetPlayerMap(Index)).DoorTimer = GetTickCount
                Call SendDataToMap(GetPlayerMap(Index), "MAPKEY" & SEP_CHAR & x & SEP_CHAR & y & SEP_CHAR & 1 & END_CHAR)
                Call SendDataToMap(GetPlayerMap(Index), "sound" & SEP_CHAR & "Chave" & END_CHAR)
            End If
        End If
    End If
    End If

    ' Checar quanto às warp tiles
    If GetPlayerVoar(Index) = 0 Then
    If Map(GetPlayerMap(Index)).Tile(GetPlayerX(Index), GetPlayerY(Index)).Type = TILE_TYPE_WARP Then
        MapNum = Map(GetPlayerMap(Index)).Tile(GetPlayerX(Index), GetPlayerY(Index)).Data1
        x = Map(GetPlayerMap(Index)).Tile(GetPlayerX(Index), GetPlayerY(Index)).Data2
        y = Map(GetPlayerMap(Index)).Tile(GetPlayerX(Index), GetPlayerY(Index)).Data3
        Call PlayerWarp(Index, MapNum, x, y)
        Moved = YES
    End If
   
    Call AddToGrid(GetPlayerMap(Index), GetPlayerX(Index), GetPlayerY(Index))
    End If

    ' Checar pela Chave
    If GetPlayerVoar(Index) = 0 Then
    If Map(GetPlayerMap(Index)).Tile(GetPlayerX(Index), GetPlayerY(Index)).Type = TILE_TYPE_KEYOPEN Then
        x = Map(GetPlayerMap(Index)).Tile(GetPlayerX(Index), GetPlayerY(Index)).Data1
        y = Map(GetPlayerMap(Index)).Tile(GetPlayerX(Index), GetPlayerY(Index)).Data2

        If Map(GetPlayerMap(Index)).Tile(x, y).Type = TILE_TYPE_KEY And TempTile(GetPlayerMap(Index)).DoorOpen(x, y) = NO Then
            TempTile(GetPlayerMap(Index)).DoorOpen(x, y) = YES
            TempTile(GetPlayerMap(Index)).DoorTimer = GetTickCount
            Call SendDataToMap(GetPlayerMap(Index), "MAPKEY" & SEP_CHAR & x & SEP_CHAR & y & SEP_CHAR & 1 & END_CHAR)

            If Trim$(Map(GetPlayerMap(Index)).Tile(GetPlayerX(Index), GetPlayerY(Index)).String1) = vbNullString Then
                Call MapMsg(GetPlayerMap(Index), "Uma porta foi destrancada!", White)
            Else
                Call MapMsg(GetPlayerMap(Index), Trim$(Map(GetPlayerMap(Index)).Tile(GetPlayerX(Index), GetPlayerY(Index)).String1), White)
            End If

            Call SendDataToMap(GetPlayerMap(Index), "sound" & SEP_CHAR & "Chave" & END_CHAR)
        End If
    End If
    End If

    ' Check for shop
    If GetPlayerVoar(Index) = 0 Then
    If Map(GetPlayerMap(Index)).Tile(GetPlayerX(Index), GetPlayerY(Index)).Type = TILE_TYPE_SHOP Then
        If Map(GetPlayerMap(Index)).Tile(GetPlayerX(Index), GetPlayerY(Index)).Data1 > 0 Then
            Call SendTrade(Index, Map(GetPlayerMap(Index)).Tile(GetPlayerX(Index), GetPlayerY(Index)).Data1)
        Else
            Call PlayerMsg(Index, "Não há lojas aqui.", BrightRed)
        End If
    End If
    End If

    ' Checar se o jogador pisou nas tiles de mudança de sprite
    If GetPlayerVoar(Index) = 0 Then
    If Map(GetPlayerMap(Index)).Tile(GetPlayerX(Index), GetPlayerY(Index)).Type = TILE_TYPE_SPRITE_CHANGE Then
        If GetPlayerSprite(Index) = Map(GetPlayerMap(Index)).Tile(GetPlayerX(Index), GetPlayerY(Index)).Data1 Then
            Call PlayerMsg(Index, "Você já usa essa sprite!", BrightRed)
            Exit Sub
        Else

            If Map(GetPlayerMap(Index)).Tile(GetPlayerX(Index), GetPlayerY(Index)).Data2 = 0 Then
                Call SendDataTo(Index, "spritechange" & SEP_CHAR & 0 & END_CHAR)
            Else

                If Item(Map(GetPlayerMap(Index)).Tile(GetPlayerX(Index), GetPlayerY(Index)).Data2).Type = ITEM_TYPE_CURRENCY Then
                    Call PlayerMsg(Index, "Essa sprite irá custar " & Map(GetPlayerMap(Index)).Tile(GetPlayerX(Index), GetPlayerY(Index)).Data3 & " " & Trim$(Item(Map(GetPlayerMap(Index)).Tile(GetPlayerX(Index), GetPlayerY(Index)).Data2).Name) & "!", Yellow)
                Else
                    Call PlayerMsg(Index, "Essa sprite irá custar um(a) " & Trim$(Item(Map(GetPlayerMap(Index)).Tile(GetPlayerX(Index), GetPlayerY(Index)).Data2).Name) & "!", Yellow)
                End If

                Call SendDataTo(Index, "spritechange" & SEP_CHAR & 1 & END_CHAR)
            End If
        End If
        End If
    End If

    ' Checar se o jogador pisou nas tiles de mudança de sprite
    If GetPlayerVoar(Index) = 0 Then
    If Map(GetPlayerMap(Index)).Tile(GetPlayerX(Index), GetPlayerY(Index)).Type = TILE_TYPE_CLASS_CHANGE Then
        If Map(GetPlayerMap(Index)).Tile(GetPlayerX(Index), GetPlayerY(Index)).Data2 > 0 Then
            If GetPlayerClass(Index) <> Map(GetPlayerMap(Index)).Tile(GetPlayerX(Index), GetPlayerY(Index)).Data2 Then
                Call PlayerMsg(Index, "Você não está na classe requerida!", BrightRed)
                Exit Sub
            End If
        End If

        If GetPlayerClass(Index) = Map(GetPlayerMap(Index)).Tile(GetPlayerX(Index), GetPlayerY(Index)).Data1 Then
            Call PlayerMsg(Index, "Você já é dessa classe!", BrightRed)
        Else

            If Player(Index).Char(Player(Index).CharNum).Sex = 0 Then
                If GetPlayerSprite(Index) = Class(GetPlayerClass(Index)).MaleSprite Then
                    Call SetPlayerSprite(Index, Class(Map(GetPlayerMap(Index)).Tile(GetPlayerX(Index), GetPlayerY(Index)).Data1).MaleSprite)
                End If

            Else

                If GetPlayerSprite(Index) = Class(GetPlayerClass(Index)).FemaleSprite Then
                    Call SetPlayerSprite(Index, Class(Map(GetPlayerMap(Index)).Tile(GetPlayerX(Index), GetPlayerY(Index)).Data1).FemaleSprite)
                End If
            End If

            Call SetPlayerstr(Index, (Player(Index).Char(Player(Index).CharNum).STR - Class(GetPlayerClass(Index)).STR))
            Call SetPlayerDEF(Index, (Player(Index).Char(Player(Index).CharNum).DEF - Class(GetPlayerClass(Index)).DEF))
            Call SetPlayerMAGI(Index, (Player(Index).Char(Player(Index).CharNum).Magi - Class(GetPlayerClass(Index)).Magi))
            Call SetPlayerSPEED(Index, (Player(Index).Char(Player(Index).CharNum).Speed - Class(GetPlayerClass(Index)).Speed))
            Call SetPlayerClass(Index, Map(GetPlayerMap(Index)).Tile(GetPlayerX(Index), GetPlayerY(Index)).Data1)
            Call SetPlayerstr(Index, (Player(Index).Char(Player(Index).CharNum).STR + Class(GetPlayerClass(Index)).STR))
            Call SetPlayerDEF(Index, (Player(Index).Char(Player(Index).CharNum).DEF + Class(GetPlayerClass(Index)).DEF))
            Call SetPlayerMAGI(Index, (Player(Index).Char(Player(Index).CharNum).Magi + Class(GetPlayerClass(Index)).Magi))
            Call SetPlayerSPEED(Index, (Player(Index).Char(Player(Index).CharNum).Speed + Class(GetPlayerClass(Index)).Speed))
            Call PlayerMsg(Index, "Sua nova classe é " & Trim$(Class(GetPlayerClass(Index)).Name) & "!", BrightGreen)
            Call SendStats(Index)
            Call SendHP(Index)
            Call SendMP(Index)
            Call SendSP(Index)
            Call SendDataToMap(GetPlayerMap(Index), "checksprite" & SEP_CHAR & Index & SEP_CHAR & GetPlayerSprite(Index) & END_CHAR)
        End If
    End If
    End If

    ' Checar se o jogador pisou em uma tile de notice x_X
    If GetPlayerVoar(Index) = 0 Then
    If Map(GetPlayerMap(Index)).Tile(GetPlayerX(Index), GetPlayerY(Index)).Type = TILE_TYPE_NOTICE Then
        If Trim$(Map(GetPlayerMap(Index)).Tile(GetPlayerX(Index), GetPlayerY(Index)).String1) <> vbNullString Then
            Call PlayerMsg(Index, Trim$(Map(GetPlayerMap(Index)).Tile(GetPlayerX(Index), GetPlayerY(Index)).String1), Black)
        End If

        If Trim$(Map(GetPlayerMap(Index)).Tile(GetPlayerX(Index), GetPlayerY(Index)).String2) <> vbNullString Then
            Call PlayerMsg(Index, Trim$(Map(GetPlayerMap(Index)).Tile(GetPlayerX(Index), GetPlayerY(Index)).String2), Grey)
        End If

        Call SendDataToMap(GetPlayerMap(Index), "sound" & SEP_CHAR & Map(GetPlayerMap(Index)).Tile(GetPlayerX(Index), GetPlayerY(Index)).String3 & END_CHAR)
    End If
    End If

    ' Mesma coisa do de cima, sendo que de som
    If GetPlayerVoar(Index) = 0 Then
    If Map(GetPlayerMap(Index)).Tile(GetPlayerX(Index), GetPlayerY(Index)).Type = TILE_TYPE_SOUND Then
        Call SendDataToMap(GetPlayerMap(Index), "sound" & SEP_CHAR & Map(GetPlayerMap(Index)).Tile(GetPlayerX(Index), GetPlayerY(Index)).String1 & END_CHAR)
    End If

    If SCRIPTING = 1 Then
        If Map(GetPlayerMap(Index)).Tile(GetPlayerX(Index), GetPlayerY(Index)).Type = TILE_TYPE_SCRIPTED Then
            MyScript.ExecuteStatement "Scripts\Principal.txt", "ScriptedTile " & Index & "," & Map(GetPlayerMap(Index)).Tile(GetPlayerX(Index), GetPlayerY(Index)).Data1
        End If
    End If
    End If

End Sub

Agora Procure por :

Código:

Sub PlayerMapGetItem(ByVal Index As Long)

E substitua a Sub toda por :

Código:

Sub PlayerMapGetItem(ByVal Index As Long)
    Dim i As Long
    Dim N As Long
    Dim MapNum As Long
    Dim Msg As String

    If IsPlaying(Index) = False Then
        Exit Sub
    End If

    MapNum = GetPlayerMap(Index)

    For i = 1 To MAX_MAP_ITEMS

        ' Ver se tem um item por aqui...
        If (MapItem(MapNum, i).num > 0) And (MapItem(MapNum, i).num <= MAX_ITEMS) Then

            ' Checar se o item está no mesmo lugar que o jogador
            If (MapItem(MapNum, i).x = GetPlayerX(Index)) And (MapItem(MapNum, i).y = GetPlayerY(Index)) Then
            If GetPlayerVoar(Index) = 1 Then Exit Sub

                ' Achar um slot aberto
                N = FindOpenInvSlot(Index, MapItem(MapNum, i).num)

                ' Slot livre?
                If N <> 0 Then

                    ' Setar item no inventário do jogador
                    Call SetPlayerInvItemNum(Index, N, MapItem(MapNum, i).num)

                    If Item(GetPlayerInvItemNum(Index, N)).Type = ITEM_TYPE_CURRENCY Then
                        Call SetPlayerInvItemValue(Index, N, GetPlayerInvItemValue(Index, N) + MapItem(MapNum, i).Value)
                        Msg = "Você pegou um(a) " & MapItem(MapNum, i).Value & " " & Trim$(Item(GetPlayerInvItemNum(Index, N)).Name) & "."
                    Else
                        Call SetPlayerInvItemValue(Index, N, 0)
                        Msg = "Você pegou um(a) " & Trim$(Item(GetPlayerInvItemNum(Index, N)).Name) & "."
                    End If

                    Call SetPlayerInvItemDur(Index, N, MapItem(MapNum, i).Dur)

                    ' Erase item from the map
                    MapItem(MapNum, i).num = 0
                    MapItem(MapNum, i).Value = 0
                    MapItem(MapNum, i).Dur = 0
                    MapItem(MapNum, i).x = 0
                    MapItem(MapNum, i).y = 0
                    Call SendInventoryUpdate(Index, N)
                    Call SpawnItemSlot(i, 0, 0, 0, GetPlayerMap(Index), GetPlayerX(Index), GetPlayerY(Index))
                    Call PlayerMsg(Index, Msg, Yellow)
                    Exit Sub
                Else
                    Call PlayerMsg(Index, "Seu inventário está cheio.", BrightRed)
                    Exit Sub
                End If
            End If
        End If

    Next

End Sub

Agora no ModServerTCP procure por :

Código:

Case "refresh"

Acima adicione :

Código:

Case "dvoar"
        Call SetPlayerVoar(Index, 0)
        Call DeixarVoar(Index)
        Exit Sub
       
        Case "avoar"
        Call SetPlayerVoar(Index, 1)
        Call InicioVoar(Index)
        Exit Sub

Agora no final do ModServerTCP adicione :

Código:

Sub DeixarVoar(ByVal Index As Long)

Select Case GetPlayerSprite(Index)

Case 2
Call SetPlayerSprite(Index, 1)
Call SendPlayerData(Index)
Exit Sub

Case 4
Call SetPlayerSprite(Index, 3)
Call SendPlayerData(Index)
Exit Sub
End Select
End Sub

Sub InicioVoar(ByVal Index As Long)

Select Case GetPlayerSprite(Index)

Case 1
Call SetPlayerSprite(Index, 2)
Call SendPlayerData(Index)
Exit Sub

Case 3
Call SetPlayerSprite(Index, 4)
Call SendPlayerData(Index)
Exit Sub
End Select
End Sub

O Número do Case é o número da Sprite que o Player vai estar... Basta Modificar ali para qual Sprite ele vai quando Inicia o Voo e qual ele deve estar, e Para qual ele vai quando Termina o Voo e qual ele deve estar.

No ModTypes procure por :

Código:

Type PlayerRec

Abaixo coloque :

Código:

Voar As Long

No final do ModTypes coloque :

Código:

Function GetPlayerVoar(ByVal Index As Long) As Long
    GetPlayerVoar = Player(Index).Char(Player(Index).CharNum).Voar
End Function

Sub SetPlayerVoar(ByVal Index As Long, _
  ByVal Voar As Long)
    Player(Index).Char(Player(Index).CharNum).Voar = Voar
End Sub

Agora no final da clsCommands adicione :

Código:

Function GetPlayerVoar(ByVal Index As Long) As Long
    GetPlayerVoar = Player(Index).Char(Player(Index).CharNum).Voar
End Function

Sub SetPlayerVoar(ByVal Index As Long, _
  ByVal Voar As Long)
    Player(Index).Char(Player(Index).CharNum).Voar = Voar
End Sub

Cliente~Side

Va no frmMirage e procure por :

Código:

If KeyCode = vbKeyF1 Then
        If Player(MyIndex).Access > 3 Then
            frmadmin.Visible = False
            frmadmin.Visible = True
        End If
    End If

Abaixo disso adicione :

Código:

If KeyCode = vbKeyF2 Then
    If GetPlayerVoar(MyIndex) = 1 Then
    Call SetPlayerVoar(MyIndex, 0)
    Call AddText("Você parou de voar!", Black)
    Call SendData("dvoar" & SEP_CHAR & END_CHAR)
    Else
    Call SetPlayerVoar(MyIndex, 1)
    Call AddText("Você está voando!", Black)
    Call SendData("avoar" & SEP_CHAR & END_CHAR)
    End If
    End If

Agora va no ModDirectX e procure por :

Código:

If x >= 0 And x <= MAX_MAPX Then
            If y >= 0 And y <= MAX_MAPY Then
                If Map(GetPlayerMap(MyIndex)).Tile(x, y).Type = TILE_TYPE_BLOCKED Then
                    Player(Index).Arrow(z).Arrow = 0
              End If
            End If
        End If

Mude isso para :

Código:

If x >= 0 And x <= MAX_MAPX Then
            If y >= 0 And y <= MAX_MAPY Then
                If Map(GetPlayerMap(MyIndex)).Tile(x, y).Type = TILE_TYPE_BLOCKED Then
                If GetPlayerVoar(Index) = 0 Then
                    Player(Index).Arrow(z).Arrow = 0
                    Else
                    Player(Index).Arrow(z).Arrow = 1
                    End If
                End If
            End If
        End If

Agora procure por :

Código:

For I = 1 To MAX_PLAYERS
          If IsPlaying(I) And GetPlayerMap(I) = GetPlayerMap(MyIndex) Then
                If GetPlayerX(I) = x And GetPlayerY(I) = y Then
                    If Index = MyIndex Then
                        Call SendData("arrowhit" & SEP_CHAR & 0 & SEP_CHAR & I & SEP_CHAR & x & SEP_CHAR & y & END_CHAR)
                    End If
                    If Index <> I Then Player(Index).Arrow(z).Arrow = 0
                    Exit Sub
                End If
            End If
        Next I

E mude para :

Código:

For I = 1 To MAX_PLAYERS
          If IsPlaying(I) And GetPlayerMap(I) = GetPlayerMap(MyIndex) Then
                If GetPlayerX(I) = x And GetPlayerY(I) = y Then
                    If Index = MyIndex Then
                        Call SendData("arrowhit" & SEP_CHAR & 0 & SEP_CHAR & I & SEP_CHAR & x & SEP_CHAR & y & END_CHAR)
                    End If
                    If GetPlayerVoar(Index) = GetPlayerVoar(I) Then
                    If Index <> I Then Player(Index).Arrow(z).Arrow = 0
                    Else
                    Player(Index).Arrow(z).Arrow = 1
                    End If
                    Exit Sub
                End If
            End If
        Next I

Agora procure por :

Código:

For I = 1 To MAX_MAP_NPCS
            If MapNpc(I).Num > 0 Then
                If MapNpc(I).x = x And MapNpc(I).y = y Then
                    If Index = MyIndex Then
                        Call SendData("arrowhit" & SEP_CHAR & 1 & SEP_CHAR & I & SEP_CHAR & x & SEP_CHAR & y & END_CHAR)
                    End If
                    Player(Index).Arrow(z).Arrow = 0
                    Exit Sub
                End If
            End If
        Next I
    End If
Next z
End Sub

E mude para :

Código:

For I = 1 To MAX_MAP_NPCS
            If MapNpc(I).Num > 0 Then
                If MapNpc(I).x = x And MapNpc(I).y = y Then
                    If Index = MyIndex Then
                        Call SendData("arrowhit" & SEP_CHAR & 1 & SEP_CHAR & I & SEP_CHAR & x & SEP_CHAR & y & END_CHAR)
                    End If
                    If GetPlayerVoar(Index) = 0 Then
                    Player(Index).Arrow(z).Arrow = 0
                    Else
                    Player(Index).Arrow(z).Arrow = 1
                    End If
                    Exit Sub
                End If
            End If
        Next I
    End If
Next z
End Sub

Agora procure por :

Código:

' Gotta check :)
                If Map(GetPlayerMap(MyIndex)).Tile(GetPlayerX(MyIndex), GetPlayerY(MyIndex)).Type = TILE_TYPE_WARP Then
GettingMap = True
End If
End If
        End If
    End If
End Sub

Substitua por :

Código:

If Map(GetPlayerMap(MyIndex)).Tile(GetPlayerX(MyIndex), GetPlayerY(MyIndex)).Type = TILE_TYPE_WARP Then
                        If GetPlayerVoar(MyIndex) = 0 Then
                    GettingMap = True
                    Else
                    GettingMap = False
                    End If
                End If
            End If
        End If
    End If
End Sub

Agora no ModTypes procure por :

Código:

Type PlayerRec

Abaixo adicione :

Código:

Voar As Long

Agora no Final do ModTypes adicione :

Código:

Function GetPlayerVoar(ByVal Index As Long) As Long
    GetPlayerVoar = Player(Index).Voar
End Function

Sub SetPlayerVoar(ByVal Index As Long, ByVal Voar As Long)
    Player(Index).Voar = Voar
End Sub

Agora no ModGameLogic Procure por :

Código:

Function CanMove() As Boolean

E Substitua a Function Toda por :

Código:

Faça o Download abaixo da Sub e Substitua.

Download Da Function CanMove : Download Aqui

Testado e Aprovado!

Créditos : Guardian