?? modmainserver.vb.svn-base
字號:
If CheckTablesMatch(Locals, Player.LocalObjects) = False Then
'Locals Changed
Dim k, tPlayerID As Integer
'Send Appears
'PLAYERS
If Not Locals.Count = 0 Then
For k = 0 To Locals.Count - 1
If Not Locals(k) Is Nothing Then
'Current Local Players ID
tPlayerID = Locals(k)
'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
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
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 Items
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
Player.LocalDropItems = LocalItems
End If
''PLAYERS
'Dim tPlayerID, k As Integer
''For i = 0 To Locals.Count - 1
'' tPlayerID = Locals(i)
'' tPlayer = ObjectList(tPlayerID)
'' If Not tPlayerID = Player.StateId And Not Added.Contains(tPlayer.StateId) Then
'' Packets.SendAppears(State.Index, tPlayer.StateId, Races.Player, GetPlayerBuffer(tPlayer))
'' Added.Add(tPlayer.StateId, "")
'' End If
''Next i
'If Not Locals.Count = 0 Then
' For k = 0 To Locals.Count - 1
' If Not Locals(k) Is Nothing Then
' 'Current Local Players ID
' tPlayerID = Locals(k)
' 'If Players Local Players Doesnt Contain the Local Players ID
' If Not Player.LocalObjects.Contains(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(FreeSlot, Player.StateId)
' Packets.SendAppears(tPlayer.StateId, Player.StateId, Races.Player, GetPlayerBuffer(Player))
' End If
' Packets.SendAppears(Player.StateId, tPlayer.StateId, Races.Player, GetPlayerBuffer(tPlayer))
' Added.Add(tPlayer.StateId, "")
' End If
' End If
' Next k
'End If
'Added.Clear()
''MONSTERS
'Dim tMonsterID, l As Long
'For l = 0 To Locals.Count - 1
' If Not ObjectList(tMonsterID) Is Nothing Then
' End If
'Next l
' ''NPCS
''Dim tNpcID, k As Short
''Dim tNpc As clsNpc
''For k = 0 To Locals.Count - 1
'' tNpcID = Locals(k)
'' tNpc = ObjectList(tNpcID)
'' If Not tNpc Is Nothing Then
'' Packets.SendAppears(State.Index, tNpcID, Races.Npc, GetNpcBuffer(tNpc))
'' End If
''Next k
'Player.LocalObjects = Locals
End Sub
#End Region
#Region "ProcessPlayerDisappear"
Public Sub ProcessPlayerDisappear(ByVal Index As Integer)
Dim Player As clsPlayer = ObjectList(Index)
Dim Added As New Hashtable
Dim tPlayerID, i As Integer
Dim tPlayer As clsPlayer
If Player.LocalObjects.Count = 0 Then Exit Sub
For i = 0 To Player.LocalObjects.Count - 1
If Not Player.LocalObjects(i) Is Nothing Then
tPlayerID = Player.LocalObjects(i)
If Not Added.Contains(tPlayerID) Then
tPlayer = ObjectList(tPlayerID)
tPlayer.LocalObjects.Remove(Player.StateId)
Player.LocalObjects.Remove(tPlayerID)
Packets.SendDisappear(tPlayerID, Player.StateId, Races.Player)
Added.Add(tPlayerID, "")
End If
End If
Next i
End Sub
#End Region
#Region "ProcessMove"
Public Sub ProcessMove(ByVal Header As Header, ByVal State As State)
Dim Steps As Byte = Header.wSeries
Dim Dir As Byte = Header.wTag
Dim Player As clsPlayer = ObjectList(PlayerList(Socket.Lst.GetCharacter(State.Index)))
Dim PlayerMap As Map = Maps(Player.Map)
If Player.IsDead Or Player.Poison = clsPlayer.Poisons.Paralysis Then
Packets.SendMoveFail(State.Index, Player.X, Player.Y, Player.Dir)
Exit Sub
End If
'If Player.LastMove + (Player.MoveSpeed * 10000) > DateTime.Now.Ticks Then
' 'Packets.SendMoveFail(State.Index, Player.X, Player.Y)
' 'Exit Sub
'End If
Dim Target As Point
Target.X = Header.nRecog
Target.Y = Header.wParam
Dim PointXY As Point
PointXY.X = Player.X
PointXY.Y = Player.Y
Dim EndPoint As Point
EndPoint = IsNextWalkDir(Dir, PointXY)
Dim EndPoint2 As Point
EndPoint2 = IsNextWalkDir(Dir, EndPoint)
If Steps = 1 Then
If Target.Equals(EndPoint) = False Then
'Walk failed once
'Player.MoveFail += 1
Packets.SendMoveFail(State.Index, Player.X, Player.Y, Player.Dir)
Exit Sub
Else
'Player.MoveFail = 0
End If
End If
If Steps = 2 Then
If Target.Equals(EndPoint2) = False Then
'Run failed once
'Player.MoveFail += 1
Packets.SendMoveFail(State.Index, Player.X, Player.Y, Player.Dir)
Else
'Player.MoveFail = 0
End If
End If
If CanWalk(EndPoint, Player.Map) = False Then
Packets.SendMoveFail(State.Index, Player.X, Player.Y, Player.Dir)
Exit Sub
End If
If Steps = 2 Then
If CanWalk(EndPoint2, Player.Map) = False Then
Packets.SendMoveFail(State.Index, Player.X, Player.Y, Player.Dir)
Exit Sub
End If
End If
'Player can walk
If PlayerMap.Doors.Contains(EndPoint.X & "/" & EndPoint.Y) Then
AddLog("Maps", "Change map here")
Exit Sub
End If
If Steps = 2 Then
If PlayerMap.Doors.Contains(EndPoint2.X & "/" & EndPoint2.Y) Then
AddLog("Maps", "Change map here")
Exit Sub
End If
End If
Dim Done As Boolean = False
Dim Removed As Boolean = False
Dim i As Integer
Dim tX, tY As Short
tX = EndPoint.X
tY = EndPoint.Y
If Steps = 2 Then
tX = EndPoint2.X
tY = EndPoint2.Y
End If
If PlayerMap.ObjectList.ContainsValue(Player.StateId) Then
Dim tPlayerID As Integer
Dim GotId As Boolean = False
For i = 0 To 9
If Not Done Then
If GotId = False Then
tPlayerID = PlayerMap.ObjectList(Player.X & "/" & Player.Y & "/" & i)
GotId = True
End If
If tPlayerID = Player.StateId Then
If Removed = False Then
PlayerMap.ObjectList.Remove(Player.X & "/" & Player.Y & "/" & i)
Removed = True
End If
If PlayerMap.ObjectList.Contains(tX & "/" & tY & "/" & i) = False Then
Player.LastX = Player.X
Player.LastY = Player.Y
Player.Dir = Dir
Player.X = tX
Player.Y = tY
PlayerMap.ObjectList.Add(Player.X & "/" & Player.Y & "/" & i, Player.StateId)
Done = True
Player.LastMove = DateTime.Now.Ticks
Exit For
End If
End If
End If
Next
End If
If Done = True Then
'Get Players Local Players
Dim Locals As Hashtable = GetLocalObjects(Player.X, Player.Y, Player.Map, 15, 15, Player.StateId)
Dim tPlayerID As Integer
Dim j As Integer
If Not Locals.Count = 0 Then
'Tell everyone a player walked
For j = 0 To Locals.Count - 1
If Not Locals(j) Is Nothing Then
tPlayerID = Locals(j)
If Not tPlayerID = Player.StateId Then
Packets.SendMove(tPlayerID, Player.StateId, Races.Player, Player.X, Player.Y, Player.Dir, Steps)
End If
End If
Next j
End If
Dim Added As New Hashtable
If CheckTablesMatch(Locals, Player.LocalObjects) = False Then
'Locals Changed
Dim k As Integer
Dim tPlayer As New clsPlayer
'Send Appears
'PLAYERS
If Not Locals.Count = 0 Then
For k = 0 To Locals.Count - 1
If Not Locals(k) Is Nothing Then
'Its a player
tPlayerID = Locals(k)
?? 快捷鍵說明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -