Teleporte usando mapa múndi com custo de gold

Então ok... Vamos começar?

Primeiro baixe este Arquivo e coloque na pasta src do seu projeto...
Depois no Visual Basic clique em Project e em Add File...
Então carregue o arquivo frmMapa! Very Happy
Pronto, primeira parte já foi...

Agora no frmMain adicione um Label:

Código:

 Name: lblMapa
    Backstyle: Transparent
    Agora na imagem de background do frmMain crie algo visual dizendo "Mapa" e coloque esta label transparente por cima entende?!

Código do lblMapa:

 

Código:

frmMapa.Visible = True

Agora vamos arrumar o bug do lblGold...

Client~Side

Procure:

Código:

 If GetPlayerInvItemNum(MyIndex, i) = 1 Then '1 = gold Razz

Substitua por:

Código:

 if Item(GetPlayerInvItemNum(MyIndex, i)).Type = ITEM_TYPE_CURRENCY Then

Agora Procure por:

Código:

 ' If item is a stack - draw the amount you have
    If GetPlayerInvItemValue(MyIndex, i) > 1 Then
    y = rec_pos.Top + 22
    X = rec_pos.Left - 4
    Amount = CStr(GetPlayerInvItemValue(MyIndex, i))
    ' Draw currency but with k, m, b etc. using a convertion function
    RenderText Font_Default, ConvertCurrency(Amount), X, y, Yellow, 0
    ' Check if it's gold, and update the label

    If Item(GetPlayerInvItemNum(MyIndex, i)).Type = ITEM_TYPE_CURRENCY Then '1 = gold Razz
    frmMain.lblGold.Caption = Format$(Amount, "#,###,###,###") & "g"
    End If
    End If

Substitua por:

Código:

 ' If item is a stack - draw the amount you have
    If Item(GetPlayerInvItemNum(MyIndex, i)).Type <> ITEM_TYPE_ARMOR Or ITEM_TYPE_WEAPON Or ITEM_TYPE_CONSUME Then
    If GetPlayerInvItemValue(MyIndex, i) >= 1 Then
    y = rec_pos.Top + 22
    X = rec_pos.Left - 4
    Amount = CStr(GetPlayerInvItemValue(MyIndex, i))
    ' Draw currency but with k, m, b etc. using a convertion function
    RenderText Font_Default, ConvertCurrency(Amount), X, y, Yellow, 0
    ' Check if it's gold, and update the label

    If Item(GetPlayerInvItemNum(MyIndex, i)).Type = ITEM_TYPE_CURRENCY Then '1 = gold Razz
    frmMain.lblGold.Caption = Format$(Amount, "#,###,###,###") & "g"
    End If
    end if
    End If

E Agora, Procure por:

Código:

 ' If item is a stack - draw the amount you have
    If GetPlayerInvItemValue(MyIndex, i) > 1 Then
    y = rec_pos.top + 22
    X = rec_pos.Left - 4
    Amount = CStr(GetPlayerInvItemValue(MyIndex, i))
    ' Draw currency but with k, m, b etc. using a convertion function
    DrawText frmMain.picInventory.hDC, X, y, ConvertCurrency(Amount), QBColor(Yellow)

    ' Check if it's gold, and update the label
    If Item(GetPlayerInvItemNum(MyIndex, i)).Type = ITEM_TYPE_CURRENCY Then
    frmMain.lblGold.Caption = Format$(Amount, "#,###,###,###") & "g"
    End If
    End If

E Substitua por:

Código:

 If Item(GetPlayerInvItemNum(MyIndex, i)).Type <> ITEM_TYPE_ARMOR Or ITEM_TYPE_WEAPON OR ITEM_TYPE_CONSUMEThen
    If GetPlayerInvItemValue(MyIndex, i) >= 1 Then
    y = rec_pos.Top + 22
    X = rec_pos.Left - 4

    Amount = GetPlayerInvItemValue(MyIndex, i) - amountModifier

    ' Draw currency but with k, m, b etc. using a convertion function
    If Amount < 1000000 Then
    colour = White
    ElseIf Amount > 1000000 And Amount < 10000000 Then
    colour = Yellow
    ElseIf Amount > 10000000 Then
    colour = BrightGreen
    End If
    RenderText Font_Default, Format$(ConvertCurrency(str(Amount)), "#,###,###,###"), X, y, colour, 0
    ' Check if it's gold, and update the label
    If Item(GetPlayerInvItemNum(MyIndex, i)).Type = ITEM_TYPE_CURRENCY Then '1 = gold Razz
    frmMain.lblGold.Caption = Format$(Amount, "#,###,###,###") & "g"
    ' Check if it's gold, and update the label 2
    If Amount = 0 Then
    frmMain.lblGold.Caption = "0g"
    frmMapa.lblGold.Caption = "0g"
    end If
    end if

