[ALL]Pet Systen

por Lucas Lôpo Ter 23 Nov 2010, 20:17

""CLIENTSIDE""

Sobre Public Const ITEM_TYPE_SPELL As Byte = 13 Adicionar

Código:: Public Const ITEM_TYPE_PET As Byte = 14

No Módulo ModTypes em algum lugarno topo adicionar

Código:: Public PETHP_CHAR As String * 1 Public PETDATA_CHAR As String * 1 Public PETMOVE_CHAR As String * 1 Public PETATTACKNPC_CHAR As String * 1 Public NPCATTACKPET_CHAR As String * 1 Public CHANGEPETDIR_CHAR As String * 1 Public KILLPET_CHAR As String * 1 Public PETMOVESELECT_CHAR As String * 1

Sobre Public Const SPELL_TYPE_SUBSP As Byte = 5 Adicionar

Código:: Public Const SPELL_TYPE_PET As Byte = 6

Sobre Public Const TARGET_TYPE_LOCATION As Byte = 2 Adicionar

Código:: Public Const TARGET_TYPE_PET As Byte = 3

No Módulo ModTypes Adicionar

Código:: Type PetRec Sprite AsLong Alive AsByte HP As Long MaxHP AsLong Map As Long x As Long y As Long Dir As Byte Moving AsByte XOffset AsLong YOffset AsLong AttackTimerAs Long Attacking AsByte LastAttackAs Long End Type

No Type PlayerRec

Código:: ' Pet! Pet AsPetRec Under PLAYERHP_CHAR = Chr$(14) PETHP_CHAR= Chr$(15) Under PLAYERDATA_CHAR = Chr$(20) PETDATA_CHAR= Chr$(21)

SobrePLAYERMOVE_CHAR = Chr$(22) Adicionar

Código:: PETMOVE_CHAR = Chr$(23)

SobreATTACKNPC_CHAR = Chr$(29) Adicionar

Código:: PETATTACKNPC_CHAR = Chr$(30)

SobreNPCATTACK_CHAR = Chr$(31) Adicionar

Código:: NPCATTACKPET_CHAR = Chr$(32)

SobreCHANGEDIR_CHAR = Chr$(74) Adicionar

Código:: CHANGEPETDIR_CHAR = Chr$(75)

Sobre REQUESTLOCATION_CHAR = Chr$(167) Adicionar

Código:: KILLPET_CHAR =Chr$(168)

SobreREFRESH_CHAR = Chr$(169) Adicionar

Código:: PETMOVESELECT_CHAR = Chr$(170)

Na Sub GameLoop Adicionar

Código:: Dim PetWalkSpeed As Long ' Blit the players' pets' bar Call BltPetBars ' Blit out players' pet Call BltPet ' Blit out the pet and playertops If SIZE_Y > PIC_Y Then Call BltPetTop InGameLoop Under ' DrawPlayer Names If PlayerNameOn = YES Then For I = 1 To MAX_PLAYERS If IsPlaying(I) And GetPlayerMap(I) = GetPlayerMap(MyIndex) Then CallBltPlayerGuildName(I) Call BltPlayerName(I)

add:

Código:: IfPlayer(I).Pet.Alive = YES And Player(I).Pet.Map = GetPlayerMap(MyIndex) Then CallBltPetName(I) Ingame loop ' Process pet movements (actually movethem) IfPetWalkSpeed < GetTickCount Then CallProcessPetMovement PetWalkSpeed = GetTickCount + 30 End If

Na parte inferior da ModGameLogicAdicionar

Código:: Sub BltPet() 'ByVal Index As Long) Dim Anim As Byte Dim x As Long, y As Long Dim AttackSpeed As Long Dim Index As Long For Index =1 To MAX_PLAYERS IfIsPlaying(Index) Then IfGetPlayerMap(Index) = GetPlayerMap(MyIndex) Then If Player(Index).Pet.Alive = YES Then ' Only used if ever want to switch to blt rather then bltfast ' I suggest you don't use, because custom sizes won't work any longer With rec_pos .Top = Player(Index).Pet.y * PIC_Y + Player(Index).Pet.YOffset - (SIZE_Y- PIC_Y) .Bottom = .Top + PIC_Y .Left = Player(Index).Pet.x * PIC_X + Player(Index).Pet.XOffset +((SIZE_X - PIC_X) / 2) .Right = .Left + PIC_X + ((SIZE_X - PIC_X) / 2) End With ' Check for animation Anim = 0 If Player(Index).Pet.Attacking = 0 Then Select Case Player(Index).Pet.Dir Case DIR_UP If(Player(Index).Pet.YOffset < PIC_Y / 2) Then Anim = 1 Case DIR_DOWN If(Player(Index).Pet.YOffset > PIC_Y / 2 * -1) Then Anim = 1 Case DIR_LEFT If(Player(Index).Pet.XOffset < PIC_Y / 2) Then Anim = 1 Case DIR_RIGHT If(Player(Index).Pet.XOffset > PIC_Y / 2 * -1) Then Anim = 1 End Select Else If Player(Index).Pet.AttackTimer + 500 > GetTickCount Then Anim = 2 End If End If ' Check to see if we want to stop making him attack If Player(Index).Pet.AttackTimer + 1000 < GetTickCount Then Player(Index).Pet.Attacking = 0 Player(Index).Pet.AttackTimer = 0 End If rec.Top = Player(Index).Pet.Sprite * SIZE_Y + (SIZE_Y - PIC_Y) rec.Bottom = rec.Top + PIC_Y rec.Left = (Player(Index).Pet.Dir * (3 * (SIZE_X / PIC_X)) + (Anim *(SIZE_X / PIC_X))) * PIC_X rec.Right = rec.Left + SIZE_X x = Player(Index).Pet.x * PIC_X - (SIZE_X - PIC_X) / 2 + sx +Player(Index).Pet.XOffset y = Player(Index).Pet.y * PIC_Y - (SIZE_Y - PIC_Y) + sx +Player(Index).Pet.YOffset + (SIZE_Y - PIC_Y) If SIZE_X > PIC_X Then If x < 0 Then x =Player(Index).Pet.XOffset + sx + ((SIZE_X - PIC_X) / 2) IfPlayer(Index).Pet.Dir = DIR_RIGHT And Player(Index).Pet.Moving > 0 Then rec.Left = rec.Left -Player(Index).Pet.XOffset Else rec.Left =rec.Left - Player(Index).Pet.XOffset + ((SIZE_X - PIC_X) / 2) End If End If If x > MAX_MAPX * 32 Then x = MAX_MAPX * 32 +sx - ((SIZE_X - PIC_X) / 2) + Player(Index).Pet.XOffset IfPlayer(Index).Pet.Dir = DIR_LEFT And Player(Index).Pet.Moving > 0 Then rec.Right =rec.Right + Player(Index).Pet.XOffset Else rec.Right =rec.Right + Player(Index).Pet.XOffset - ((SIZE_X - PIC_X) / 2) End If End If End If Call DD_BackBuffer.BltFast(x - (NewPlayerX * PIC_X) - NewXOffset, y -(NewPlayerY * PIC_Y) - NewYOffset, DD_SpriteSurf, rec, DDBLTFAST_WAIT OrDDBLTFAST_SRCCOLORKEY) End If EndIf End If Next Index End Sub Sub BltPetTop() 'ByVal Index As Long) Dim Anim As Byte Dim x As Long, y As Long Dim AttackSpeed As Long Dim Index As Long For Index =1 To MAX_PLAYERS IfIsPlaying(Index) Then IfGetPlayerMap(Index) = GetPlayerMap(MyIndex) Then If Player(Index).Pet.Alive = YES Then ' Only used if ever want to switch to blt rather then bltfast ' I suggest you don't use, because custom sizes won't work any longer With rec_pos .Top = Player(Index).Pet.y * PIC_Y + Player(Index).Pet.YOffset - (SIZE_Y- PIC_Y) .Bottom = .Top + PIC_Y .Left = Player(Index).Pet.x * PIC_X + Player(Index).Pet.XOffset +((SIZE_X - PIC_X) / 2) .Right = .Left + PIC_X + ((SIZE_X - PIC_X) / 2) End With ' Check for animation Anim = 0 If Player(Index).Pet.Attacking = 0 Then Select Case Player(Index).Pet.Dir Case DIR_UP If(Player(Index).Pet.YOffset < PIC_Y / 2) Then Anim = 1 Case DIR_DOWN If(Player(Index).Pet.YOffset < PIC_Y / 2 * -1) Then Anim = 1 Case DIR_LEFT If(Player(Index).Pet.XOffset < PIC_Y / 2) Then Anim = 1 Case DIR_RIGHT If(Player(Index).Pet.XOffset < PIC_Y / 2 * -1) Then Anim = 1 End Select Else If Player(Index).Pet.AttackTimer + 500 > GetTickCount Then Anim = 2 End If End If ' Check to see if we want to stop making him attack If Player(Index).Pet.AttackTimer + 1000 < GetTickCount Then Player(Index).Pet.Attacking = 0 Player(Index).Pet.AttackTimer = 0 End If rec.Top = Player(Index).Pet.Sprite * SIZE_Y rec.Bottom = rec.Top + (SIZE_Y - PIC_Y) rec.Left = (Player(Index).Pet.Dir * (3 * (SIZE_X / PIC_X)) + (Anim *(SIZE_X / PIC_X))) * PIC_X rec.Right = rec.Left + SIZE_X x = Player(Index).Pet.x * PIC_X - (SIZE_X - PIC_X) / 2 + sx +Player(Index).Pet.XOffset y = Player(Index).Pet.y * PIC_Y - (SIZE_Y - PIC_Y) + sx +Player(Index).Pet.YOffset If y < 0 Then y = 0 If Player(Index).Pet.Dir = DIR_DOWN And Player(Index).Pet.Moving > 0Then rec.Top = rec.Top -Player(Index).Pet.YOffset Else rec.Top = rec.Top -Player(Index).Pet.YOffset + (SIZE_Y - PIC_Y) End If End If If SIZE_X > PIC_X Then If x < 0 Then x =Player(Index).Pet.XOffset + sx + ((SIZE_X - PIC_X) / 2) IfPlayer(Index).Pet.Dir = DIR_RIGHT And Player(Index).Pet.Moving > 0 Then rec.Left =rec.Left - Player(Index).Pet.XOffset Else rec.Left =rec.Left - Player(Index).Pet.XOffset + ((SIZE_X - PIC_X) / 2) End If End If If x > MAX_MAPX * 32 Then x = MAX_MAPX * 32 +sx - ((SIZE_X - PIC_X) / 2) + Player(Index).Pet.XOffset IfPlayer(Index).Pet.Dir = DIR_LEFT And Player(Index).Pet.Moving > 0 Then rec.Right =rec.Right + Player(Index).Pet.XOffset Else rec.Right =rec.Right + Player(Index).Pet.XOffset - ((SIZE_X - PIC_X) / 2) End If End If End If Call DD_BackBuffer.BltFast(x - (NewPlayerX * PIC_X) - NewXOffset, y -(NewPlayerY * PIC_Y) - NewYOffset, DD_SpriteSurf, rec, DDBLTFAST_WAIT OrDDBLTFAST_SRCCOLORKEY) End If EndIf End If Next Index End Sub Sub BltPetName(ByVal Index As Long) Dim TextX As Long Dim TextY As Long Dim Color As Long ' Checkaccess level IfGetPlayerPK(Index) = NO Then SelectCase GetPlayerAccess(Index) Case0 Color = QBColor(Brown) Case1 Color = QBColor(DarkGrey) Case2 Color = QBColor(Cyan) Case3 Color = QBColor(Blue) Case4 Color = QBColor(Pink) EndSelect Else Color =QBColor(BrightRed) End If ' Draw name TextX =Player(Index).Pet.x * PIC_X + sx + Player(Index).Pet.XOffset + Int(PIC_X / 2) -((Len(GetPlayerName(Index) & "'s Pet") / 2) * 8) TextY =Player(Index).Pet.y * PIC_Y + sx + Player(Index).Pet.YOffset - Int(PIC_Y / 2) -(SIZE_Y - PIC_Y) CallDrawText(TexthDC, TextX - (NewPlayerX * PIC_X) - NewXOffset, TextY -(NewPlayerY * PIC_Y) - NewYOffset, GetPlayerName(Index) & "'sPet", Color) End Sub Sub ProcessPetMovement() 'ByVal PetNum As Long) Dim PetNum As Long For PetNum =1 To MAX_PLAYERS IfIsPlaying(PetNum) Then IfPlayer(PetNum).Pet.Alive = YES Then ' Check if pet is walking, and if so process moving them over If Player(PetNum).Pet.Moving = MOVING_WALKING Then Select Case Player(PetNum).Pet.Dir Case DIR_UP Player(PetNum).Pet.YOffset =Player(PetNum).Pet.YOffset - WALK_SPEED Case DIR_DOWN Player(PetNum).Pet.YOffset = Player(PetNum).Pet.YOffset + WALK_SPEED Case DIR_LEFT Player(PetNum).Pet.XOffset= Player(PetNum).Pet.XOffset - WALK_SPEED Case DIR_RIGHT Player(PetNum).Pet.XOffset = Player(PetNum).Pet.XOffset + WALK_SPEED End Select ' Check if completed walking over to the next tile If (Player(PetNum).Pet.XOffset = 0) And (Player(PetNum).Pet.YOffset = 0)Then Player(PetNum).Pet.Moving = 0 End If End If EndIf End If Next PetNum End Sub

