Suporte ao desenvolvimento de jogos!


    Sistema de Voar Completo!

    Compartilhe
    avatar
    jadieljr
    Banido
    Banido

    Mensagens : 38
    Créditos : 30

    Sistema de Voar Completo!

    Mensagem por jadieljr em Ter Nov 15, 2011 1:33 pm

    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

    Successful
    avatar
    FilipeJF
    Aldeia Friend
    Aldeia Friend

    Medalhas :
    Mensagens : 1920
    Créditos : 134

    Re: Sistema de Voar Completo!

    Mensagem por FilipeJF em Qua Nov 16, 2011 7:19 pm

    Muito bom. Obrigado por postar aqui.


    _________________

    avatar
    Scar
    Iniciante
    Iniciante

    Mensagens : 50
    Créditos : 2

    Re: Sistema de Voar Completo!

    Mensagem por Scar em Qui Fev 02, 2012 10:49 pm

    Vou por F2??


    _________________
    Primeiro Evento Ganhado que emoçao
    avatar
    mago140598
    Novato
    Novato

    Mensagens : 19
    Créditos : 1

    Re: Sistema de Voar Completo!

    Mensagem por mago140598 em Seg Jan 14, 2013 1:26 pm

    Meu Deus, que complicaduuuuuuu
    avatar
    Wolf
    Ocasional
    Ocasional

    Mensagens : 192
    Créditos : 19

    Re: Sistema de Voar Completo!

    Mensagem por Wolf em Seg Jan 14, 2013 3:01 pm

    Cara você não percebe que reviveu o tipico apenas para falar
    Meu Deus, que complicaduuuuuuu
    Não reviva topicos.


    _________________
    Killer Wolf (Sempre siga em frente )
    Meu maior Suporte °~
    avatar
    Samuka_Maker
    Aldeia Friend
    Aldeia Friend

    Medalhas :
    Mensagens : 1205
    Créditos : 124

    Re: Sistema de Voar Completo!

    Mensagem por Samuka_Maker em Ter Jan 15, 2013 6:47 am

    mago apenas reviva tópicos em caso de duvida, o membro criador do tópico está banido se continuar assim a staff te banira como o caio te avisou já respeite as regras :>


    _________________

    Life rpg maker, suporte para criacao de jgoos online eoffline, link do forum:(v2.0)
    http://liferpgmakerv2.forumais.com/




    Tópico original/Tópico de Recrutamento

    Conteúdo patrocinado

    Re: Sistema de Voar Completo!

    Mensagem por Conteúdo patrocinado


      Data/hora atual: Ter Jun 19, 2018 1:33 pm