Para acabar, procure por:

Código:

 ' reset gold label
    frmMain.lblGold.Caption = "0g"

Substitua por:

Código:

 ' reset gold label
    If Amount = 0 Then
    frmMain.lblGold.Caption = "0g"
    frmMapa.lblGold.Caption = "0g"
    End If

Pronto, o bug está concertado... Agora vamos ao warp player!

Server-Side

Procure por:

Código:

 CWarpTo

Em baixo coloque:

Código:

 CWarpPlayer

Depois procure por:

Código:

 HandleDataSub(CWarpTo) = GetAddress(AddressOf HandleWarpTo)

Em baixo adicione:

Código:

 HandleDataSub(CWarpPlayer) = GetAddress(AddressOf HandleWarpPlayer)

No final do modHandleData adicione:

Código:

 Sub HandleWarpPlayer(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
    Dim n As Long
    Dim Buffer As clsBuffer
    Set Buffer = New clsBuffer
    Buffer.WriteBytes Data()

    ' The map
    n = Buffer.ReadLong 'CLng(Parse(1))
    Set Buffer = Nothing

    ' Prevent hacking
    If n < 0 Or n > MAX_MAPS Then
    Exit Sub
    End If

    Call PlayerWarp(index, n, GetPlayerX(index), GetPlayerY(index))
    Call PlayerMsg(index, "Você está no mapa:" & n, BrightBlue)
    Call AddLog(GetPlayerName(index) & " Você foi para o mapa:" & n & ".", ADMIN_LOG)
    End Sub

Fim do Server~Side!

Agora no Client~Side

No final da modClientTCP adicione:

Código:

 Sub HandleWarpPlayer(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
    Dim n As Long
    Dim x As Byte, y As Byte
    Dim i As Byte
    Dim Buffer As clsBuffer
    Set Buffer = New clsBuffer
    Buffer.WriteBytes Data()

    For i = 1 To MAX_INV
    If GetPlayerInvItemNum(index, i) = 1 Then
    If GetPlayerInvItemValue(index, i) < 100 Then
    PlayerMsg index, "Você não tem Gold Suficiente!", Yellow
    Exit Sub
    Exit For
    End If
    End If
    Next

    ' The map
    n = Buffer.ReadLong 'CLng(Parse(1))
    x = Buffer.ReadByte
    y = Buffer.ReadByte
    Set Buffer = Nothing

    ' Prevent hacking
    If n < 0 Or n > MAX_MAPS Then
    Exit Sub
    End If

    If x < 0 Or x > Map(GetPlayerMap(index)).MaxX Then Exit Sub
    If y < 0 Or y > Map(GetPlayerMap(index)).MaxY Then Exit Sub

    For i = 1 To MAX_INV
    If GetPlayerInvItemNum(index, i) = 1 Then
    TakeInvItem index, 1, 100
    End If
    Next

    Call PlayerWarp(index, n, x, y)
    Call PlayerMsg(index, "Você está no mapa:" & n, BrightBlue)
    Call AddLog(GetPlayerName(index) & " Você foi para o mapa:" & n & ".", ADMIN_LOG)
    SendPlayerData index
    End Sub

Depois procure por:

Código:

 CWarpTo

Em baixo adicione:

 

Código:

 CWarpPlayer

Pronto, agora para usar quando você clicar no picture do frmMapa e tiver 100 de gold você teleportará!
Para mudar o local do teleporte no frmMapa, na picMapa, duplo clique, e mude:
Call WarpPlayer(mapa, x, y)

Se quiser criar mais teleportes só usar o Call WarpPlayer(10, 12, 9) em outras pictures, basta apenas ir copiando... xD

Espero que ajude vocês este tutorial!
Se ajudou +cred ai ^^


Créditos:

Sistema de Warp Player: Thales12
Implementações e Correções: Guardian
Criação do frmMapa e do Tutorial: Wirosaki
Correção da lblGold: Wirosaki