Teleport Em Level(por Shift)

por newbie123 Qui Jan 30, 2014 11:47 am

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:

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

Hitskin.com

Teleport Em Level(por Shift)

Teleport Em Level(por Shift)