"""""Sobre""""""

Código:: ' Party request IfLCase$(Mid(MyText, 1, 6)) = "/party" Then 'Make sure they are actually sending something If Len(MyText) > 7 Then ChatText = Mid(MyText, 8, Len(MyText) - 7) Call SendPartyRequest(ChatText) Else Call AddText("Usage: /party playernamehere", AlertColor) EndIf MyText = vbNullString ExitSub End If

""""" Adicionar """""

Código:: ' Kill pet IfLCase$(Mid(MyText, 1, 8)) = "/killpet" Then CallSendData(KILLPET_CHAR & END_CHAR) MyText = vbNullString ExitSub End If

Substituir a Function CanMove() toda.

Código:: Function CanMove() As Boolean Dim I As Long, d As Long Dim x As Long, y As Long CanMove =True ' Make surethey aren't trying to move when they are already moving IfPlayer(MyIndex).Moving <> 0 Then CanMove= False ExitFunction End If ' Make surethey haven't just casted a spell IfPlayer(MyIndex).CastedSpell = YES Then IfGetTickCount > Player(MyIndex).AttackTimer + 1000 Then Player(MyIndex).CastedSpell = NO Else CanMove = False ExitFunction End If End If d =GetPlayerDir(MyIndex) If DirUpThen CallSetPlayerDir(MyIndex, DIR_UP) ' Checkto see if they are trying to go out of bounds IfGetPlayerY(MyIndex) > 0 Then 'Check to see if the map tile is blocked or not IfMap(GetPlayerMap(MyIndex)).Tile(GetPlayerX(MyIndex), GetPlayerY(MyIndex) -1).Type = TILE_TYPE_BLOCKED OrMap(GetPlayerMap(MyIndex)).Tile(GetPlayerX(MyIndex), GetPlayerY(MyIndex) -1)Type = TILE_TYPE_SIGN Then If TempTile(GetPlayerX(MyIndex), GetPlayerY(MyIndex) - 1).Type =TILE_TYPE_BLOCKED Or TempTile(GetPlayerX(MyIndex), GetPlayerY(MyIndex) -1).Type = TILE_TYPE_NONE Then CanMove = False ' Set the new direction if they weren't facing that direction If d <> DIR_UP Then Call SendPlayerDir End If Exit Function End If Else If TempTile(GetPlayerX(MyIndex), GetPlayerY(MyIndex) - 1).Type =TILE_TYPE_BLOCKED Then CanMove = False ' Set the new direction if they weren't facing that direction If d <> DIR_UP Then Call SendPlayerDir End If Exit Function End If EndIf IfMap(GetPlayerMap(MyIndex)).Tile(GetPlayerX(MyIndex), GetPlayerY(MyIndex) -1).Type = TILE_TYPE_CBLOCK Then If Map(GetPlayerMap(MyIndex)).Tile(GetPlayerX(MyIndex),GetPlayerY(MyIndex) - 1).Data1 = Player(MyIndex).Class Then Exit Function If Map(GetPlayerMap(MyIndex)).Tile(GetPlayerX(MyIndex),GetPlayerY(MyIndex) - 1).Data2 = Player(MyIndex).Class Then Exit Function If Map(GetPlayerMap(MyIndex)).Tile(GetPlayerX(MyIndex),GetPlayerY(MyIndex) - 1).Data3 = Player(MyIndex).Class Then Exit Function CanMove = False ' Set the new direction if they weren't facing that direction If d <> DIR_UP Then Call SendPlayerDir End If EndIf 'Check to see if the key door is open or not IfMap(GetPlayerMap(MyIndex)).Tile(GetPlayerX(MyIndex), GetPlayerY(MyIndex) -1).Type = TILE_TYPE_KEY Or Map(GetPlayerMap(MyIndex)).Tile(GetPlayerX(MyIndex),GetPlayerY(MyIndex) - 1).Type = TILE_TYPE_DOOR Then ' This actually checks if its open or not If TempTile(GetPlayerX(MyIndex), GetPlayerY(MyIndex) - 1).DoorOpen = NOThen CanMove = False ' Set the new direction if they weren't facing that direction If d <> DIR_UP Then Call SendPlayerDir End If Exit Function End If EndIf 'Check to see if a player is already on that tile For I = 1 To MAX_PLAYERS If I <> MyIndex Then If IsPlaying(I) Then If GetPlayerMap(I) = GetPlayerMap(MyIndex) Then If (GetPlayerX(I) =GetPlayerX(MyIndex)) And (GetPlayerY(I) = GetPlayerY(MyIndex) - 1) Then CanMove = False ' Set the newdirection if they weren't facing that direction If d <>DIR_UP Then CallSendPlayerDir End If Exit Function End If End If ' Might as well check for pets too If Player(I).Pet.Alive = YES Then IfPlayer(I).Pet.Map = GetPlayerMap(MyIndex) Then IfPlayer(I).Pet.x = GetPlayerX(MyIndex) And Player(I).Pet.y = GetPlayerY(MyIndex)- 1 Then CanMove =False ' Set thenew direction if they weren't facing that direction If d <> DIR_UP Then CallSendPlayerDir End If ExitFunction End If End If End If End If Else If Player(I).Pet.Alive = YES Then If Player(I).Pet.Map = GetPlayerMap(MyIndex) Then If Player(I).Pet.x= GetPlayerX(MyIndex) And Player(I).Pet.y = GetPlayerY(MyIndex) - 1 Then IfIsValid(GetPlayerX(MyIndex), GetPlayerY(MyIndex) - 2) Then IfMap(GetPlayerMap(MyIndex)).Tile(GetPlayerX(MyIndex), GetPlayerY(MyIndex) -2).Type = TILE_TYPE_BLOCKED Then CanMove= False ' Setthe new direction if they weren't facing that direction If d<> DIR_UP Then Call SendPlayerDir End If ExitFunction End If Else CanMove =False ' Set thenew direction if they weren't facing that direction If d <>DIR_UP Then CallSendPlayerDir End If ExitFunction End If End If End If End If End If NextI 'Check to see if a npc is already on that tile ForI = 1 To MAX_MAP_NPCS If MapNpc(I).Num > 0 Then If (MapNpc(I).x = GetPlayerX(MyIndex)) And (MapNpc(I).y =GetPlayerY(MyIndex) - 1) Then CanMove = False ' Set the new direction if they weren't facing that direction If d <> DIR_UP Then Call SendPlayerDir End If Exit Function End If End If NextI Else 'Check if they can warp to a new map IfMap(GetPlayerMap(MyIndex)).Up > 0 Then Call SendPlayerRequestNewMap GettingMap = True EndIf CanMove = False ExitFunction End If End If If DirDownThen CallSetPlayerDir(MyIndex, DIR_DOWN) ' Checkto see if they are trying to go out of bounds IfGetPlayerY(MyIndex) < MAX_MAPY Then 'Check to see if the map tile is blocked or not IfMap(GetPlayerMap(MyIndex)).Tile(GetPlayerX(MyIndex), GetPlayerY(MyIndex) +1).Type = TILE_TYPE_BLOCKED OrMap(GetPlayerMap(MyIndex)).Tile(GetPlayerX(MyIndex), GetPlayerY(MyIndex) +1)Type = TILE_TYPE_SIGN Then If TempTile(GetPlayerX(MyIndex),GetPlayerY(MyIndex) + 1).Type = TILE_TYPE_BLOCKED OrTempTile(GetPlayerX(MyIndex), GetPlayerY(MyIndex) + 1).Type = TILE_TYPE_NONEThen CanMove = False ' Set the new direction if they weren't facing that direction If d <> DIR_DOWN Then Call SendPlayerDir End If Exit Function End If Else If TempTile(GetPlayerX(MyIndex), GetPlayerY(MyIndex) + 1).Type =TILE_TYPE_BLOCKED Then CanMove = False ' Set the new direction if they weren't facing that direction If d <> DIR_DOWN Then Call SendPlayerDir End If Exit Function End If EndIf IfMap(GetPlayerMap(MyIndex)).Tile(GetPlayerX(MyIndex), GetPlayerY(MyIndex) +1).Type = TILE_TYPE_CBLOCK Then If Map(GetPlayerMap(MyIndex)).Tile(GetPlayerX(MyIndex),GetPlayerY(MyIndex) + 1).Data1 = Player(MyIndex).Class Then Exit Function If Map(GetPlayerMap(MyIndex)).Tile(GetPlayerX(MyIndex),GetPlayerY(MyIndex) + 1).Data2 = Player(MyIndex).Class Then Exit Function If Map(GetPlayerMap(MyIndex)).Tile(GetPlayerX(MyIndex),GetPlayerY(MyIndex) + 1).Data3 = Player(MyIndex).Class Then Exit Function CanMove = False ' Set the new direction if they weren't facing that direction If d <> DIR_DOWN Then Call SendPlayerDir End If Exit Function End If 'Check to see if the key door is open or not IfMap(GetPlayerMap(MyIndex)).Tile(GetPlayerX(MyIndex), GetPlayerY(MyIndex) +1).Type = TILE_TYPE_KEY Or Map(GetPlayerMap(MyIndex)).Tile(GetPlayerX(MyIndex),GetPlayerY(MyIndex) + 1).Type = TILE_TYPE_DOOR Then ' This actually checks if its open or not If TempTile(GetPlayerX(MyIndex), GetPlayerY(MyIndex) + 1).DoorOpen = NOThen CanMove = False ' Set the new direction if they weren't facing that direction If d <> DIR_DOWN Then Call SendPlayerDir End If Exit Function End If EndIf 'Check to see if a player is already on that tile ForI = 1 To MAX_PLAYERS If I <> MyIndex Then If IsPlaying(I) And GetPlayerMap(I) = GetPlayerMap(MyIndex) Then If (GetPlayerX(I) = GetPlayerX(MyIndex)) And (GetPlayerY(I) =GetPlayerY(MyIndex) + 1) Then CanMove = False ' Set the new direction ifthey weren't facing that direction If d <>DIR_DOWN Then CallSendPlayerDir End If Exit Function End If End If ' Might as well check for pets too If Player(I).Pet.Alive = YES Then If Player(I).Pet.Map = GetPlayerMap(MyIndex) Then If Player(I).Pet.x= GetPlayerX(MyIndex) And Player(I).Pet.y = GetPlayerY(MyIndex) + 1 Then CanMove = False ' Set the newdirection if they weren't facing that direction If d <>DIR_DOWN Then CallSendPlayerDir End If Exit Function End If End If End If Else If Player(I).Pet.Alive = YES Then If Player(I).Pet.Map = GetPlayerMap(MyIndex) Then If Player(I).Pet.x= GetPlayerX(MyIndex) And Player(I).Pet.y = GetPlayerY(MyIndex) + 1 Then IfIsValid(GetPlayerX(MyIndex), GetPlayerY(MyIndex) + 2) Then IfMap(GetPlayerMap(MyIndex)).Tile(GetPlayerX(MyIndex), GetPlayerY(MyIndex) +2).Type = TILE_TYPE_BLOCKED Then CanMove= False ' Setthe new direction if they weren't facing that direction If d<> DIR_DOWN Then Call SendPlayerDir End If ExitFunction End If Else CanMove =False ' Set thenew direction if they weren't facing that direction If d<> DIR_DOWN Then CallSendPlayerDir End If ExitFunction End If End If End If End If End If NextI 'Check to see if a npc is already on that tile ForI = 1 To MAX_MAP_NPCS If MapNpc(I).Num > 0 Then If (MapNpc(I).x = GetPlayerX(MyIndex)) And (MapNpc(I).y =GetPlayerY(MyIndex) + 1) Then CanMove = False ' Set the new direction if they weren't facing that direction If d <> DIR_DOWN Then Call SendPlayerDir End If Exit Function End If End If NextI Else 'Check if they can warp to a new map IfMap(GetPlayerMap(MyIndex)).Down > 0 Then Call SendPlayerRequestNewMap GettingMap = True EndIf CanMove = False ExitFunction End If End If If DirLeftThen CallSetPlayerDir(MyIndex, DIR_LEFT) ' Checkto see if they are trying to go out of bounds IfGetPlayerX(MyIndex) > 0 Then ' Check to see if the map tile is blocked ornot IfMap(GetPlayerMap(MyIndex)).Tile(GetPlayerX(MyIndex) - 1,GetPlayerY(MyIndex)).Type = TILE_TYPE_BLOCKED OrMap(GetPlayerMap(MyIndex)).Tile(GetPlayerX(MyIndex) - 1,GetPlayerY(MyIndex)).Type = TILE_TYPE_SIGN Then If TempTile(GetPlayerX(MyIndex) - 1, GetPlayerY(MyIndex)).Type =TILE_TYPE_BLOCKED Or TempTile(GetPlayerX(MyIndex) - 1,GetPlayerY(MyIndex)).Type = TILE_TYPE_NONE Then CanMove = False ' Set the new direction if they weren't facing that direction If d <> DIR_LEFT Then Call SendPlayerDir End If Exit Function End If Else If TempTile(GetPlayerX(MyIndex) - 1, GetPlayerY(MyIndex)).Type =TILE_TYPE_BLOCKED Then CanMove = False ' Set the new direction if they weren't facing that direction If d <> DIR_LEFT Then Call SendPlayerDir End If Exit Function End If EndIf IfMap(GetPlayerMap(MyIndex)).Tile(GetPlayerX(MyIndex) - 1,GetPlayerY(MyIndex)).Type = TILE_TYPE_CBLOCK Then If Map(GetPlayerMap(MyIndex)).Tile(GetPlayerX(MyIndex) - 1,GetPlayerY(MyIndex)).Data1 = Player(MyIndex).Class Then Exit Function If Map(GetPlayerMap(MyIndex)).Tile(GetPlayerX(MyIndex) - 1,GetPlayerY(MyIndex)).Data2 = Player(MyIndex).Class Then Exit Function If Map(GetPlayerMap(MyIndex)).Tile(GetPlayerX(MyIndex) - 1,GetPlayerY(MyIndex)).Data3 = Player(MyIndex).Class Then Exit Function CanMove = False ' Set the new direction if they weren't facing that direction If d <> DIR_LEFT Then Call SendPlayerDir End If Exit Function EndIf 'Check to see if the key door is open or not IfMap(GetPlayerMap(MyIndex)).Tile(GetPlayerX(MyIndex) - 1,GetPlayerY(MyIndex)).Type = TILE_TYPE_KEY Or Map(GetPlayerMap(MyIndex)).Tile(GetPlayerX(MyIndex)- 1, GetPlayerY(MyIndex)).Type = TILE_TYPE_DOOR Then ' This actually checks if its open or not If TempTile(GetPlayerX(MyIndex) - 1, GetPlayerY(MyIndex)).DoorOpen = NOThen CanMove = False ' Set the new direction if they weren't facing that direction If d <> DIR_LEFT Then Call SendPlayerDir End If Exit Function End If EndIf 'Check to see if a player is already on that tile ForI = 1 To MAX_PLAYERS If I <> MyIndex Then If IsPlaying(I) And GetPlayerMap(I) = GetPlayerMap(MyIndex) Then If (GetPlayerX(I) = GetPlayerX(MyIndex) - 1) And (GetPlayerY(I) =GetPlayerY(MyIndex)) Then CanMove = False ' Set the new directionif they weren't facing that direction If d <>DIR_LEFT Then CallSendPlayerDir End If Exit Function End If End If ' Might as well check for pets too If Player(I).Pet.Alive = YES Then If Player(I).Pet.Map = GetPlayerMap(MyIndex) Then If Player(I).Pet.x= GetPlayerX(MyIndex) - 1 And Player(I).Pet.y = GetPlayerY(MyIndex) Then CanMove = False ' Set the newdirection if they weren't facing that direction If d <>DIR_LEFT Then CallSendPlayerDir End If Exit Function End If End If End If Else If Player(I).Pet.Alive = YES Then If Player(I).Pet.Map = GetPlayerMap(MyIndex) Then If Player(I).Pet.x= GetPlayerX(MyIndex) - 1 And Player(I).Pet.y = GetPlayerY(MyIndex) Then IfIsValid(GetPlayerX(MyIndex) - 2, GetPlayerY(MyIndex)) Then IfMap(GetPlayerMap(MyIndex)).Tile(GetPlayerX(MyIndex) - 2,GetPlayerY(MyIndex)).Type = TILE_TYPE_BLOCKED Then CanMove= False ' Setthe new direction if they weren't facing that direction If d<> DIR_LEFT Then Call SendPlayerDir End If Exit Function End If Else CanMove =False ' Set thenew direction if they weren't facing that direction If d<> DIR_LEFT Then CallSendPlayerDir End If ExitFunction End If End If End If End If End If NextI 'Check to see if a npc is already on that tile ForI = 1 To MAX_MAP_NPCS If MapNpc(I).Num > 0 Then If (MapNpc(I).x = GetPlayerX(MyIndex) - 1) And (MapNpc(I).y =GetPlayerY(MyIndex)) Then CanMove = False ' Set the new direction if they weren't facing that direction If d <> DIR_LEFT Then Call SendPlayerDir End If Exit Function End If End If NextI Else 'Check if they can warp to a new map IfMap(GetPlayerMap(MyIndex)).Left > 0 Then Call SendPlayerRequestNewMap GettingMap = True EndIf CanMove = False ExitFunction End If End If If DirRightThen CallSetPlayerDir(MyIndex, DIR_RIGHT) ' Checkto see if they are trying to go out of bounds IfGetPlayerX(MyIndex) < MAX_MAPX Then 'Check to see if the map tile is blocked or not IfMap(GetPlayerMap(MyIndex)).Tile(GetPlayerX(MyIndex) + 1, GetPlayerY(MyIndex)).Type= TILE_TYPE_BLOCKED Or Map(GetPlayerMap(MyIndex)).Tile(GetPlayerX(MyIndex) + 1,GetPlayerY(MyIndex)).Type = TILE_TYPE_SIGN Then If TempTile(GetPlayerX(MyIndex) + 1, GetPlayerY(MyIndex)).Type =TILE_TYPE_BLOCKED Or TempTile(GetPlayerX(MyIndex) + 1,GetPlayerY(MyIndex)).Type = TILE_TYPE_NONE Then CanMove = False ' Set the new direction if they weren't facing that direction If d <> DIR_RIGHT Then Call SendPlayerDir End If Exit Function End If Else If TempTile(GetPlayerX(MyIndex) + 1, GetPlayerY(MyIndex)).Type =TILE_TYPE_BLOCKED Then CanMove = False ' Set the new direction if they weren't facing that direction If d <> DIR_RIGHT Then Call SendPlayerDir End If Exit Function End If EndIf IfMap(GetPlayerMap(MyIndex)).Tile(GetPlayerX(MyIndex) + 1,GetPlayerY(MyIndex)).Type = TILE_TYPE_CBLOCK Then If Map(GetPlayerMap(MyIndex)).Tile(GetPlayerX(MyIndex) + 1,GetPlayerY(MyIndex)).Data1 = Player(MyIndex).Class Then Exit Function If Map(GetPlayerMap(MyIndex)).Tile(GetPlayerX(MyIndex) + 1,GetPlayerY(MyIndex)).Data2 = Player(MyIndex).Class Then Exit Function If Map(GetPlayerMap(MyIndex)).Tile(GetPlayerX(MyIndex) + 1,GetPlayerY(MyIndex)).Data3 = Player(MyIndex).Class Then Exit Function CanMove = False ' Set the new direction if they weren't facing that direction If d <> DIR_RIGHT Then Call SendPlayerDir End If Exit Function EndIf 'Check to see if the key door is open or not IfMap(GetPlayerMap(MyIndex)).Tile(GetPlayerX(MyIndex) + 1,GetPlayerY(MyIndex)).Type = TILE_TYPE_KEY OrMap(GetPlayerMap(MyIndex)).Tile(GetPlayerX(MyIndex) + 1,GetPlayerY(MyIndex)).Type = TILE_TYPE_DOOR Then ' This actually checks if its open or not If TempTile(GetPlayerX(MyIndex) + 1, GetPlayerY(MyIndex)).DoorOpen = NOThen CanMove = False ' Set the new direction if they weren't facing that direction If d <> DIR_RIGHT Then Call SendPlayerDir End If Exit Function End If EndIf ' Checkto see if a player is already on that tile ForI = 1 To MAX_PLAYERS If I <> MyIndex Then If IsPlaying(I) And GetPlayerMap(I) = GetPlayerMap(MyIndex) Then If (GetPlayerX(I) = GetPlayerX(MyIndex) + 1) And (GetPlayerY(I) =GetPlayerY(MyIndex)) Then CanMove = False ' Set the newdirection if they weren't facing that direction If d <> DIR_RIGHT Then CallSendPlayerDir End If Exit Function End If End If ' Might as well check for pets too If Player(I).Pet.Alive = YES Then If Player(I).Pet.Map = GetPlayerMap(MyIndex) Then If Player(I).Pet.x= GetPlayerX(MyIndex) + 1 And Player(I).Pet.y = GetPlayerY(MyIndex) Then CanMove = False ' Set the newdirection if they weren't facing that direction If d <>DIR_RIGHT Then CallSendPlayerDir End If Exit Function End If End If End If Else If Player(I).Pet.Alive = YESThen If Player(I).Pet.Map = GetPlayerMap(MyIndex) Then If Player(I).Pet.x= GetPlayerX(MyIndex) + 1 And Player(I).Pet.y = GetPlayerY(MyIndex) Then IfIsValid(GetPlayerX(MyIndex) + 2, GetPlayerY(MyIndex)) Then IfMap(GetPlayerMap(MyIndex)).Tile(GetPlayerX(MyIndex) + 2,GetPlayerY(MyIndex)).Type = TILE_TYPE_BLOCKED Then CanMove = False ' Setthe new direction if they weren't facing that direction If d<> DIR_RIGHT Then Call SendPlayerDir End If ExitFunction End If Else CanMove =False ' Set thenew direction if they weren't facing that direction If d<> DIR_RIGHT Then CallSendPlayerDir End If ExitFunction End If End If End If End If End If NextI 'Check to see if a npc is already on that tile ForI = 1 To MAX_MAP_NPCS If MapNpc(I).Num > 0 Then If (MapNpc(I).x = GetPlayerX(MyIndex) + 1) And (MapNpc(I).y =GetPlayerY(MyIndex)) Then CanMove = False ' Set the new direction if they weren't facing that direction If d <> DIR_RIGHT Then Call SendPlayerDir End If Exit Function End If End If NextI Else 'Check if they can warp to a new map IfMap(GetPlayerMap(MyIndex)).Right > 0 Then Call SendPlayerRequestNewMap GettingMap = True EndIf CanMove = False ExitFunction End If End If End Function

Continua '-'

por Lucas Lôpo Ter 23 Nov 2010, 20:19

Na parte inferior da ModGameLogcAdicionar

Código:: Public Sub PetMove(Button As Integer, Shift AsInteger, x As Single, y As Single) Dim x1, y1 As Long IfPlayer(MyIndex).Pet.Alive = NO Then Exit Sub x1 = Int(x /PIC_X) y1 = Int(y /PIC_Y) If (Button =1) And (x1 >= 0) And (x1 <= MAX_MAPX) And (y1 >= 0) And (y1 <=MAX_MAPY) Then CallSendData(PETMOVESELECT_CHAR & SEP_CHAR & x1 & SEP_CHAR & y1& END_CHAR) End If End Sub Substitua toda a SubItemEditorOk() Public Sub ItemEditorOk() Item(EditorIndex).Name = frmItemEditor.txtName.Text Item(EditorIndex).desc = frmItemEditor.txtDesc.Text Item(EditorIndex).Pic = EditorItemY * 6 + EditorItemX Item(EditorIndex).Type = frmItemEditor.cmbType.ListIndex If(frmItemEditor.cmbType.ListIndex >= ITEM_TYPE_WEAPON) And(frmItemEditor.cmbType.ListIndex <= ITEM_TYPE_SHIELD) Then Item(EditorIndex).Data1 = frmItemEditor.scrlDurability.Value IffrmItemEditor.chkRepair.Value = 0 Then Item(EditorIndex).Data1 =Item(EditorIndex).Data1 * -1 Item(EditorIndex).Data2 = frmItemEditor.scrlStrength.Value IffrmItemEditor.chkBow.Value = Checked Then Item(EditorIndex).Data3 = frmItemEditor.cmbBow.ListIndex + 1 Else Item(EditorIndex).Data3= 0 End If Item(EditorIndex).StrReq = frmItemEditor.scrlStrReq.Value Item(EditorIndex).DefReq = frmItemEditor.scrlDefReq.Value Item(EditorIndex).SpeedReq = frmItemEditor.scrlSpeedReq.Value Item(EditorIndex).MagicReq= frmItemEditor.scrlMagicReq.Value Item(EditorIndex).ClassReq = frmItemEditor.scrlClassReq.Value Item(EditorIndex).AccessReq = frmItemEditor.scrlAccessReq.Value Item(EditorIndex).AddHP = frmItemEditor.scrlAddHP.Value Item(EditorIndex).AddMP = frmItemEditor.scrlAddMP.Value Item(EditorIndex).AddSP = frmItemEditor.scrlAddSP.Value Item(EditorIndex).AddStr = frmItemEditor.scrlAddStr.Value Item(EditorIndex).AddDef = frmItemEditor.scrlAddDef.Value Item(EditorIndex).AddMagi = frmItemEditor.scrlAddMagi.Value Item(EditorIndex).AddSpeed = frmItemEditor.scrlAddSpeed.Value Item(EditorIndex).AddEXP = frmItemEditor.scrlAddEXP.Value Item(EditorIndex).AttackSpeed = frmItemEditor.scrlAttackSpeed.Value End If If(frmItemEditor.cmbType.ListIndex >= ITEM_TYPE_POTIONADDHP) And(frmItemEditor.cmbType.ListIndex <= ITEM_TYPE_POTIONSUBSP) Then Item(EditorIndex).Data1 = frmItemEditor.scrlVitalMod.Value Item(EditorIndex).Data2 = 0 Item(EditorIndex).Data3 = 0 Item(EditorIndex).StrReq = 0 Item(EditorIndex).DefReq = 0 Item(EditorIndex).SpeedReq = 0 Item(EditorIndex).MagicReq = 0 Item(EditorIndex).ClassReq = 0 Item(EditorIndex).AccessReq = 0 Item(EditorIndex).AddHP = 0 Item(EditorIndex).AddMP = 0 Item(EditorIndex).AddSP = 0 Item(EditorIndex).AddStr = 0 Item(EditorIndex).AddDef = 0 Item(EditorIndex).AddMagi = 0 Item(EditorIndex).AddSpeed = 0 Item(EditorIndex).AddEXP = 0 Item(EditorIndex).AttackSpeed = 0 End If If(frmItemEditor.cmbType.ListIndex = ITEM_TYPE_SPELL) Then Item(EditorIndex).Data1 =frmItemEditor.scrlSpell.Value Item(EditorIndex).Data2 = 0 Item(EditorIndex).Data3 = 0 Item(EditorIndex).StrReq = 0 Item(EditorIndex).DefReq = 0 Item(EditorIndex).SpeedReq = 0 Item(EditorIndex).MagicReq = 0 Item(EditorIndex).ClassReq = 0 Item(EditorIndex).AccessReq = 0 Item(EditorIndex).AddHP = 0 Item(EditorIndex).AddMP = 0 Item(EditorIndex).AddSP = 0 Item(EditorIndex).AddStr = 0 Item(EditorIndex).AddDef = 0 Item(EditorIndex).AddMagi = 0 Item(EditorIndex).AddSpeed = 0 Item(EditorIndex).AddEXP = 0 Item(EditorIndex).AttackSpeed = 0 End If If(frmItemEditor.cmbType.ListIndex = ITEM_TYPE_PET) Then Item(EditorIndex).Data1 = frmItemEditor.scrlPet.Value Item(EditorIndex).Data2 = frmItemEditor.scrlPetLevel.Value Item(EditorIndex).Data3 = 0 Item(EditorIndex).StrReq = 0 Item(EditorIndex).DefReq = 0 Item(EditorIndex).SpeedReq = 0 Item(EditorIndex).MagicReq = 0 Item(EditorIndex).ClassReq = 0 Item(EditorIndex).AccessReq = 0 Item(EditorIndex).AddHP = 0 Item(EditorIndex).AddMP = 0 Item(EditorIndex).AddSP = 0 Item(EditorIndex).AddStr = 0 Item(EditorIndex).AddDef = 0 Item(EditorIndex).AddMagi = 0 Item(EditorIndex).AddSpeed = 0 Item(EditorIndex).AddEXP = 0 Item(EditorIndex).AttackSpeed = 0 End If CallSendSaveItem(EditorIndex) InItemsEditor = False UnloadfrmItemEditor End Sub

Na parte inferior da ModGameLogicAdicionar

Código:: Sub BltPetBars() 'ByVal Index As Long) Dim x As Long, y As Long, Index As Long For Index =1 To MAX_PLAYERS IfIsPlaying(Index) Then IfPlayer(Index).Pet.Map = GetPlayerMap(MyIndex) And Player(Index).Pet.Alive = YESThen If GetTickCount < Player(MyIndex).Pet.LastAttack + 5000 Then x = (Player(Index).Pet.x * PIC_X + sx + Player(Index).Pet.XOffset) -(NewPlayerX * PIC_X) - NewXOffset y = (Player(Index).Pet.y * PIC_Y + sx + Player(Index).Pet.YOffset) -(NewPlayerY * PIC_Y) - NewYOffset If Player(Index).HP = 0 Then Exit Sub 'draws the back bars Call DD_BackBuffer.SetFillColor(RGB(0, 0, 255)) Call DD_BackBuffer.DrawBox(x, y + 32, x + 32, y + 36) 'draws HP If Int((Player(Index).Pet.HP / Player(Index).Pet.MaxHP) * 100) > 50Then Call DD_BackBuffer.SetFillColor(RGB(0, 255, 0)) End If If Int((Player(Index).Pet.HP / Player(Index).Pet.MaxHP) * 100) > 20And Int((Player(Index).Pet.HP / Player(Index).Pet.MaxHP) * 100) <= 50 Then Call DD_BackBuffer.SetFillColor(RGB(255, 255, 0)) End If If Int((Player(Index).Pet.HP / Player(Index).Pet.MaxHP) * 100) <= 20Then Call DD_BackBuffer.SetFillColor(RGB(255, 0, 0)) End If Call DD_BackBuffer.DrawBox(x, y + PIC_Y, x + ((Player(Index).Pet.HP /100) / (Player(Index).Pet.MaxHP / 100) * SIZE_X), y + 36) End If EndIf End If Next Index End Sub

Na Sub HandleData() Adicionar

Código:: '::::::::::::::::::: ' :: Pet hppacket :: '::::::::::::::::::: If Parse$(0)= PETHP_CHAR Then Player(MyIndex).Pet.MaxHP = Val(Parse$(1)) Player(MyIndex).Pet.HP = Val(Parse$(2)) Exit Sub End If '::::::::::::::::::::: ' :: Petdata packet :: ' ::::::::::::::::::::: If Parse$(0)= PETDATA_CHAR Then I =Val(Parse$(1)) Player(I).Pet.Alive = Val(Parse$(2)) Player(I).Pet.Map = Val(Parse$(3)) Player(I).Pet.x = Val(Parse$(4)) Player(I).Pet.y = Val(Parse$(5)) Player(I).Pet.Dir = Val(Parse$(6)) Player(I).Pet.Sprite = Val(Parse$(7)) Player(I).Pet.HP = Val(Parse$(8)) Player(I).Pet.MaxHP = Val(Parse$(9)) ' Makesure their pet isn't walking Player(I).Pet.Moving = 0 Player(I).Pet.XOffset = 0 Player(I).Pet.YOffset = 0 ' Checkif the player is the client player, and if so reset Directions If I =MyIndex Then DirUp = False DirDown = False DirLeft = False DirRight = False End If Exit Sub End If '::::::::::::::::::::::::: ' :: Petmovement packet :: '::::::::::::::::::::::::: If(Parse$(0) = PETMOVE_CHAR) Then I = Val(Parse$(1)) x =Val(Parse$(2)) y =Val(Parse$(3)) Direction = Val(Parse$(4)) n =Val(Parse$(5)) Player(I).Pet.x = x Player(I).Pet.y = y Player(I).Pet.Dir = Direction Player(I).Pet.XOffset = 0 Player(I).Pet.YOffset = 0 Player(I).Pet.Moving = MOVING_WALKING SelectCase Player(I).Pet.Dir CaseDIR_UP Player(I).Pet.YOffset = PIC_Y CaseDIR_DOWN Player(I).Pet.YOffset = PIC_Y * -1 CaseDIR_LEFT Player(I).Pet.XOffset = PIC_X CaseDIR_RIGHT Player(I).Pet.XOffset = PIC_X * -1 EndSelect Exit Sub End If

""""Subistitua toda a packet """"

'

Código:: :::::::::::::::::::::::::: ' :: Playerattack packet :: '::::::::::::::::::::::::::

""""Por:""""

Código:: ':::::::::::::::::::::::::: ' :: Playerattack packet :: ':::::::::::::::::::::::::: If(Parse$(0) = ATTACKPLAYER_CHAR) Then I =Val(Parse$(1)) ' Setplayer to attacking Player(I).Attacking = 1 Player(I).AttackTimer = GetTickCount Player(I).LastAttack = GetTickCount Exit Sub End If If(Parse$(0) = ATTACKNPC_CHAR) Then I =Val(Parse$(1)) ' Setplayer to attacking Player(I).Attacking = 1 Player(I).AttackTimer = GetTickCount Player(I).LastAttack = GetTickCount ' The servernow also keeps track, just to let you know MapNpc(Val(Parse$(2))).LastAttack = GetTickCount Exit Sub End If If(Parse$(0) = PETATTACKNPC_CHAR) Then I =Val(Parse$(1)) ' Setpet to attacking Player(I).Pet.Attacking = 1 Player(I).Pet.AttackTimer = GetTickCount Player(I).Pet.LastAttack = GetTickCount ' Theserver now also keeps track, just to let you know MapNpc(Val(Parse$(2))).LastAttack = GetTickCount Exit Sub End If If(Parse$(0) = NPCATTACK_CHAR) Then I =Val(Parse$(1)) ' Setnpc to attacking MapNpc(I).Attacking = 1 MapNpc(I).AttackTimer = GetTickCount MapNpc(I).LastAttack = GetTickCount Player(Val(Parse$(2))).LastAttack = GetTickCount Exit Sub End If If(Parse$(0) = NPCATTACKPET_CHAR) Then I =Val(Parse$(1)) ' Setnpc to attacking MapNpc(I).Attacking = 1 MapNpc(I).AttackTimer = GetTickCount MapNpc(I).LastAttack = GetTickCount Player(Val(Parse$(2))).Pet.LastAttack = GetTickCount Exit Sub End If '::::::::::::::::::::::::::::::::: ' :: ChangePet Direction Packet :: '::::::::::::::::::::::::::::::::: If Parse$(0)= CHANGEPETDIR_CHAR Then Player(Val(Parse$(2))).Pet.Dir = Val(Parse$(1)) Exit Sub End If InfrmItemEditor ReplacePrivate Sub CmbType_Click Private SubcmbType_Click() If(cmbType.ListIndex >= ITEM_TYPE_WEAPON) And (cmbType.ListIndex <=ITEM_TYPE_SHIELD) Then IfcmbType.ListIndex = ITEM_TYPE_WEAPON Then Label3.Caption = "Damage :" Else Label3.Caption = "Defence :" End If fraEquipment.Visible = True fraPet.Visible = False fraAttributes.Visible = True fraBow.Visible = True Else fraEquipment.Visible = False fraAttributes.Visible = False fraBow.Visible = False End If If(cmbType.ListIndex >= ITEM_TYPE_POTIONADDHP) And (cmbType.ListIndex <=ITEM_TYPE_POTIONSUBSP) Then fraVitals.Visible = True fraPet.Visible = False fraAttributes.Visible = False fraEquipment.Visible = False fraBow.Visible = False Else fraVitals.Visible = False End If If(cmbType.ListIndex = ITEM_TYPE_SPELL) Then fraSpell.Visible = True fraPet.Visible = False fraAttributes.Visible = False fraEquipment.Visible = False fraBow.Visible = False Else fraSpell.Visible = False End If If(cmbType.ListIndex = ITEM_TYPE_PET) Then fraSpell.Visible = False fraPet.Visible = True fraAttributes.Visible = False fraEquipment.Visible = False fraBow.Visible = False Else fraPet.Visible = False End If End Sub Private Sub scrlPet_Change() Label34.Caption = scrlPet.Value End Sub Private Sub scrlPetLevel_Change() Label35.Caption = scrlPetLevel.Value End Sub Add ScrlPetLevel and ScrlPet In FrmMiragE Replace PicScreen_MOuseDown Private Sub picScreen_MouseDown(Button As Integer, ShiftAs Integer, x As Single, y As Single) Dim I As Long IfInSpawnEditor Then IfSpawnLocator > 0 Then TempNpcSpawn(SpawnLocator).Used = 1 TempNpcSpawn(SpawnLocator).x = Int((x + (NewPlayerX * PIC_X)) / PIC_X) TempNpcSpawn(SpawnLocator).y = Int((y + (NewPlayerY * PIC_Y)) / PIC_Y) frmMapProperties.Spawn(SpawnLocator - 1).Caption = "(" &TempNpcSpawn(SpawnLocator).x & ", " &TempNpcSpawn(SpawnLocator).y & ")" SpawnLocator = 0 End If Exit Sub End If If (Button =1 Or Button = 2) And InEditor = True Then CallEditorMouseDown(Button, Shift, (x + (NewPlayerX * PIC_X)), (y + (NewPlayerY *PIC_Y))) End If If (Button =1 Or Button = 2) And InEditor = False Then IfButton = 1 And Player(MyIndex).Pet.Alive = YES Then CallPetMove(Button, Shift, (x + (NewPlayerX * PIC_X)), (y + (NewPlayerY * PIC_Y))) Else CallPlayerSearch(Button, Shift, (x + (NewPlayerX * PIC_X)), (y + (NewPlayerY *PIC_Y))) End If End If End Sub

por Lucas Lôpo Ter 23 Nov 2010, 20:40

Continuando...

""Server Side""

1. Faça novo módulo chamadoModPetAI

2. Em ModPetAI Adicionar

Código:: Option Explicit Private X As Long Private x1 As Byte Private y1 As Byte Private x2 As Byte Private y2 As Byte Private Damage As Long Private i As Long Sub PetAI() On Error GoTo ErrHandler '////////////////////////////////////////////////////////// ' // Usado para mover os pets // '////////////////////////////////////////////////////////// For X = 1 ToMAX_PLAYERS IfPlayer(X).Pet.Alive = YES Then x1 =Player(X).Pet.X y1 =Player(X).Pet.Y x2 =Player(X).Pet.XToGo y2 =Player(X).Pet.YToGo IfPlayer(X).Pet.Target > 0 Then If Player(X).Pet.TargetType = TARGET_TYPE_PLAYER Then x2 = GetPlayerX(Player(X).Pet.Target) y2 = GetPlayerY(Player(X).Pet.Target) End If If Player(X).Pet.TargetType = TARGET_TYPE_NPC Then If CanPetAttackNpc(X, Player(X).Pet.Target) Then Damage = Player(X).Pet.Level - Npc(Player(X).Pet.Target).STR + (Rnd * 5)- 2 If Damage > 0 Then CallPetAttackNpc(X, Player(X).Pet.Target, Damage) x2 = x1 y2 = y1 End If Else x2 =MapNpc(Player(X).Pet.Map, Player(X).Pet.Target).X y2 = MapNpc(Player(X).Pet.Map, Player(X).Pet.Target).Y End If End If Else If Player(X).Pet.Map = GetPlayerMap(X) Or Player(X).Pet.MapToGo = 0 Then If Player(X).Pet.XToGo = -1 Or Player(X).Pet.YToGo = -1 Then i = Int(Rnd * 4) If i = 1 Then i = Int(Rnd * 4) If i = DIR_UP Then y2 = y1 - 1 x2 =Player(X).Pet.X End If If i = DIR_DOWNThen y2 = y1 + 1 x2 =Player(X).Pet.X End If If i = DIR_RIGHTThen x2 = x1 + 1 y2 = Player(X).Pet.Y End If If i = DIR_LEFTThen x2 = x1 - 1 y2 =Player(X).Pet.Y End If If Not IsValid(x2,y2) Then x2 = x1 y2 = y1 End If IfGrid(Player(X).Pet.Map).Loc(x2, y2).Blocked = True Then x2 = x1 y2 = y1 End If Else x2 = x1 y2 = y1 End If End If Else If Map(Player(X).Pet.Map).Up = Player(X).Pet.MapToGo Then y2 = y1 - 1 Else If Map(Player(X).Pet.Map).Down = Player(X).Pet.MapToGo Then y2 = y1 + 1 Else IfMap(Player(X).Pet.Map).Left = Player(X).Pet.MapToGo Then x2 = x1 - 1 Else IfMap(Player(X).Pet.Map).Right = Player(X).Pet.MapToGo Then x2 = x1 + 1 Else i = Int(Rnd* 4) If i = 1 Then i =Int(Rnd * 4) If i =DIR_UP Then y2 = y1 - 1 If i =DIR_DOWN Then y2 = y1 + 1 If i = DIR_RIGHT Then x2 = x1 + 1 If i =DIR_LEFT Then x2 = x1 - 1 If NotIsValid(x2, y2) Then x2= x1 y2 = y1 End If IfGrid(Player(X).Pet.Map).Loc(x2, y2).Blocked = True Then x2= x1 y2 = y1 End If Else x2 = x1 y2 = y1 End If End If End If End If End If End If EndIf Ifx1 < x2 Then ' RIGHT not left If y1 < y2 Then ' DOWN not up If x2 - x1 > y2 - y1 Then ' RIGHT not down If CanPetMove(X, DIR_RIGHT) Then ' RIGHT works Call PetMove(X,DIR_RIGHT, MOVING_WALKING) Else If CanPetMove(X,DIR_DOWN) Then ' DOWN worksand right doesn't Call PetMove(X,DIR_DOWN, MOVING_WALKING) Else ' Nothingworks, random time i = Int(Rnd *4) If CanPetMove(X,i) Then CallPetMove(X, i, MOVING_WALKING) End If End If End If Else If x2 - x1 <> y2 - y1 Then ' DOWN not right If CanPetMove(X,DIR_DOWN) Then ' DOWN works Call PetMove(X,DIR_DOWN, MOVING_WALKING) Else IfCanPetMove(X, DIR_RIGHT) Then ' RIGHTworks and down doesn't CallPetMove(X, DIR_RIGHT, MOVING_WALKING) Else ' Nothingworks, random time i = Int(Rnd* 4) IfCanPetMove(X, i) Then Call PetMove(X, i, MOVING_WALKING) End If End If End If Else ' Both are equal If CanPetMove(X, DIR_RIGHT) Then ' RIGHT works IfCanPetMove(X, DIR_DOWN) Then ' DOWN andRIGHT work i =(Int(Rnd * 2) * 2) + 1 IfCanPetMove(X, i) Then CallPetMove(X, i, MOVING_WALKING) End If Else ' RIGHT worksonly CallPetMove(X, DIR_RIGHT, MOVING_WALKING) End If Else IfCanPetMove(X, DIR_DOWN) Then ' DOWNworks only CallPetMove(X, DIR_DOWN, MOVING_WALKING) Else ' Nothingworks, random time i = Int(Rnd * 4) IfCanPetMove(X, i) Then CallPetMove(X, i, MOVING_WALKING) End If End If End If End If End If Else If y1 <> y2 Then ' UP not down If x2 - x1 > y1 - y2 Then ' RIGHT not up If CanPetMove(X,DIR_RIGHT) Then ' RIGHT works Call PetMove(X,DIR_RIGHT, MOVING_WALKING) Else IfCanPetMove(X, DIR_UP) Then ' UP worksand right doesn't CallPetMove(X, DIR_UP, MOVING_WALKING) Else ' Nothing works,random time i = Int(Rnd* 4) IfCanPetMove(X, i) Then CallPetMove(X, i, MOVING_WALKING) End If End If End If Else If x2 - x1 <>y1 - y2 Then ' UP not right IfCanPetMove(X, DIR_UP) Then ' UP works CallPetMove(X, DIR_UP, MOVING_WALKING) Else If CanPetMove(X, DIR_RIGHT) Then ' RIGHTworks and up doesn't CallPetMove(X, DIR_RIGHT, MOVING_WALKING) Else ' Nothing works,random time i =Int(Rnd * 4) IfCanPetMove(X, i) Then Call PetMove(X, i, MOVING_WALKING) End If End If End If Else ' Both areequal IfCanPetMove(X, DIR_RIGHT) Then ' RIGHTworks IfCanPetMove(X, DIR_UP) Then ' UPand RIGHT work i =Int(Rnd * 2) * 3 IfCanPetMove(X, i) Then Call PetMove(X, i, MOVING_WALKING) End If Else ' RIGHT worksonly CallPetMove(X, DIR_RIGHT, MOVING_WALKING) End If Else IfCanPetMove(X, DIR_UP) Then ' UPworks only CallPetMove(X, DIR_UP, MOVING_WALKING) Else 'Nothing works, random time i =Int(Rnd * 4) IfCanPetMove(X, i) Then Call PetMove(X, i, MOVING_WALKING) End If End If End If End If End If Else ' Target is horizontal If CanPetMove(X, DIR_RIGHT) Then ' RIGHT works Call PetMove(X,DIR_RIGHT, MOVING_WALKING) Else ' Right doesn'twork If CanPetMove(X,DIR_UP) Then IfCanPetMove(X, DIR_DOWN) Then ' UP andDOWN work i = Int(Rnd* 2) CallPetMove(X, i, MOVING_WALKING) Else ' Only UPworks CallPetMove(X, DIR_UP, MOVING_WALKING) End If Else IfCanPetMove(X, DIR_DOWN) Then ' Only DOWNworks CallPetMove(X, DIR_DOWN, MOVING_WALKING) Else ' Nothing works,only left is left (heh) IfCanPetMove(X, DIR_LEFT) Then CallPetMove(X, DIR_LEFT, MOVING_WALKING) Else ' Nothing worksat all, let it die End If End If End If End If End If End If Else If x1 <> x2 Then ' LEFT not right If y1 < y2 Then ' DOWN not up If x1 - x2 > y2 - y1 Then ' LEFT not down If CanPetMove(X,DIR_LEFT) Then ' LEFT works Call PetMove(X,DIR_LEFT, MOVING_WALKING) Else IfCanPetMove(X, DIR_DOWN) Then ' DOWNworks and left doesn't CallPetMove(X, DIR_DOWN, MOVING_WALKING) Else ' Nothing works,random time i = Int(Rnd* 4) IfCanPetMove(X, i) Then CallPetMove(X, i, MOVING_WALKING) End If End If End If Else If x1 - x2 <>y2 - y1 Then ' DOWN not left IfCanPetMove(X, DIR_DOWN) Then ' DOWNworks CallPetMove(X, DIR_DOWN, MOVING_WALKING) Else If CanPetMove(X, DIR_LEFT) Then ' LEFTworks and down doesn't CallPetMove(X, DIR_LEFT, MOVING_WALKING) Else ' Nothingworks, random time i =Int(Rnd * 4) IfCanPetMove(X, i) Then Call PetMove(X, i, MOVING_WALKING) End If End If End If Else ' Both areequal If CanPetMove(X,DIR_LEFT) Then ' LEFTworks IfCanPetMove(X, DIR_DOWN) Then ' DOWNand LEFT work i = Int(Rnd * 2) + 1 CallPetMove(X, i, MOVING_WALKING) Else ' LEFTworks only CallPetMove(X, DIR_LEFT, MOVING_WALKING) End If Else IfCanPetMove(X, DIR_DOWN) Then ' DOWNworks only Call PetMove(X,DIR_DOWN, MOVING_WALKING) Else 'Nothing works, random time i =Int(Rnd * 4) If CanPetMove(X, i) Then Call PetMove(X, i, MOVING_WALKING) End If End If End If End If End If Else If y1 <> y2 Then ' UP not down If x1 - x2 > y1- y2 Then ' LEFT not up IfCanPetMove(X, DIR_LEFT) Then ' LEFTworks CallPetMove(X, DIR_LEFT, MOVING_WALKING) Else IfCanPetMove(X, DIR_UP) Then ' UPworks and left doesn't CallPetMove(X, DIR_UP, MOVING_WALKING) Else ' Nothingworks, random time i =Int(Rnd * 4) IfCanPetMove(X, i) Then Call PetMove(X, i, MOVING_WALKING) End If End If End If Else If x1 - x2<> y1 - y2 Then ' UP notLEFT IfCanPetMove(X, DIR_UP) Then ' UPworks CallPetMove(X, DIR_UP, MOVING_WALKING) Else IfCanPetMove(X, DIR_LEFT) Then 'LEFT works and up doesn't Call PetMove(X, DIR_LEFT, MOVING_WALKING) Else 'Nothing works, random time i =Int(Rnd * 4) IfCanPetMove(X, i) Then Call PetMove(X, i, MOVING_WALKING) EndIf End If End If Else ' Both areequal IfCanPetMove(X, DIR_LEFT) Then ' LEFTworks If CanPetMove(X,DIR_UP) Then 'UP and LEFT work i =Int(Rnd * 2) * 2 Call PetMove(X, i, MOVING_WALKING) Else 'LEFT works only Call PetMove(X, DIR_LEFT, MOVING_WALKING) End If Else IfCanPetMove(X, DIR_UP) Then 'UP works only Call PetMove(X, DIR_UP, MOVING_WALKING) Else 'Nothing works, random time i =Int(Rnd * 4) IfCanPetMove(X, i) Then Call PetMove(X, i, MOVING_WALKING) EndIf End If End If End If End If Else ' Target ishorizontal If CanPetMove(X,DIR_LEFT) Then ' LEFT works Call PetMove(X, DIR_LEFT, MOVING_WALKING) Else ' LEFT doesn'twork IfCanPetMove(X, DIR_UP) Then IfCanPetMove(X, DIR_DOWN) Then ' UPand DOWN work i =Int(Rnd * 2) CallPetMove(X, i, MOVING_WALKING) Else ' OnlyUP works CallPetMove(X, DIR_UP, MOVING_WALKING) End If Else IfCanPetMove(X, DIR_DOWN) Then ' OnlyDOWN works CallPetMove(X, DIR_DOWN, MOVING_WALKING) Else ' Nothingworks, only right is left (heh) IfCanPetMove(X, DIR_RIGHT) Then Call PetMove(X, DIR_RIGHT, MOVING_WALKING) Else ' Nothingworks at all, let it die Player(X).Pet.MapToGo = Player(X).Pet.Map Player(X).Pet.XToGo = -1 Player(X).Pet.YToGo = -1 End If End If End If End If End If End If Else ' Target is vertical If y1 < y2 Then ' DOWN not up If CanPetMove(X, DIR_DOWN) Then Call PetMove(X,DIR_DOWN, MOVING_WALKING) Else ' Down doesn't work If CanPetMove(X,DIR_RIGHT) Then If CanPetMove(X,DIR_LEFT) Then ' RIGHT andLEFT work i =Int((Rnd * 2) + 2) CallPetMove(X, i, MOVING_WALKING) Else ' RIGHT works only CallPetMove(X, DIR_RIGHT, MOVING_WALKING) End If Else IfCanPetMove(X, DIR_LEFT) Then ' LEFTworks only CallPetMove(X, DIR_LEFT, MOVING_WALKING) Else ' Nothingworks, lets try up IfCanPetMove(X, DIR_UP) Then CallPetMove(X, DIR_UP, MOVING_WALKING) Else 'Nothing at all works, let it die Player(X).Pet.MapToGo = Player(X).Pet.Map Player(X).Pet.XToGo = -1 Player(X).Pet.YToGo = -1 End If End If End If End If Else If y1 <> y2 Then ' UP not down If CanPetMove(X,DIR_UP) Then Call PetMove(X,DIR_UP, MOVING_WALKING) Else ' UP doesn'twork IfCanPetMove(X, DIR_RIGHT) Then IfCanPetMove(X, DIR_LEFT) Then ' RIGHTand LEFT work i =Int((Rnd * 2) + 2) CallPetMove(X, i, MOVING_WALKING) Else ' RIGHTworks only CallPetMove(X, DIR_RIGHT, MOVING_WALKING) End If Else IfCanPetMove(X, DIR_LEFT) Then ' LEFTworks only CallPetMove(X, DIR_LEFT, MOVING_WALKING) Else 'Nothing works, lets try down IfCanPetMove(X, DIR_DOWN) Then Call PetMove(X, DIR_DOWN, MOVING_WALKING) Else 'Nothing at all works, let it die Player(X).Pet.MapToGo = Player(X).Pet.Map Player(X).Pet.XToGo = -1 Player(X).Pet.YToGo = -1 End If End If End If End If Else ' Question: ' What do we do now? ' Answer: Player(X).Pet.MapToGo = Player(X).Pet.Map Player(X).Pet.XToGo = -1 Player(X).Pet.YToGo= -1 ' Explaination: ' If y1 - y2 = 0 and x1 - x2 = 0... ' We must be at the location we want to moveto! ' Cancel the movement for the future End If End If End If EndIf End If Next Exit Sub ErrHandler: CallAddLog("Error avoided in Sub PetAI()!", "errorlist.txt") End Sub

3. Substituir todo SubLoadPlayer Por

Código:: Sub LoadPlayer(ByVal Index As Long, _ ByVal Name AsString) Dim FileNameAs String Dim i AsLong Dim N AsLong CallClearPlayer(Index) FileName =App.Path & "\accounts" & Trim$(Name) & ".ini" Player(Index).Login = GetVar(FileName, "GENERAL","Login") Player(Index).Password = GetVar(FileName, "GENERAL","Password") Player(Index).Pet.Alive = NO For i = 1 ToMAX_CHARS 'General Player(Index).Char(i).Name = GetVar(FileName, "CHAR" & i,"Name") Player(Index).Char(i).Sex = Val(GetVar(FileName, "CHAR" &i, "Sex")) Player(Index).Char(i).Class = Val(GetVar(FileName, "CHAR"& i, "Class")) IfPlayer(Index).Char(i).Class = 0 Then Player(Index).Char(i).Class = 1 Player(Index).Char(i).Sprite = Val(GetVar(FileName, "CHAR"& i, "Sprite")) Player(Index).Char(i).Level= Val(GetVar(FileName, "CHAR" & i, "Level")) Player(Index).Char(i).Exp = Val(GetVar(FileName, "CHAR" &i, "Exp")) Player(Index).Char(i).Access = Val(GetVar(FileName, "CHAR"& i, "Access")) Player(Index).Char(i).PK = Val(GetVar(FileName, "CHAR" &i, "PK")) Player(Index).Char(i).Guild = GetVar(FileName, "CHAR" & i,"Guild") Player(Index).Char(i).Guildaccess = Val(GetVar(FileName,"CHAR" & i, "Guildaccess")) ' Vitals Player(Index).Char(i).HP = Val(GetVar(FileName, "CHAR" &i, "HP")) Player(Index).Char(i).MP = Val(GetVar(FileName, "CHAR" &i, "MP")) Player(Index).Char(i).SP = Val(GetVar(FileName, "CHAR" &i, "SP")) ' Stats Player(Index).Char(i).STR = Val(GetVar(FileName, "CHAR" &i, "str")) Player(Index).Char(i).DEF = Val(GetVar(FileName, "CHAR" &i, "DEF")) Player(Index).Char(i).Speed = Val(GetVar(FileName, "CHAR"& i, "SPEED")) Player(Index).Char(i).Magi = Val(GetVar(FileName, "CHAR" &i, "MAGI")) Player(Index).Char(i).POINTS = Val(GetVar(FileName, "CHAR"& i, "POINTS")) ' Wornequipment Player(Index).Char(i).ArmorSlot = Val(GetVar(FileName, "CHAR"& i, "ArmorSlot")) Player(Index).Char(i).WeaponSlot = Val(GetVar(FileName, "CHAR"& i, "WeaponSlot")) Player(Index).Char(i).HelmetSlot = Val(GetVar(FileName, "CHAR"& i, "HelmetSlot")) Player(Index).Char(i).ShieldSlot = Val(GetVar(FileName, "CHAR"& i, "ShieldSlot")) 'Position Player(Index).Char(i).Map = Val(GetVar(FileName, "CHAR" &i, "Map")) Player(Index).Char(i).X = Val(GetVar(FileName, "CHAR" & i,"X")) Player(Index).Char(i).Y = Val(GetVar(FileName, "CHAR" & i,"Y")) Player(Index).Char(i).Dir= Val(GetVar(FileName, "CHAR" & i, "Dir")) ' Checkto make sure that they aren't on map 0, if so reset'm IfPlayer(Index).Char(i).Map = 0 Then Player(Index).Char(i).Map = START_MAP Player(Index).Char(i).X = START_X Player(Index).Char(i).Y = START_Y End If 'Inventory For N =1 To MAX_INV Player(Index).Char(i).Inv(N).num= Val(GetVar(FileName, "CHAR" & i, "InvItemNum" &N)) Player(Index).Char(i).Inv(N).Value= Val(GetVar(FileName, "CHAR" & i, "InvItemVal" &N)) Player(Index).Char(i).Inv(N).Dur =Val(GetVar(FileName, "CHAR" & i, "InvItemDur" & N)) Next ' Spells For N =1 To MAX_PLAYER_SPELLS Player(Index).Char(i).Spell(N)= Val(GetVar(FileName, "CHAR" & i, "Spell" & N)) Next IfVal(GetVar(FileName, "CHAR" & i, "HasPet")) = 1 Then Player(Index).Pet.Sprite = Val(GetVar(FileName, "CHAR" &i, "Pet")) Player(Index).Pet.Alive = YES Player(Index).Pet.Dir = DIR_UP Player(Index).Pet.Map = Player(Index).Char(i).Map Player(Index).Pet.X = Player(Index).Char(i).X + Int((Rnd * 3) - 1) IfPlayer(Index).Pet.X < 0 Or Player(Index).Pet.X > MAX_MAPX ThenPlayer(Index).Pet.X = GetPlayerX(Index) Player(Index).Pet.Y = Player(Index).Char(i).Y + Int((Rnd * 3) - 1) IfPlayer(Index).Pet.Y < 0 Or Player(Index).Pet.Y > MAX_MAPY Then Player(Index).Pet.Y= GetPlayerY(Index) Player(Index).Pet.MapToGo = 0 Player(Index).Pet.XToGo = -1 Player(Index).Pet.YToGo = -1 Player(Index).Pet.Level = Val(GetVar(FileName, "CHAR" & i,"PetLevel")) Player(Index).Pet.HP = Player(Index).Pet.Level * 5 '??? End If For N =1 To MAX_FRIENDS Player(Index).Char(i).Friends(N) = GetVar(FileName, "CHAR"& i, "Friend" & N) Next Next End Sub

Substituir a Sub SavePlayer por

Código:: Sub SavePlayer(ByVal Index As Long) Dim FileNameAs String Dim i AsLong Dim N AsLong FileName =App.Path & "\accounts" & Trim$(Player(Index).Login) &".ini" CallPutVar(FileName, "GENERAL", "Login",Trim$(Player(Index).Login)) CallPutVar(FileName, "GENERAL", "Password",Trim$(Player(Index).Password)) For i = 1 ToMAX_CHARS 'General CallPutVar(FileName, "CHAR" & i, "Name", Trim$(Player(Index).Char(i).Name)) CallPutVar(FileName, "CHAR" & i, "Class",STR(Player(Index).Char(i).Class)) CallPutVar(FileName, "CHAR" & i, "Sex",STR(Player(Index).Char(i).Sex)) CallPutVar(FileName, "CHAR" & i, "Sprite", STR(Player(Index).Char(i).Sprite)) CallPutVar(FileName, "CHAR" & i, "Level",STR(Player(Index).Char(i).Level)) CallPutVar(FileName, "CHAR" & i, "Exp",STR(Player(Index).Char(i).Exp)) CallPutVar(FileName, "CHAR" & i, "Access", STR(Player(Index).Char(i).Access)) CallPutVar(FileName, "CHAR" & i, "PK",STR(Player(Index).Char(i).PK)) CallPutVar(FileName, "CHAR" & i, "Guild",Trim$(Player(Index).Char(i).Guild)) CallPutVar(FileName, "CHAR" & i, "Guildaccess", STR(Player(Index).Char(i).Guildaccess)) ' Vitals CallPutVar(FileName, "CHAR" & i, "HP",STR(Player(Index).Char(i).HP)) CallPutVar(FileName, "CHAR" & i, "MP",STR(Player(Index).Char(i).MP)) CallPutVar(FileName, "CHAR" & i, "SP", STR(Player(Index).Char(i).SP)) ' Stats CallPutVar(FileName, "CHAR" & i, "str",STR(Player(Index).Char(i).STR)) CallPutVar(FileName, "CHAR" & i, "DEF",STR(Player(Index).Char(i).DEF)) CallPutVar(FileName, "CHAR" & i, "SPEED",STR(Player(Index).Char(i).Speed)) CallPutVar(FileName, "CHAR" & i, "MAGI",STR(Player(Index).Char(i).Magi)) CallPutVar(FileName, "CHAR" & i, "POINTS",STR(Player(Index).Char(i).POINTS)) ' Wornequipment CallPutVar(FileName, "CHAR" & i, "ArmorSlot",STR(Player(Index).Char(i).ArmorSlot)) CallPutVar(FileName, "CHAR" & i, "WeaponSlot",STR(Player(Index).Char(i).WeaponSlot)) CallPutVar(FileName, "CHAR" & i, "HelmetSlot",STR(Player(Index).Char(i).HelmetSlot)) CallPutVar(FileName, "CHAR" & i, "ShieldSlot",STR(Player(Index).Char(i).ShieldSlot)) ' Checkto make sure that they aren't on map 0, if so reset'm IfPlayer(Index).Char(i).Map = 0 Then Player(Index).Char(i).Map = START_MAP Player(Index).Char(i).X = START_X Player(Index).Char(i).Y = START_Y End If 'Position CallPutVar(FileName, "CHAR" & i, "Map",STR(Player(Index).Char(i).Map)) CallPutVar(FileName, "CHAR" & i, "X",STR(Player(Index).Char(i).X)) CallPutVar(FileName, "CHAR" & i, "Y",STR(Player(Index).Char(i).Y)) CallPutVar(FileName, "CHAR" & i, "Dir",STR(Player(Index).Char(i).Dir)) ' Inventory For N =1 To MAX_INV CallPutVar(FileName, "CHAR" & i, "InvItemNum" & N,STR(Player(Index).Char(i).Inv(N).num)) Call PutVar(FileName,"CHAR" & i, "InvItemVal" & N,STR(Player(Index).Char(i).Inv(N).Value)) Call PutVar(FileName, "CHAR" & i, "InvItemDur"& N, STR(Player(Index).Char(i).Inv(N).Dur)) Next ' Spells For N =1 To MAX_PLAYER_SPELLS CallPutVar(FileName, "CHAR" & i, "Spell" & N,STR(Player(Index).Char(i).Spell(N))) Next ' Pet If i =Player(Index).CharNum Then IfPlayer(Index).Pet.Alive = YES Then Call PutVar(FileName, "CHAR" & i, "HasPet", 1) Call PutVar(FileName, "CHAR" & i, "Pet", STR(Player(Index).Pet.Sprite)) Call PutVar(FileName, "CHAR" & i, "PetLevel",STR(Player(Index).Pet.Level)) Else Call PutVar(FileName, "CHAR" & i, "HasPet", 0) Call DelVar(FileName, "CHAR" & i, "Pet") 'Saving space Call DelVar(FileName, "CHAR" & i, "PetLevel") EndIf Else CallPutVar(FileName, "CHAR" & i, "HasPet", 0) CallDelVar(FileName, "CHAR" & i, "Pet") ' Saving space CallDelVar(FileName, "CHAR" & i, "PetLevel") End If ' Friendlist For N =1 To MAX_FRIENDS CallPutVar(FileName, "CHAR" & i, "Friend" & N,Player(Index).Char(i).Friends(N)) Next Next End Sub

Em algum lugar do ModTypesAdicionar

Código:: Public PETHP_CHAR As String * 1 Public PETDATA_CHAR As String * 1 Public PETMOVE_CHAR As String * 1 Public PETATTACKNPC_CHAR As String * 1 Public NPCATTACKPET_CHAR As String * 1 Public CHANGEPETDIR_CHAR As String * 1 Public KILLPET_CHAR As String * 1 Public PETMOVESELECT_CHAR As String * 1

Sobre Public Const ITEM_TYPE_SPELL As Byte = 13 Adicionar

Código:: Public Const ITEM_TYPE_PET As Byte = 14

Sobre Public Const SPELL_TYPE_SUBSP As Byte = 5 Adicionar

Código:: Public Const SPELL_TYPE_PET As Byte = 6

Sobre Public Const TARGET_TYPE_LOCATION As Byte = 2 Adicionar

Código:: Public Const TARGET_TYPE_PET As Byte = 3

Acima do Type PlayerInvRec Adicionar

Código:: Type PetRec Sprite AsLong Alive AsByte Map As Long X As Long Y As Long Dir As Byte Level AsLong HP As Long MapToGo AsLong XToGo AsLong YToGo AsLong Target AsLong TargetTypeAs Byte AttackTimerAs Long End Type

Na Type AccountRec Adicionar

Código:: Pet As PetRec

Na Sub ClearPlayer Adicionar

Código:: Player(Index).Pet.Alive = NO

No Topodo ModGameLogic Adicionar

Código:: Private tmrPetAI As Long

No finaldo ModGameLogic Adicionar

Código:: Function CanNpcAttackPet(ByVal MapNpcNum As Long,ByVal Index As Long) As Boolean Dim MapNumAs Long, NpcNum As Long Dim X AsLong Dim Y AsLong CanNpcAttackPet= False ' Check forsubscript out of range If MapNpcNum<= 0 Or MapNpcNum > MAX_MAP_NPCS Or IsPlaying(Index) = False Then ExitFunction End If ' Check forsubscript out of range IfMapNpc(GetPlayerMap(Index), MapNpcNum).num <= 0 Then ExitFunction End If MapNum =Player(Index).Pet.Map NpcNum =MapNpc(MapNum, MapNpcNum).num ' Make surethe npc isn't already dead IfMapNpc(MapNum, MapNpcNum).HP <= 0 Then ExitFunction End If ' Make surenpcs dont attack more then once a second IfGetTickCount < MapNpc(MapNum, MapNpcNum).AttackTimer + 1000 Then ExitFunction End If MapNpc(MapNum, MapNpcNum).AttackTimer = GetTickCount ' Make surethey are on the same map IfIsPlaying(Index) Then IfNpcNum > 0 Then X =DirToX(MapNpc(MapNum, MapNpcNum).X, MapNpc(MapNum, MapNpcNum).Dir) Y =DirToY(MapNpc(MapNum, MapNpcNum).Y, MapNpc(MapNum, MapNpcNum).Dir) 'Check if at same coordinates If(Player(Index).Pet.Y = Y) And (Player(Index).Pet.X = X) Then CanNpcAttackPet = True EndIf End If End If End Function Function CanPetAttackNpc(ByVal Attacker As Long, ByValMapNpcNum As Long) As Boolean Dim MapNumAs Long, NpcNum As Long Dim X AsLong Dim Y AsLong Dim Dir AsLong CanPetAttackNpc = False ' Check forsubscript out of range If IsPlaying(Attacker)= False Or MapNpcNum <= 0 Or MapNpcNum > MAX_MAP_NPCS Then ExitFunction End If ' Check forsubscript out of range IfMapNpc(Player(Attacker).Pet.Map, MapNpcNum).num <= 0 Then ExitFunction End If MapNum =Player(Attacker).Pet.Map NpcNum =MapNpc(MapNum, MapNpcNum).num ' Make surethe npc isn't already dead IfMapNpc(MapNum, MapNpcNum).HP <= 0 Then ExitFunction End If ' Make surethey are on the same map IfIsPlaying(Attacker) Then IfNpcNum > 0 And GetTickCount > Player(Attacker).Pet.AttackTimer + 1000Then IfNpc(NpcNum).Behavior <> NPC_BEHAVIOR_FRIENDLY And Npc(NpcNum).Behavior<> NPC_BEHAVIOR_SHOPKEEPER Then For Dir = 0 To 3 ' Check if at same coordinates X = DirToX(Player(Attacker).Pet.X, Dir) Y = DirToY(Player(Attacker).Pet.Y, Dir) If (MapNpc(MapNum, MapNpcNum).Y = Y) And (MapNpc(MapNum, MapNpcNum).X =X) Then CanPetAttackNpc = True End If Next EndIf End If End If End Function Function CanPetMove(ByVal PetNum As Long, ByVal Dir)As Boolean Dim X AsLong, Y As Long Dim i AsLong, Packet As String CanPetMove =False If PetNum<= 0 Or PetNum > MAX_PLAYERS Or Dir < DIR_UP Or Dir > DIR_RIGHTThen Exit Function X =DirToX(Player(PetNum).Pet.X, Dir) Y =DirToY(Player(PetNum).Pet.Y, Dir) If NotIsValid(X, Y) Then If Dir =DIR_UP Then IfMap(Player(PetNum).Pet.Map).Up > 0 And Map(Player(PetNum).Pet.Map).Up =Player(PetNum).Pet.MapToGo Then CanPetMove = True End If End If If Dir =DIR_DOWN Then IfMap(Player(PetNum).Pet.Map).Down > 0 And Map(Player(PetNum).Pet.Map).Down =Player(PetNum).Pet.MapToGo Then CanPetMove = True EndIf End If If Dir =DIR_LEFT Then IfMap(Player(PetNum).Pet.Map).Left > 0 And Map(Player(PetNum).Pet.Map).Left =Player(PetNum).Pet.MapToGo Then CanPetMove = True EndIf End If If Dir =DIR_RIGHT Then IfMap(Player(PetNum).Pet.Map).Right > 0 And Map(Player(PetNum).Pet.Map).Right= Player(PetNum).Pet.MapToGo Then 'i = Player(PetNum).Pet.Map 'Player(PetNum).Pet.Map = Map(Player(PetNum).Pet.Map).Right 'Packet = PETDATA_CHAR & SEP_CHAR 'Packet = Packet & PetNum & SEP_CHAR 'Packet = Packet & Player(PetNum).Pet.Alive & SEP_CHAR 'Packet = Packet & Player(PetNum).Pet.Map & SEP_CHAR 'Packet = Packet & Player(PetNum).Pet.x& SEP_CHAR 'Packet = Packet & Player(PetNum).Pet.y & SEP_CHAR 'Packet = Packet & Player(PetNum).Pet.Dir & SEP_CHAR 'Packet = Packet & Player(PetNum).Pet.Sprite & SEP_CHAR 'Packet = Packet & Player(PetNum).Pet.HP & SEP_CHAR 'Packet = Packet & Player(PetNum).Pet.Level * 5 & SEP_CHAR 'Packet = Packet & END_CHAR 'Call SendDataToMap(Player(PetNum).Pet.Map, Packet) 'Call SendDataToMap(i, Packet) CanPetMove = True EndIf End If ExitFunction End If IfGrid(Player(PetNum).Pet.Map).Loc(X, Y).Blocked = True Then Exit Function CanPetMove =True End Function

Na Sub CastSpell Adicionar

Código:: If Spell(SpellNum).Type = SPELL_TYPE_PET Then Player(Index).Pet.Alive = YES Player(Index).Pet.Sprite = Spell(SpellNum).Data1 Player(Index).Pet.Dir = DIR_UP Player(Index).Pet.Map = GetPlayerMap(Index) Player(Index).Pet.MapToGo = 0 Player(Index).Pet.X = GetPlayerX(Index) + Int(Rnd * 3 - 1) IfPlayer(Index).Pet.X < 0 Or Player(Index).Pet.X > MAX_MAPX ThenPlayer(Index).Pet.X = GetPlayerX(Index) Player(Index).Pet.XToGo = -1 Player(Index).Pet.Y = GetPlayerY(Index) + Int(Rnd * 3 - 1) IfPlayer(Index).Pet.Y < 0 Or Player(Index).Pet.Y > MAX_MAPY ThenPlayer(Index).Pet.Y = GetPlayerY(Index) Player(Index).Pet.YToGo = -1 Player(Index).Pet.Level = Spell(SpellNum).Range Player(Index).Pet.HP = Player(Index).Pet.Level * 5 CallAddToGrid(Player(Index).Pet.Map, Player(Index).Pet.X, Player(Index).Pet.Y) Packet =PETDATA_CHAR & SEP_CHAR Packet =Packet & Index & SEP_CHAR Packet =Packet & Player(Index).Pet.Alive & SEP_CHAR Packet =Packet & Player(Index).Pet.Map & SEP_CHAR Packet =Packet & Player(Index).Pet.X & SEP_CHAR Packet =Packet & Player(Index).Pet.Y & SEP_CHAR Packet =Packet & Player(Index).Pet.Dir & SEP_CHAR Packet =Packet & Player(Index).Pet.Sprite & SEP_CHAR Packet =Packet & Player(Index).Pet.HP & SEP_CHAR Packet =Packet & Player(Index).Pet.Level * 5 & SEP_CHAR Packet =Packet & END_CHAR ' Excusethe messy code, I'm rushing CallPlayerMsg(Index, "You summon a beast", White) CallSendDataToMap(GetPlayerMap(Index), Packet) CallSetPlayerMP(Index, GetPlayerMP(Index) - Spell(SpellNum).MPCost) CallSendMP(Index) Casted =True Exit Sub End If

Na Sub LeftGame Adicionar

Código:: IfPlayer(Index).Pet.Alive = YES Then CallTakeFromGrid(GetPlayerMap(Index), Player(Index).Pet.X, Player(Index).Pet.Y) End If

por Lucas Lôpo Ter 23 Nov 2010, 20:41

Adicionar no final do ModGameLogic

Código:: Sub NpcAttackPet(ByVal MapNpcNum As Long, _ ByVal VictimAs Long, _ ByVal DamageAs Long) Dim Name AsString Dim MapNumAs Long Dim PacketAs String ' Check forsubscript out of range If MapNpcNum<= 0 Or MapNpcNum > MAX_MAP_NPCS Or IsPlaying(Victim) = False Or Damage< 0 Then Exit Sub End If ' Check forsubscript out of range IfMapNpc(Player(Victim).Pet.Map, MapNpcNum).num <= 0 Then Exit Sub End If ' Send thispacket so they can see the npc attacking CallSendDataToMap(Player(Victim).Pet.Map, NPCATTACKPET_CHAR & SEP_CHAR &MapNpcNum & SEP_CHAR & Victim & END_CHAR) MapNum =Player(Victim).Pet.Map Name =Trim$(Npc(MapNpc(MapNum, MapNpcNum).num).Name) If Damage>= Player(Victim).Pet.HP Then CallBattleMsg(Victim, "Your pet died!", Red, 1) Player(Victim).Pet.Alive= NO CallTakeFromGrid(Player(Victim).Pet.Map, Player(Victim).Pet.X,Player(Victim).Pet.Y) MapNpc(MapNum, MapNpcNum).Target = 0 Packet =PETDATA_CHAR & SEP_CHAR Packet =Packet & Victim & SEP_CHAR Packet = Packet &Player(Victim).Pet.Alive & SEP_CHAR Packet =Packet & Player(Victim).Pet.Map & SEP_CHAR Packet =Packet & Player(Victim).Pet.X & SEP_CHAR Packet =Packet & Player(Victim).Pet.Y & SEP_CHAR Packet =Packet & Player(Victim).Pet.Dir & SEP_CHAR Packet =Packet & Player(Victim).Pet.Sprite & SEP_CHAR Packet =Packet & Player(Victim).Pet.HP & SEP_CHAR Packet =Packet & Player(Victim).Pet.Level * 5 & SEP_CHAR Packet =Packet & END_CHAR CallSendDataTo(Victim, Packet) CallSendDataToMapBut(Victim, Player(Victim).Pet.Map, Packet) Else ' Petnot dead, just do the damage Player(Victim).Pet.HP = Player(Victim).Pet.HP - Damage Packet =PETHP_CHAR & SEP_CHAR & Player(Victim).Pet.Level * 5 & SEP_CHAR& Player(Victim).Pet.HP & END_CHAR CallSendDataTo(Victim, Packet) End If 'CallSendDataTo(Victim, BLITNPCDMGPET_CHAR & SEP_CHAR & Damage &END_CHAR) End Sub Sub PetAttackNpc(ByVal Attacker As Long, _ ByValMapNpcNum As Long, _ ByVal DamageAs Long) Dim Name AsString Dim N AsLong, i As Long Dim MapNumAs Long, NpcNum As Long Dim Dir AsLong, X As Long, Y As Long Dim PacketAs String ' Check forsubscript out of range IfIsPlaying(Attacker) = False Or MapNpcNum <= 0 Or MapNpcNum > MAX_MAP_NPCSOr Damage < 0 Then Exit Sub End If ' Send thispacket so they can see the pet attacking CallSendDataToMap(Player(Attacker).Pet.Map, PETATTACKNPC_CHAR & SEP_CHAR &Attacker & SEP_CHAR & MapNpcNum & END_CHAR) MapNum =Player(Attacker).Pet.Map NpcNum = MapNpc(MapNum, MapNpcNum).num Name= Trim$(Npc(NpcNum).Name) MapNpc(MapNum,MapNpcNum).LastAttack = GetTickCount For Dir = 0To 3 IfMapNpc(MapNum, NpcNum).X = DirToX(Player(Attacker).Pet.X, Dir) AndMapNpc(MapNum, NpcNum).Y = DirToY(Player(Attacker).Pet.Y, Dir) Then Packet = CHANGEPETDIR_CHAR & SEP_CHAR & Dir & SEP_CHAR &Attacker & END_CHAR CallSendDataToMap(Player(Attacker).Pet.Map, Packet) End If Next If Damage>= MapNpc(MapNum, MapNpcNum).HP Then For i =1 To MAX_NPC_DROPS 'Drop the goods if they get it N =Int(Rnd * Npc(NpcNum).ItemNPC(i).Chance) + 1 If N= 1 Then Call SpawnItem(Npc(NpcNum).ItemNPC(i).ItemNum,Npc(NpcNum).ItemNPC(i).ItemValue, MapNum, MapNpc(MapNum, MapNpcNum).X,MapNpc(MapNum, MapNpcNum).Y) EndIf Next CallBattleMsg(Attacker, "Your pet killed " & CheckGrammar(Name) &" " & Name & ".", Red, 1) ' Nowset HP to 0 so we know to actually kill them in the server loop (this preventssubscript out of range) MapNpc(MapNum, MapNpcNum).num = 0 MapNpc(MapNum, MapNpcNum).SpawnWait = GetTickCount MapNpc(MapNum, MapNpcNum).HP = 0 CallSendDataToMap(MapNum, NPCDEAD_CHAR & SEP_CHAR & MapNpcNum &END_CHAR) CallTakeFromGrid(MapNum, MapNpc(MapNum, MapNpcNum).X, MapNpc(MapNum, MapNpcNum).Y) ' Checkif target is npc that died and if so set target to 0 IfPlayer(Attacker).Pet.TargetType = TARGET_TYPE_NPC AndPlayer(Attacker).Pet.Target = MapNpcNum Then Player(Attacker).Pet.Target= 0 Player(Attacker).Pet.TargetType = 0 Player(Attacker).Pet.MapToGo = 0 End If Else ' NPCnot dead, just do the damage MapNpc(MapNum, MapNpcNum).HP = MapNpc(MapNum, MapNpcNum).HP - Damage ' Setthe NPC target to the pet MapNpc(MapNum, MapNpcNum).TargetType = TARGET_TYPE_PET MapNpc(MapNum, MapNpcNum).Target = Attacker ' Nowcheck for guard ai and if so have all onmap guards come after'm IfNpc(MapNpc(MapNum, MapNpcNum).num).Behavior = NPC_BEHAVIOR_GUARD Then Fori = 1 To MAX_MAP_NPCS IfMapNpc(MapNum, i).num = MapNpc(MapNum, MapNpcNum).num Then MapNpc(MapNum, i).TargetType = TARGET_TYPE_PET MapNpc(MapNum, i).Target = Attacker End If Next End If End If 'CallSendDataToMap(MapNum, npchp_CHAR & SEP_CHAR & MapNpcNum & SEP_CHAR& MapNpc(MapNum, MapNpcNum).HP & SEP_CHAR & GetNpcMaxHP(MapNpc(MapNum,MapNpcNum).num) & END_CHAR) ' Resetattack timer Player(Attacker).Pet.AttackTimer = GetTickCount End Sub Sub PetMove(ByVal PetNum As Long, _ ByVal Dir AsLong, _ ByValMovement As Long) Dim PacketAs String Dim X As Long Dim Y AsLong Dim i AsLong IfGetPlayerMap(PetNum) <= 0 Or GetPlayerMap(PetNum) > MAX_MAPS Or PetNum<= 0 Or PetNum > MAX_PLAYERS Or Dir < DIR_UP Or Dir > DIR_RIGHT OrMovement < 1 Or Movement > 2 Then Exit Sub Player(PetNum).Pet.Dir = Dir X =DirToX(Player(PetNum).Pet.X, Dir) Y =DirToY(Player(PetNum).Pet.Y, Dir) IfIsValid(X, Y) Then IfGrid(Player(PetNum).Pet.Map).Loc(X, Y).Blocked = True Then Packet = CHANGEPETDIR_CHAR & SEP_CHAR & Dir & SEP_CHAR &PetNum & END_CHAR CallSendDataToMap(Player(PetNum).Pet.Map, Packet) ExitSub End If CallUpdateGrid(Player(PetNum).Pet.Map, Player(PetNum).Pet.X, Player(PetNum).Pet.Y,Player(PetNum).Pet.Map, X, Y) Player(PetNum).Pet.Y = Y Player(PetNum).Pet.X = X Packet =PETMOVE_CHAR & SEP_CHAR & PetNum & SEP_CHAR & X & SEP_CHAR& Y & SEP_CHAR & Dir & SEP_CHAR & Movement & END_CHAR CallSendDataToMap(Player(PetNum).Pet.Map, Packet) Else i =Player(PetNum).Pet.Map If Dir =DIR_UP Then Player(PetNum).Pet.Map = Map(Player(PetNum).Pet.Map).Up Player(PetNum).Pet.Y = MAX_MAPY End If If Dir =DIR_DOWN Then Player(PetNum).Pet.Map= Map(Player(PetNum).Pet.Map).Down Player(PetNum).Pet.Y = 0 End If If Dir =DIR_LEFT Then Player(PetNum).Pet.Map = Map(Player(PetNum).Pet.Map).Left Player(PetNum).Pet.X = MAX_MAPX End If If Dir =DIR_RIGHT Then Player(PetNum).Pet.Map = Map(Player(PetNum).Pet.Map).Right Player(PetNum).Pet.X = 0 End If Packet =PETDATA_CHAR & SEP_CHAR Packet =Packet & PetNum & SEP_CHAR Packet =Packet & Player(PetNum).Pet.Alive & SEP_CHAR Packet =Packet & Player(PetNum).Pet.Map & SEP_CHAR Packet =Packet & Player(PetNum).Pet.X & SEP_CHAR Packet =Packet & Player(PetNum).Pet.Y & SEP_CHAR Packet =Packet & Player(PetNum).Pet.Dir & SEP_CHAR Packet =Packet & Player(PetNum).Pet.Sprite & SEP_CHAR Packet =Packet & Player(PetNum).Pet.HP & SEP_CHAR Packet =Packet & Player(PetNum).Pet.Level * 5 & SEP_CHAR Packet =Packet & END_CHAR CallSendDataToMap(Player(PetNum).Pet.Map, Packet) CallSendDataToMap(i, Packet) End If End Sub

Substituir a SubPlayerMove Por

Código:: Sub PlayerMove(ByVal Index As Long, _ ByVal Dir AsLong, _ ByValMovement As Long) Dim PacketAs String Dim MapNumAs Long Dim X AsLong Dim Y AsLong Dim oldx AsLong Dim oldy AsLong Dim OldMapAs Long Dim Moved AsByte ' They triedto hack 'If Moved =NO Then 'CallHackingAttempt(index, "Position Modification") 'Exit Sub 'End If ' Check forsubscript out of range IfIsPlaying(Index) = False Or Dir < DIR_UP Or Dir > DIR_RIGHT Or Movement< 1 Or Movement > 2 Then Exit Sub End If CallSetPlayerDir(Index, Dir) Moved = NO X =DirToX(GetPlayerX(Index), Dir) Y =DirToY(GetPlayerY(Index), Dir) CallTakeFromGrid(GetPlayerMap(Index), GetPlayerX(Index), GetPlayerY(Index)) ' Move theplayer's pet out of the way if we need to IfPlayer(Index).Pet.Alive = YES Then IfPlayer(Index).Pet.Map = GetPlayerMap(Index) And Player(Index).Pet.X = X AndPlayer(Index).Pet.Y = Y Then IfGrid(GetPlayerMap(Index)).Loc(DirToX(X, Dir), DirToY(Y, Dir)).Blocked = FalseThen 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_CHAR & 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) EndIf End If End If ' Check to make sure not outside of boundries IfIsValid(X, Y) Then ' Checkto make sure that the tile is walkable IfGrid(GetPlayerMap(Index)).Loc(X, Y).Blocked = False Then 'Check to see if the tile is a key and if it is check if its opened If(Map(GetPlayerMap(Index)).Tile(X, Y).Type <> TILE_TYPE_KEY OrMap(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_CHAR & 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 EndIf End If Else ' Checkto see if we can move them to the another map IfMap(GetPlayerMap(Index)).Up > 0 And Dir = DIR_UP Then CallPlayerWarp(Index, Map(GetPlayerMap(Index)).Up, GetPlayerX(Index), MAX_MAPY) Moved = YES End If IfMap(GetPlayerMap(Index)).Down > 0 And Dir = DIR_DOWN Then CallPlayerWarp(Index, Map(GetPlayerMap(Index)).Down, GetPlayerX(Index), 0) Moved = YES End If IfMap(GetPlayerMap(Index)).Left > 0 And Dir = DIR_LEFT Then CallPlayerWarp(Index, Map(GetPlayerMap(Index)).Left, MAX_MAPX, GetPlayerY(Index)) Moved = YES End If IfMap(GetPlayerMap(Index)).Right > 0 And Dir = DIR_RIGHT Then CallPlayerWarp(Index, Map(GetPlayerMap(Index)).Right, 0, GetPlayerY(Index)) Moved = YES End If End If If Moved =NO Then Call SendPlayerXY(Index) IfGetPlayerX(Index) < 0 Or GetPlayerY(Index) < 0 Or GetPlayerX(Index) >MAX_MAPX Or GetPlayerY(Index) > MAX_MAPY Or GetPlayerMap(Index) <= 0 Then CallHackingAttempt(Index, vbNullString) Exit Sub End If 'healingtiles code IfMap(GetPlayerMap(Index)).Tile(GetPlayerX(Index), GetPlayerY(Index)).Type =TILE_TYPE_HEAL Then CallSetPlayerHP(Index, GetPlayerMaxHP(Index)) CallSendHP(Index) CallSetPlayerMP(Index, GetPlayerMaxMP(Index)) CallSendMP(Index) CallSetPlayerSP(Index, GetPlayerMaxSP(Index)) CallSendSP(Index) CallPlayerMsg(Index, "You feel a sudden rush through your body as you regainstrength!", BrightGreen) End If 'Check forkill tile, and if so kill them IfMap(GetPlayerMap(Index)).Tile(GetPlayerX(Index), GetPlayerY(Index)).Type =TILE_TYPE_KILL Then CallSetPlayerHP(Index, 0) CallPlayerMsg(Index, "You embrace the cold finger of death; and feel your lifeextinguished", BrightRed) ' Warp player away IfSCRIPTING = 1 Then MyScript.ExecuteStatement "Scripts\Main.txt", "OnDeath" & Index Else CallPlayerWarp(Index, START_MAP, START_X, START_Y) End If CallSetPlayerHP(Index, GetPlayerMaxHP(Index)) CallSetPlayerMP(Index, GetPlayerMaxMP(Index)) CallSetPlayerSP(Index, GetPlayerMaxSP(Index)) CallSendHP(Index) CallSendMP(Index) CallSendSP(Index) Moved =YES End If IfIsValid(X, Y) Then IfMap(GetPlayerMap(Index)).Tile(X, Y).Type = TILE_TYPE_DOOR Then IfTempTile(GetPlayerMap(Index)).DoorOpen(X, Y) = NO Then TempTile(GetPlayerMap(Index)).DoorOpen(X, Y) = YES TempTile(GetPlayerMap(Index)).DoorTimer = GetTickCount Call SendDataToMap(GetPlayerMap(Index), MAPKEY_CHAR & SEP_CHAR &X & SEP_CHAR & Y & SEP_CHAR & 1 & END_CHAR) 'Call SendDataToMap(GetPlayerMap(Index), SOUND_CHAR & SEP_CHAR &"Key" & END_CHAR) Call SendSound(Index, KEY_SOUND, SDTM) EndIf End If End If ' Check tosee if the tile is a warp tile, and if so warp them IfMap(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 CallPlayerWarp(Index, MapNum, X, Y) Moved =YES End If CallAddToGrid(GetPlayerMap(Index), GetPlayerX(Index), GetPlayerY(Index)) ' Check forkey trigger open IfMap(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 IfMap(GetPlayerMap(Index)).Tile(X, Y).Type = TILE_TYPE_KEY AndTempTile(GetPlayerMap(Index)).DoorOpen(X, Y) = NO Then TempTile(GetPlayerMap(Index)).DoorOpen(X, Y) = YES TempTile(GetPlayerMap(Index)).DoorTimer = GetTickCount CallSendDataToMap(GetPlayerMap(Index), MAPKEY_CHAR & SEP_CHAR & X &SEP_CHAR & Y & SEP_CHAR & 1 & END_CHAR) IfTrim$(Map(GetPlayerMap(Index)).Tile(GetPlayerX(Index), GetPlayerY(Index)).String1)= vbNullString Then Call MapMsg(GetPlayerMap(Index), "A door has been unlocked!",White) Else Call MapMsg(GetPlayerMap(Index),Trim$(Map(GetPlayerMap(Index)).Tile(GetPlayerX(Index), GetPlayerY(Index)).String1),White) EndIf 'Call SendDataToMap(GetPlayerMap(Index), SOUND_CHAR & SEP_CHAR &"Key" & END_CHAR) CallSendSound(Index, KEY_SOUND, SDTM) End If End If ' Check forshop IfMap(GetPlayerMap(Index)).Tile(GetPlayerX(Index), GetPlayerY(Index)).Type =TILE_TYPE_SHOP Then IfMap(GetPlayerMap(Index)).Tile(GetPlayerX(Index), GetPlayerY(Index)).Data1 >0 Then CallSendTrade(Index, Map(GetPlayerMap(Index)).Tile(GetPlayerX(Index),GetPlayerY(Index)).Data1) Else CallPlayerMsg(Index, "There is no shop here.", BrightRed) End If End If ' Check ifplayer stepped on sprite changing tile IfMap(GetPlayerMap(Index)).Tile(GetPlayerX(Index), GetPlayerY(Index)).Type =TILE_TYPE_SPRITE_CHANGE Then IfGetPlayerSprite(Index) = Map(GetPlayerMap(Index)).Tile(GetPlayerX(Index),GetPlayerY(Index)).Data1 Then CallPlayerMsg(Index, "You already have this sprite!", BrightRed) ExitSub Else IfMap(GetPlayerMap(Index)).Tile(GetPlayerX(Index), GetPlayerY(Index)).Data2 = 0Then Call SendDataTo(Index, SPRITECHANGE_CHAR & SEP_CHAR & 0 &END_CHAR) Else IfItem(Map(GetPlayerMap(Index)).Tile(GetPlayerX(Index),GetPlayerY(Index)).Data2).Type = ITEM_TYPE_CURRENCY Then Call PlayerMsg(Index, "This sprite will cost you " &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, "This sprite will cost you " &CheckGrammar(Trim$(Item(Map(GetPlayerMap(Index)).Tile(GetPlayerX(Index),GetPlayerY(Index)).Data2).Name)) & " " &Trim$(Item(Map(GetPlayerMap(Index)).Tile(GetPlayerX(Index),GetPlayerY(Index)).Data2).Name) & "!", Yellow) End If Call SendDataTo(Index, SPRITECHANGE_CHAR & SEP_CHAR & 1 &END_CHAR) EndIf End If End If ' Check ifplayer stepped on sprite changing tile IfMap(GetPlayerMap(Index)).Tile(GetPlayerX(Index), GetPlayerY(Index)).Type =TILE_TYPE_CLASS_CHANGE Then IfMap(GetPlayerMap(Index)).Tile(GetPlayerX(Index), GetPlayerY(Index)).Data2 >0 Then IfGetPlayerClass(Index) <> Map(GetPlayerMap(Index)).Tile(GetPlayerX(Index),GetPlayerY(Index)).Data2 Then Call PlayerMsg(Index, "You arent the required class!",BrightRed) Exit Sub EndIf End If IfGetPlayerClass(Index) = Map(GetPlayerMap(Index)).Tile(GetPlayerX(Index),GetPlayerY(Index)).Data1 Then CallPlayerMsg(Index, "You are already this class!", BrightRed) Else IfPlayer(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)).FemaleSpriteThen Call SetPlayerSprite(Index,Class(Map(GetPlayerMap(Index)).Tile(GetPlayerX(Index),GetPlayerY(Index)).Data1).FemaleSprite) End If EndIf Call SetPlayerSTR(Index,(Player(Index).Char(Player(Index).CharNum).STR -Class(GetPlayerClass(Index)).STR)) CallSetPlayerDEF(Index, (Player(Index).Char(Player(Index).CharNum).DEF -Class(GetPlayerClass(Index)).DEF)) CallSetPlayerMAGI(Index, (Player(Index).Char(Player(Index).CharNum).Magi -Class(GetPlayerClass(Index)).Magi)) CallSetPlayerSPEED(Index, (Player(Index).Char(Player(Index).CharNum).Speed -Class(GetPlayerClass(Index)).Speed)) CallSetPlayerClass(Index, Map(GetPlayerMap(Index)).Tile(GetPlayerX(Index),GetPlayerY(Index)).Data1) CallSetPlayerSTR(Index, (Player(Index).Char(Player(Index).CharNum).STR +Class(GetPlayerClass(Index)).STR)) CallSetPlayerDEF(Index, (Player(Index).Char(Player(Index).CharNum).DEF +Class(GetPlayerClass(Index)).DEF)) CallSetPlayerMAGI(Index, (Player(Index).Char(Player(Index).CharNum).Magi +Class(GetPlayerClass(Index)).Magi)) CallSetPlayerSPEED(Index, (Player(Index).Char(Player(Index).CharNum).Speed +Class(GetPlayerClass(Index)).Speed)) CallPlayerMsg(Index, "Your new class is " &CheckGrammar(Trim$(Class(GetPlayerClass(Index)).Name)) & " "& Trim$(Class(GetPlayerClass(Index)).Name) & "!", BrightGreen) Call SendStats(Index) CallSendHP(Index) CallSendMP(Index) CallSendSP(Index) CallSendDataToMap(GetPlayerMap(Index), CHECKSPRITE_CHAR & SEP_CHAR & Index& SEP_CHAR & GetPlayerSprite(Index) & END_CHAR) End If End If ' Check ifplayer stepped on notice tile IfMap(GetPlayerMap(Index)).Tile(GetPlayerX(Index), GetPlayerY(Index)).Type =TILE_TYPE_NOTICE Then IfTrim$(Map(GetPlayerMap(Index)).Tile(GetPlayerX(Index), GetPlayerY(Index)).String1)<> vbNullString Then CallPlayerMsg(Index, Trim$(Map(GetPlayerMap(Index)).Tile(GetPlayerX(Index),GetPlayerY(Index)).String1), Black) End If IfTrim$(Map(GetPlayerMap(Index)).Tile(GetPlayerX(Index), GetPlayerY(Index)).String2)<> vbNullString Then CallPlayerMsg(Index, Trim$(Map(GetPlayerMap(Index)).Tile(GetPlayerX(Index),GetPlayerY(Index)).String2), Grey) End If CallSendDataToMap(GetPlayerMap(Index), SOUND_CHAR & SEP_CHAR &Map(GetPlayerMap(Index)).Tile(GetPlayerX(Index), GetPlayerY(Index)).String3& END_CHAR) End If ' Check ifplayer stepped on sound tile IfMap(GetPlayerMap(Index)).Tile(GetPlayerX(Index), GetPlayerY(Index)).Type =TILE_TYPE_SOUND Then CallSendDataToMap(GetPlayerMap(Index), SOUND_CHAR & SEP_CHAR &Map(GetPlayerMap(Index)).Tile(GetPlayerX(Index), GetPlayerY(Index)).String1& END_CHAR) End If If SCRIPTING= 1 Then IfMap(GetPlayerMap(Index)).Tile(GetPlayerX(Index), GetPlayerY(Index)).Type =TILE_TYPE_SCRIPTED Then MyScript.ExecuteStatement "Scripts\Main.txt","ScriptedTile " & Index & "," &Map(GetPlayerMap(Index)).Tile(GetPlayerX(Index), GetPlayerY(Index)).Data1 End If End If End Sub

Substitua toda a SubPlayerWarp Por

Código:: Sub PlayerWarp(ByVal Index As Long, ByVal MapNum AsLong, ByVal X As Long, ByVal Y As Long, Optional sound As Boolean = True) Dim OldMapAs Long ' Check forsubscript out of range IfIsPlaying(Index) = False Or MapNum <= 0 Or MapNum > MAX_MAPS Then Exit Sub End If ' Check ifthere was an npc on the map the player is leaving, and if so say goodbye 'IfTrim$(Shop(ShopNum).LeaveSay) <> vbNullString Then 'CallPlayerMsg(Index, Trim$(Shop(ShopNum).Name) & ": " &Trim$(Shop(ShopNum).LeaveSay) & vbNullString, SayColor) 'End If ' Save oldmap to send erase player data to OldMap =GetPlayerMap(Index) CallSendLeaveMap(Index, OldMap) CallUpdateGrid(OldMap, GetPlayerX(Index), GetPlayerY(Index), MapNum, X, Y) CallSetPlayerMap(Index, MapNum) CallSetPlayerX(Index, X) CallSetPlayerY(Index, Y) IfPlayer(Index).Pet.Alive = YES Then Player(Index).Pet.MapToGo = -1 Player(Index).Pet.XToGo = -1 Player(Index).Pet.YToGo = -1 Player(Index).Pet.Map = MapNum Player(Index).Pet.X = X Player(Index).Pet.Y = Y End If ' Now wecheck if there were any players left on the map the player just left, and ifnot stop processing npcs IfGetTotalMapPlayers(OldMap) = 0 Then PlayersOnMap(OldMap) = NO End If ' Sets it sowe know to process npcs on the map PlayersOnMap(MapNum) = YES Player(Index).GettingMap = YES 'If soundThen Call SendDataToMap(GetPlayerMap(Index), SOUND_CHAR & SEP_CHAR &"Warp" & END_CHAR) If soundThen Call SendSound(Index, WARP_SOUND, SDTM) CallSendDataTo(Index, CHECKFORMAP_CHAR & SEP_CHAR & MapNum & SEP_CHAR& Map(MapNum).Revision & END_CHAR) CallSendInventory(Index) Call SendWornEquipment(Index) End Sub

Acho que é isso.

Creditos : Do dono.

por Karlos Qua 24 Nov 2010, 05:24

boa, super criativo da sua parte, estou lhe dando + 1 de credito por cada post teu nesse tópico . Very Happy

por Raicon Qua 24 Nov 2010, 05:51

O.o fiquei assustado.
Vc que fez?

por SkyZero Qua 24 Nov 2010, 09:14

Nossa . Testado e aprovado .

é o mesmo estilo de sistema do elysium não ?

por Lucas Lôpo Qua 24 Nov 2010, 09:15

Não quem fez foi o Visual Basic '-'

Apenas 1 credito ???
Aff isso era pra ser 20 credito por cada postagem e por pessoa '-'
não posto mais nada aqui [ALL]Pet Systen 36977

por SkyZero Qua 24 Nov 2010, 09:18

Acabei de Creditar você =]

por orochymaru67 Qua 24 Nov 2010, 11:57

isso naum funciona pro eclipse 2.7 aki nem tem algumas coisas que vc pos ae
faz um tuto pra 2.7 pode ate ser mais simples!

por Lucas Lôpo Qua 24 Nov 2010, 17:59

Faz tu , ja dei as dicas ai nesse sistema agora usa sua cabeça.

por MrMota Ter 30 Nov 2010, 20:03

Kra, to impressionado! Deu uma preguiça de fazer hj... Amanhã faço. Razz

Parabéns e +1cred

por Raicon Qua 01 Dez 2010, 08:30

Nem testei mas parece bom. +1 cred

por Lucas Lôpo Qua 01 Dez 2010, 21:38

Acho melhor testarem '-'

por gin Ter 07 Dez 2010, 14:33

Vou testar e fazer umas ganbiaras pra vê se pega no 2.7

por juichi Ter 07 Dez 2010, 14:37

estou com medo desse script '-'

nem vou testar, mas msm assim levou meu cred ^^

(eu uso supernova, entao eu teria q fazer algumas alteraçoes nesse baguio, mas eu nao manjo nda de VB)

por gin Qua 08 Dez 2010, 06:11

eu tambem não consegui uma parte do TARGET que nem encontrei XD

por Lucas Roberto Qui 09 Dez 2010, 13:09

Bom como voces não sabe ler as regras
Clique abaixo e Le Uu
Regras Para Seção de Tutoriais Eclipse.

Vou ter que começar Punir

Bom você tem 24hs para deixar o topico com as REGRAS

Uu

Equipe MMORPGBR

por Lucas Lôpo Sex 10 Dez 2010, 18:24

@Lukinha~ escreveu:Bom como voces não sabe ler as regras
Clique abaixo e Le Uu
Regras Para Seção de Tutoriais Eclipse.

Vou ter que começar Punir

Bom você tem 24hs para deixar o topico com as REGRAS

Uu

Equipe MMORPGBR

Tu ta falando isso com quem?

por gin Sex 10 Dez 2010, 21:37

tambem não entendi... Tipo ele falo ”ajeitar o topico” suponho quem criou! Mais existe uma contra que ele disse vocês... E não disse qual motivo das regras... N~so entendi tambem. Li td os postś n entendi. @.@

por Lucas Roberto Sáb 11 Dez 2010, 17:44

Tu ta falando isso com quem?

e vc mesmo

le as regras de apostagem Uu

tambem não entendi... Tipo ele falo ”ajeitar o topico” suponho quem criou! Mais existe uma contra que ele disse vocês... E não disse qual motivo das regras... N~so entendi tambem. Li td os postś n entendi. @.@

Uu não e para voce inteder Uu não e com voce fica tranquilo

Lupo ageita ae como diz as regras [ALL]Pet Systen 539285

por SkyZero Sáb 11 Dez 2010, 17:47

Eu acho que está bem dentro das Regras ??

Lopo só ponhar la [EEB] Pet System , etc .

por Lucas Roberto Sáb 11 Dez 2010, 18:00

Eu acho que está bem dentro das Regras ??

Lopo só ponhar la [EEB] Pet System , etc .

se esta nas regras pq voce falow que e so colocar [EEB]

acontece que [EEB] esta em umas das regras feita pelo "Ener" e "Lendario" mesmo que e so isso mais e uma regras entao tem que respeitar

por Lucas Lôpo Dom 12 Dez 2010, 17:10

Acho melhor vocês pararem de off - topic no meu topico , se continuarem irei punir todos aqui.

por Lucas Roberto Dom 12 Dez 2010, 19:37

Cara por favor arrume seu topico não custa nada por [ALL] etc...

por Conteúdo patrocinado

[ALL]Pet Systen

[ALL]Pet Systen

Re: [ALL]Pet Systen

Re: [ALL]Pet Systen

Re: [ALL]Pet Systen

Re: [ALL]Pet Systen

Re: [ALL]Pet Systen

Re: [ALL]Pet Systen

Re: [ALL]Pet Systen

Re: [ALL]Pet Systen

Re: [ALL]Pet Systen

Re: [ALL]Pet Systen

Re: [ALL]Pet Systen

Re: [ALL]Pet Systen

Re: [ALL]Pet Systen

Re: [ALL]Pet Systen

Re: [ALL]Pet Systen

Re: [ALL]Pet Systen

Re: [ALL]Pet Systen

Re: [ALL]Pet Systen

Re: [ALL]Pet Systen

Re: [ALL]Pet Systen

Re: [ALL]Pet Systen

Re: [ALL]Pet Systen

Re: [ALL]Pet Systen

Re: [ALL]Pet Systen

Re: [ALL]Pet Systen