?? modmainserver.vb.svn-base
字號:
'If Players Local Players Doesnt Contain the Local Players ID
If Not Player.LocalObjects.ContainsValue(tPlayerID) And Not Added.Contains(tPlayerID) Then
tPlayer = ObjectList(tPlayerID)
If tPlayer.LocalObjects.ContainsValue(Player.StateId) = False Then
'Dim FreeSlot As Integer = GetFreePlayerSlot(tPlayer.LocalObjects)
tPlayer.LocalObjects.Add(Player.StateId, Player.StateId)
Packets.SendAppears(tPlayer.StateId, Player.StateId, Races.Player, GetPlayerBuffer(Player))
Packets.SendPlayerLookChanged(tPlayer.StateId, Player.StateId, GetPlayerLooks(Player))
End If
Packets.SendAppears(Player.StateId, tPlayer.StateId, Races.Player, GetPlayerBuffer(tPlayer))
Packets.SendPlayerLookChanged(Player.StateId, tPlayer.StateId, GetPlayerLooks(tPlayer))
Added.Add(tPlayer.StateId, "")
End If
End If
Next k
End If
Added.Clear()
'MONSTERS
Dim l, tMonsterId As Long
Dim tMonster As New clsMonster
For l = 0 To Locals.Count - 1
If Not Locals(l) Is Nothing Then
'Its a monster
tMonsterId = Locals(l)
If Not Player.LocalObjects.ContainsValue(tMonsterId) And Not Added.Contains(tMonsterId) Then
tMonster = ObjectList(tMonsterId)
Packets.SendAppears(State.Index, tMonsterId, Races.Monster, GetMonsterBuffer(tMonster))
Added.Add(tMonsterId, "")
End If
End If
Next l
Added.Clear()
'NPCS
Dim tNpcID, g As Short
Dim tNpc As New clsNpc
For g = 0 To Locals.Count - 1
If Not Locals(g) Is Nothing Then
'Its a Npc
tNpcID = Locals(g)
If Not Player.LocalObjects.ContainsValue(tNpcID) And Not Added.Contains(tNpcID) Then
tNpc = ObjectList(tNpcID)
Packets.SendAppears(State.Index, tNpcID, Races.Npc, GetNpcBuffer(tNpc))
Added.Add(tNpcID, "")
End If
End If
Next g
Added.Clear()
'Send Disappears
'PLAYERS
For k = 0 To Player.LocalObjects.Count - 1
If Not Player.LocalObjects(k) Is Nothing Then
'Its a player
tPlayerID = Player.LocalObjects(k)
'If Locals Doesnt Contain the Players Local Players ID
If Not ObjectList(tPlayerID) Is Nothing And Not Locals.ContainsValue(tPlayerID) And Not Added.Contains(tPlayerID) And Not tPlayerID = Player.StateId Then
tPlayer = ObjectList(tPlayerID)
If tPlayer.LocalObjects.ContainsValue(Player.StateId) = True Then
'Dim Key As Integer = GetPKeyFromValue(tPlayer.LocalObjects, Player.StateId)
tPlayer.LocalObjects.Remove(Player.StateId)
Packets.SendDisappear(tPlayerID, Player.StateId, Races.Player)
End If
Packets.SendDisappear(Player.StateId, tPlayerID, Races.Player)
Added.Add(tPlayerID, "")
End If
End If
Next k
Added.Clear()
'MONSTERS
For l = 0 To Player.LocalObjects.Count - 1
If Not Player.LocalObjects(l) Is Nothing Then
'Its a monster
tMonsterId = Player.LocalObjects(l)
If Not Locals.ContainsValue(tMonsterId) And Not Added.Contains(tMonsterId) Then
Packets.SendDisappear(State.Index, tMonsterId, Races.Monster)
Added.Add(tMonsterId, "")
End If
End If
Next l
Added.Clear()
'NPCS
For g = 0 To Player.LocalObjects.Count - 1
If Not Player.LocalObjects(g) Is Nothing Then
'Its a npc
tNpcID = Player.LocalObjects(g)
If Not Locals.ContainsValue(tNpcID) And Not Added.Contains(tNpcID) Then
Packets.SendDisappear(State.Index, tNpcID, Races.Npc)
Added.Add(tNpcID, "")
End If
End If
Next g
Player.LocalObjects = Locals
End If
Added.Clear()
Dim LocalItems As Hashtable = GetLocalDropItems(Player.X, Player.Y, Player.Map, 15, 15)
If CheckTablesMatch(LocalItems, Player.LocalDropItems) = False Then
'Send Drop Item Appears
Dim n, ItemID As Long
Dim lItem As clsPlayerItem
Dim RealItem As clsItem
For n = 0 To LocalItems.Count - 1
If Not LocalItems(n) Is Nothing Then
ItemID = LocalItems(n)
If Not Player.LocalDropItems.Contains(ItemID) And Not Added.Contains(ItemID) Then
lItem = PlayerItemList(ItemID)
RealItem = ItemStatList(lItem.ItemIndex)
Packets.SendItemDropped(Player.StateId, lItem.ItemID, lItem.X, lItem.Y, RealItem.Looks, RealItem.Name)
Added.Add(lItem.ItemID, "")
End If
End If
Next n
Added.Clear()
'Send Drop Item Disappears
For n = 0 To Player.LocalDropItems.Count - 1
If Not Player.LocalDropItems(n) Is Nothing Then
ItemID = Player.LocalDropItems(n)
If Not LocalItems.Contains(ItemID) And Not Added.Contains(ItemID) Then
Packets.SendRemoveDropItem(State.Index, ItemID)
Added.Add(ItemID, "")
End If
End If
Next n
Player.LocalDropItems = LocalItems
End If
End If
End Sub
#End Region
#Region "ProcessTurn"
Public Sub ProcessTurn(ByVal Header As Header, ByVal State As State)
Dim Player As clsPlayer = ObjectList(PlayerList(Socket.Lst.GetCharacter(State.Index)))
Dim PlayerMap As Map = Maps(Player.Map)
If Player.IsDead Then
Packets.SendTurnFail(State.Index, Player.X, Player.Y, Player.Dir)
Exit Sub
End If
If Player.X <> Header.nRecog Or Player.Y <> Header.wParam Then
Packets.SendTurnFail(State.Index, Player.X, Player.Y, Player.Dir)
Exit Sub
End If
'Player can turn
Player.Dir = Header.wTag
Packets.SendTurn(State.Index, Player.StateId, Races.Player, Player.Dir)
'Tell everyone a player turned
Dim Locals As Hashtable = GetLocalPlayers(Player.X, Player.Y, Player.Map, 15, 15)
Dim lPlayer As clsPlayer
Dim i As Integer
Dim pID As Integer
Dim Added As New Hashtable
For i = 0 To Locals.Count - 1
pID = Locals(i)
If Not Added.ContainsKey(pID) Then
lPlayer = ObjectList(pID)
Packets.SendTurn(lPlayer.StateId, Player.StateId, Races.Player, Player.Dir)
Added.Add(pID, "")
End If
Next i
End Sub
#End Region
#Region "ProcessChat"
Public Sub ProcessChat(ByVal Body As String, ByVal State As State)
If Body.Length <= 0 Or Body.Length > 255 Then
Exit Sub
End If
Dim TargetId As Integer
Dim TargetName As String
If Body.StartsWith("/") Then
If Body.ToLower = "/who" Then
'Tell player how many users online
Packets.SendChatMessage(State.Index, ChatColours.White, "Users On: " & FrmMain.lstPlayers.Items.Count & ".", State.Index)
Exit Sub
End If
'Private messages
TargetName = GetTok(Body, 0, " ").Substring(1)
If PlayerList.Contains(TargetName) = False Then
Packets.SendChatMessage(-1, ChatColours.Red, TargetName & " not found.", State.Index)
Exit Sub
Else
TargetId = PlayerList(TargetName)
Packets.SendChatMessage(-1, ChatColours.Blue, Socket.Lst.GetCharacter(State.Index) & "=> " & Body.Substring(TargetName.Length + 1), TargetId)
Exit Sub
End If
End If
If Body.StartsWith("@") Then
Dim Player As clsPlayer = ObjectList(State.Index)
DoGMCommand(Player, Body.Substring(1))
Exit Sub
End If
If Body.StartsWith("!") Then
'Shouts
Dim Shouter As clsPlayer = ObjectList(PlayerList(Socket.Lst.GetCharacter(State.Index)))
DoShout(Shouter, Body.Substring(1))
Exit Sub
End If
Dim Chatter As clsPlayer = ObjectList(PlayerList(Socket.Lst.GetCharacter(State.Index)))
DoChat(Chatter, Body)
Exit Sub
End Sub
#End Region
#Region "ProcessClickNpc"
Public Sub ProcessClickNpc(ByVal Header As Header, ByVal State As State)
Dim NpcsId As Short = Header.nRecog
Dim Npc As clsNpc
If ObjectList.Contains(NpcsId) Then
Npc = ObjectList(NpcsId)
Npc.ProccessNpc(State.Index, "@main")
End If
End Sub
#End Region
#Region "ProcessClickNpcMenu"
Public Sub ProcessClickNpcMenu(ByVal Header As Header, ByVal Body As String, ByVal State As State)
Dim NpcsId As Short = Header.nRecog
Dim Npc As clsNpc
If ObjectList.Contains(NpcsId) Then
Npc = ObjectList(NpcsId)
Npc.ProccessNpc(State.Index, Body)
End If
End Sub
#End Region
#Region "ProcessHit"
Public Sub ProcessHit(ByVal Header As Header, ByVal State As State)
Dim Player As clsPlayer = ObjectList(State.Index)
'########################'
'###CHECK THEY CAN HIT###'
'########################'
If Player.IsDead Or Player.X <> Header.nRecog Or Player.Y <> Header.wParam Or Player.Poison = clsPlayer.Poisons.Paralysis Then
Packets.SendHitFail(State.Index)
Exit Sub
End If
'#####################'
'###IF THEY CAN HIT###'
'#####################'
'Tell them they can hit
Packets.SendHitOk(State.Index)
Player.Dir = Header.wTag
'#####################'
'###FIND THE TARGET###'
'#####################'
Dim CheckMap As Map = Maps(Player.Map)
'Find the Cords they are attacking
Dim Target As Point = IsNextWalkDir(Player.Dir, New Point(Player.X, Player.Y))
Dim TargetId As Object
Dim TargetRace As Races
Dim i As Integer
Dim GotTarget As Boolean
'Find Target Id
While i < 10 And GotTarget = False
If Not CheckMap.ObjectList(Target.X & "/" & Target.Y & "/" & i) Is Nothing Then
TargetId = CheckMap.ObjectList(Target.X & "/" & Target.Y & "/" & i)
GotTarget = True
End If
i += 1
End While
Dim Locals As Hashtable = GetLocalObjects(Player.X, Player.Y, Player.Map, 15, 15, -1)
Dim Added As New Hashtable
Dim lPlayerId As Integer
'##########################'
'###TELL EVERYONE WE HIT###'
'##########################'
For i = 0 To Locals.Count - 1
If Not Locals(i) Is Nothing Then
'Its a player
lPlayerId = Locals(i)
If Not Added.Contains(lPlayerId) And Not lPlayerId = Player.StateId Then
Packets.SendHit(lPlayerId, Player.StateId, Races.Player, Player.Dir)
Added.Add(lPlayerId, "")
End If
End If
Next i
Added.Clear()
If Not GotTarget Then
'We have no target
Exit Sub
End If
Dim Damage As Short 'Amount of damage
Dim WillHit As Boolean = False 'Will it hit or not?
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -