| Universo Games Suporte e Desenvolvimento só no Universo Games |
Ola Convidado, Seja Bem vindo a equipe lhe deseja boa sorte no seu projeto! |
| | Sistema Voar Completo | |
| | Autor | Mensagem |
---|
Lucas Roberto Administrador
Mensagens : 711
| Assunto: Sistema Voar Completo Sáb 05 Nov 2011, 18:21 | |
| Nome: Sistema Voar Completo Nivel de Dificuldade : 5/5 Utiliza: VisualBasic 6.0Como 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 ~ SideNo 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 | |
| | | Lucas Roberto Administrador
Mensagens : 711
| Assunto: Re: Sistema Voar Completo Sáb 05 Nov 2011, 18:22 | |
| Continuando...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~SideVa 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 AquiTestado e Aprovado!Créditos : Guardian | |
| | | Convidado Convidado
| Assunto: Re: Sistema Voar Completo Sáb 05 Nov 2011, 19:24 | |
| Bela Post, um sistema em que todos aguardava +1Créd |
| | | Convidado Convidado
| Assunto: Re: Sistema Voar Completo Sáb 05 Nov 2011, 19:47 | |
| +1 Cred Apesar de faltar o código para fazer que a sprite fique emcima do Fringe |
| | | Convidado Convidado
| Assunto: Re: Sistema Voar Completo Sáb 05 Nov 2011, 22:14 | |
| Belo tutorial. E é mesmo, não fica em cima de Fringe. +1 Por compartilhar ! |
| | | Convidado Convidado
| Assunto: Re: Sistema Voar Completo Sex 25 Nov 2011, 19:12 | |
| +1 Cred Apesar De Todos Falarem Não Passa Em Sima Do Fringe Ta Bem Explicado E Detalhado Flw. |
| | | Conteúdo patrocinado
| Assunto: Re: Sistema Voar Completo | |
| |
| | | | Sistema Voar Completo | |
|
Tópicos semelhantes | |
|
| Permissões neste sub-fórum | Não podes responder a tópicos
| |
| |
| |
|