Portal
Muito bem esse sistema serve para que quando o jogador chegue em um certo level, ao apertar shift e apertar com o botão direito do mouse em algum lugar o mesmo tele porte para o mesmo(bom pra um jogo de DBZ por exemplo)
Abra o Client.vbp
Na ModEnumeration procure por:
Embaixo coloque:
Na frmMain procure por:
Substitua por:
Agora no modClientTCP procure por:
Abaixo coloque:
Agora vamos para o Server.vbp
na modEnumeration procure por:
Abaixo Coloque:
na modHandleData procure por:
Abaixo coloque:
Ainda na modHandleData procure:
Abaixo coloque:
Creditos
Abra o Client.vbp
Na ModEnumeration procure por:
CAdminWarp
Embaixo coloque:
CPlayerWarp
Na frmMain procure por:
Private Sub picScreen_MouseDown(Button As Integer, Shift As Integer, x As Single, Y As Single)
' If debug mode, handle error then exit out
If Options.Debug = 1 Then On Error GoTo errorhandler
If InMapEditor Then
Call MapEditorMouseDown(Button, x, Y, False)
Else
' left click
If Button = vbLeftButton Then
' targetting
Call PlayerSearch(CurX, CurY)
' right click
ElseIf Button = vbRightButton Then
If ShiftDown Then
' admin warp if we're pressing shift and right clicking
If GetPlayerAccess(MyIndex) >= 2 Then AdminWarp CurX, CurY
End If
End If
End If
Call SetFocusOnChat
' Error handler
Exit Sub
errorhandler:
HandleError "picScreen_MouseDown", "frmMain", Err.Number, Err.Description, Err.Source, Err.HelpContext
Err.Clear
Exit Sub
End Sub
Substitua por:
Private Sub picScreen_MouseDown(Button As Integer, Shift As Integer, x As Single, Y As Single)
' If debug mode, handle error then exit out
If Options.Debug = 1 Then On Error GoTo errorhandler
If InMapEditor Then
Call MapEditorMouseDown(Button, x, Y, False)
Else
' left click
If Button = vbLeftButton Then
' targetting
Call PlayerSearch(CurX, CurY)
' right click
ElseIf Button = vbRightButton Then
If ShiftDown Then
' admin warp if we're pressing shift and right clicking
If GetPlayerAccess(MyIndex) >= 2 Then AdminWarp CurX, CurY
'Level necessário para o player teleportar
If GetPlayerLevel(MyIndex) >= 20 Then PlayerWarp CurX, CurY
End If
End If
End If
Call SetFocusOnChat
' Error handler
Exit Sub
errorhandler:
HandleError "picScreen_MouseDown", "frmMain", Err.Number, Err.Description, Err.Source, Err.HelpContext
Err.Clear
Exit Sub
End Sub
Agora no modClientTCP procure por:
Public Sub AdminWarp(ByVal x As Long, ByVal Y As Long)
Dim Buffer As clsBuffer
' If debug mode, handle error then exit out
If Options.Debug = 1 Then On Error GoTo errorhandler
Set Buffer = New clsBuffer
Buffer.WriteLong CAdminWarp
Buffer.WriteLong x
Buffer.WriteLong Y
SendData Buffer.ToArray()
Set Buffer = Nothing
' Error handler
Exit Sub
errorhandler:
HandleError "AdminWarp", "modClientTCP", Err.Number, Err.Description, Err.Source, Err.HelpContext
Err.Clear
Exit Sub
End Sub
Abaixo coloque:
Public Sub PlayerWarp(ByVal x As Long, ByVal Y As Long)
Dim Buffer As clsBuffer
' If debug mode, handle error then exit out
If Options.Debug = 1 Then On Error GoTo errorhandler
Set Buffer = New clsBuffer
Buffer.WriteLong CPlayerWarp
Buffer.WriteLong x
Buffer.WriteLong Y
SendData Buffer.ToArray()
Set Buffer = Nothing
' Error handler
Exit Sub
errorhandler:
HandleError "PlayerWarp", "modClientTCP", Err.Number, Err.Description, Err.Source, Err.HelpContext
Err.Clear
Exit Sub
End Sub
Agora vamos para o Server.vbp
na modEnumeration procure por:
CAdminWarp
Abaixo Coloque:
CPlayerWarp
na modHandleData procure por:
HandleDataSub(CAdminWarp) = GetAddress(AddressOf HandleAdminWarp)
Abaixo coloque:
HandleDataSub(CPlayerWarp) = GetAddress(AddressOf HandlePlayerWarp)
Ainda na modHandleData procure:
Sub HandleAdminWarp(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
Dim Buffer As clsBuffer
Dim x As Long
Dim y As Long
Set Buffer = New clsBuffer
Buffer.WriteBytes Data()
x = Buffer.ReadLong
y = Buffer.ReadLong
If GetPlayerAccess(index) >= ADMIN_MAPPER Then
'PlayerWarp index, GetPlayerMap(index), x, y
SetPlayerX index, x
SetPlayerY index, y
SendPlayerXYToMap index
End If
Set Buffer = Nothing
End Sub
Abaixo coloque:
Sub HandlePlayerWarp(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
Dim Buffer As clsBuffer
Dim x As Long
Dim y As Long
Set Buffer = New clsBuffer
Buffer.WriteBytes Data()
x = Buffer.ReadLong
y = Buffer.ReadLong
If GetPlayerLevel(index) >= 20 Then
'PlayerWarp index, GetPlayerMap(index), x, y
SetPlayerX index, x
SetPlayerY index, y
SendPlayerXYToMap index
End If
Set Buffer = Nothing
End Sub
Creditos
Robin - Criador do original código de tele portar admin
Newbie123 - Editar código fazendo player tele portar também
