MMORPG Brasil
Ola, visitante! Agradecemos sua visita, para ter acesso a todo nosso conteúdo recomendamos que faça um cadastro no fórum, com ele você pode participar de tópicos e ter acesso a todas áreas da comunidade!

Participe do fórum, é rápido e fácil

MMORPG Brasil
Ola, visitante! Agradecemos sua visita, para ter acesso a todo nosso conteúdo recomendamos que faça um cadastro no fórum, com ele você pode participar de tópicos e ter acesso a todas áreas da comunidade!
MMORPG Brasil
Gostaria de reagir a esta mensagem? Crie uma conta em poucos cliques ou inicie sessão para continuar.

[Pedido]Sistema de Vila

3 participantes

Ir para baixo

[Pedido]Sistema de Vila Empty [Pedido]Sistema de Vila

Mensagem por VithorUchi Qua 27 Nov 2013, 14:00

Alguem tem Sistema de Vila Funcional?scratch  Ajuda ae pfv ^^' Dou cred
VithorUchi
VithorUchi
Membro Junior
Membro Junior

Mensagens : 91

Ir para o topo Ir para baixo

[Pedido]Sistema de Vila Empty Re: [Pedido]Sistema de Vila

Mensagem por athos000 Qui 28 Nov 2013, 15:53

Vei vai ser meio dificil voce Achar :cry:mas por sorte ,achei nao se esquença quero meu cred.
athos000
athos000
Membro
Membro

Mensagens : 101

Ir para o topo Ir para baixo

[Pedido]Sistema de Vila Empty Re: [Pedido]Sistema de Vila

Mensagem por athos000 Qui 28 Nov 2013, 15:57

Bom, Na hora de criar um personagem, você escolhe a sua vila
Tutorial


Screen

[Pedido]Sistema de Vila Lol1

Client~Side

Crie uma pasta dentro da pasta GFX com o nome de Vilas. Nesta pasta, coloque as vilas que você quer, mas use sempre números (de 0 à quantidade que você vai usar e em .jpg). Usarei 10 no tutorial.
Na frmNewChar, crie uma PictureBox e mude seu nome para picVila. Agora, crie 2 CommandButton, um com o nome de cmdPVila e o outro com o nome de cmdNVila. Nos códigos da frmNewChar procure por:

Código:
Código:
Option Explicit
Public animi As Long
Abaixo coloque:
Código:
Código:
Public V As Long
Agora dê duplo clique no cmdPVila e coloque:
Código:
Código:
 If V = 1 Then
V = 10
Else
V = V - 1
End If
picVila.Picture = LoadPicture(App.Path & "\GFX\Vilas" & V & ".jpg")
No cmdNVila coloque:
Código:
Código:
 If V = 10 Then
V = 1
Else
V = V + 1
End If
picVila.Picture = LoadPicture(App.Path & "\GFX\Vilas" & V & ".jpg")
Agora, continuando na frmNewChar, crie uma textBox e mude o nome para txtVila e deixe invisível. Crie um Timer (o nome já ficará como Timer3) e mude o interval para 1. Dê duplo clique no Timer3 e adicione:
Código:
Código:
 If V = 1 Then
txtVila.Text = "Folha"
ElseIf V = 2 Then
txtVila.Text = "Areia"
ElseIf V = 3 Then
txtVila.Text = "Névoa"
ElseIf V = 4 Then
txtVila.Text = "Nuvem"
ElseIf V = 5 Then
txtVila.Text = "Pedra"
ElseIf V = 6 Then
txtVila.Text = "Som"
ElseIf V = 7 Then
txtVila.Text = "Chuva"
ElseIf V = 8 Then
txtVila.Text = "Cachoeira"
ElseIf V = 9 Then
txtVila.Text = "Grama"
ElseIf V = 10 Then
txtVila.Text = "Akatsuki"

End If

No evento Load da frmNewChar, coloque:
Código:
Código:
 V = 1
picVila.Picture = LoadPicture(App.Path & "\GUI\Vilas" & V & ".jpg")
Procure por:
Código:
Código:
 Case MENU_STATE_ADDCHAR
frmNewChar.Hide
If ConnectToServer = True Then
Call SetStatus("Conectado, enviando pedido de criação de personagem...")
If frmNewChar.optMale.Value = True Then
Call SendAddChar(frmNewChar.txtName, 0, frmNewChar.cmbClass.ListIndex + 1, frmChars.lstChars.ListIndex + 1)
Else
Call SendAddChar(frmNewChar.txtName, 1, frmNewChar.cmbClass.ListIndex + 1, frmChars.lstChars.ListIndex + 1)
End If
End If
Mude para:
Código:
Código:
 Case MENU_STATE_ADDCHAR
frmNewChar.Hide
If ConnectToServer = True Then
Call SetStatus("Conectado, enviando pedido de criação de personagem...")
If frmNewChar.optMale.Value = True Then
Call SendAddChar(frmNewChar.txtName, 0, frmNewChar.cmbClass.ListIndex + 1, frmChars.lstChars.ListIndex + 1, frmNewChar.txtVila)
Else
Call SendAddChar(frmNewChar.txtName, 1, frmNewChar.cmbClass.ListIndex + 1, frmChars.lstChars.ListIndex + 1, frmNewChar.txtVila)
End If
End If
Na Sub HandleData, embaixo de:
Código:
Código:
Dim z As Long
Adicione:
Código:
Código:
Dim Vila As String
Procure por:
Código:
Código:
 ' ::::::::::::::::::::::::
' :: Player data packet ::
' ::::::::::::::::::::::::
If Parse(0) = "playerdata" Then
I = Val(Parse(1))
Call SetPlayerName(I, Parse(2))
Call SetPlayerSprite(I, Val(Parse(3)))
Call SetPlayerMap(I, Val(Parse(4)))
Call SetPlayerX(I, Val(Parse(5)))
Call SetPlayerY(I, Val(Parse(6)))
Call SetPlayerDir(I, Val(Parse(7)))
Call SetPlayerAccess(I, Val(Parse(8)))
Call SetPlayerPK(I, Val(Parse(9)))
Call SetPlayerGuild(I, Parse(10))
Call SetPlayerGuildAccess(I, Val(Parse(11)))
Call SetPlayerClass(I, Val(Parse(13)))

' Make sure they aren't walking
Player(I).Moving = 0
Player(I).XOffset = 0
Player(I).YOffset = 0

' Check if the player is the client player, and if so reset Directions
If I = MyIndex Then
DirUp = False
DirDown = False
DirLeft = False
DirRight = False
End If
Exit Sub
End If
Mude para:
Código:
Código:
 ' ::::::::::::::::::::::::
' :: Player data packet ::
' ::::::::::::::::::::::::
If Parse(0) = "playerdata" Then
I = Val(Parse(1))
Call SetPlayerName(I, Parse(2))
Call SetPlayerSprite(I, Val(Parse(3)))
Call SetPlayerMap(I, Val(Parse(4)))
Call SetPlayerX(I, Val(Parse(5)))
Call SetPlayerY(I, Val(Parse(6)))
Call SetPlayerDir(I, Val(Parse(7)))
Call SetPlayerAccess(I, Val(Parse(8)))
Call SetPlayerPK(I, Val(Parse(9)))
Call SetPlayerGuild(I, Parse(10))
Call SetPlayerGuildAccess(I, Val(Parse(11)))
Call SetPlayerVila(I, Parse(12))
Call SetPlayerClass(I, Val(Parse(13)))

' Make sure they aren't walking
Player(I).Moving = 0
Player(I).XOffset = 0
Player(I).YOffset = 0

' Check if the player is the client player, and if so reset Directions
If I = MyIndex Then
DirUp = False
DirDown = False
DirLeft = False
DirRight = False
End If
Exit Sub
End If
Procure por:
Código:
Código:
Sub SendAddChar(ByVal Name As String, ByVal Sex As Long, ByVal ClassNum As Long, ByVal Slot As Long)
Dim Packet As String

Packet
 = "addachara" & SEP_CHAR & Trim(Name) & SEP_CHAR & Sex
& SEP_CHAR & ClassNum & SEP_CHAR & Slot & END_CHAR
Call SendData(Packet)
End Sub
Mude para:
Código:
Código:
Sub SendAddChar(ByVal Name As String, ByVal Sex As Long, ByVal ClassNum As Long, ByVal slot As Long, ByVal Vila As String)
Dim Packet As String

Packet
 = "addachara" & SEP_CHAR & Trim(Name) & SEP_CHAR & Sex
& SEP_CHAR & ClassNum & SEP_CHAR & slot & SEP_CHAR
& Vila & END_CHAR
Call SendData(Packet)
End Sub
Procure por:
Código:
Código:
Type PlayerRec
' General
Name As String * NAME_LENGTH
Guild As String
Guildaccess As Byte
Abaixo coloque:
Código:
Código:
 Vila As String
Procure por:
Código:
Código:
Sub ClearPlayer(ByVal Index As Long)
Dim I As Long
Dim n As Long

Player(Index).Name = vbNullString
Player(Index).Guild = vbNullString
Player(Index).Guildaccess = 0
Abaixo adicione:
Código:
Código:
 Player(Index).Vila = vbNullString
Procure por:
Código:
Código:
Sub SetPlayerName(ByVal Index As Long, ByVal Name As String)
Player(Index).Name = Name
End Sub
Embaixo coloque:
Código:
Código:
Function GetPlayerVila(ByVal Index As Long) As String
GetPlayerVila = Trim(Player(Index).Vila)
End Function

Sub SetPlayerVila(ByVal Index As Long, ByVal Vila As String)
Player(Index).Vila = Vila
End Sub
Procure por:
Código:
Código:
 ' :::::::::::::::::::::::::::
' :: All characters packet ::
' :::::::::::::::::::::::::::
If Parse(0) = "allchars" Then
n = 1

frmSendGetData.Hide
frmChars.Show , frmMainMenu

frmChars.lstChars.Clear

For I = 1 To MAX_CHARS
Name = Parse(n)
Msg = Parse(n + 1)
Level = Val(Parse(n + 2))

If Trim(Name) = vbNullString Then
frmChars.lstChars.AddItem "Lugar Livre"
Else
frmChars.lstChars.AddItem Name & ", level " & Level & " " & Msg
End If

n = n + 3
Next I

frmChars.lstChars.ListIndex = 0
Exit Sub
End If
Mude para:
Código:
Código:
 ' :::::::::::::::::::::::::::
' :: All characters packet ::
' :::::::::::::::::::::::::::
If Parse(0) = "allchars" Then
n = 1

frmSendGetData.Hide
frmChars.Show , frmMainMenu

frmChars.lstChars.Clear

For I = 1 To MAX_CHARS
Name = Parse(n)
Msg = Parse(n + 1)
Level = Val(Parse(n + 2))
Vila = Parse(n + 4)

If Trim(Name) = vbNullString Then
frmChars.lstChars.AddItem "Lugar Livre"
Else
frmChars.lstChars.AddItem Name & ", level " & Level & " " & Msg & ", " & Vila
End If

n = n + 5
Next I

frmChars.lstChars.ListIndex = 0
Exit Sub
End If
Server~Side

Procure por:
Código:
Código:
Sub AddChar(ByVal Index As Long, _
ByVal Name As String, _
ByVal Sex As Byte, _
ByVal ClassNum As Byte, _
ByVal CharNum As Long)
Dim f As Long

If Trim$(Player(Index).Char(CharNum).Name) = vbNullString Then
Player(Index).CharNum = CharNum
Player(Index).Char(CharNum).Name = Name
Player(Index).Char(CharNum).Sex = Sex
Player(Index).Char(CharNum).Class = ClassNum
Mude para:
Código:
Código:
Sub AddChar(ByVal Index As Long, _
ByVal Name As String, _
ByVal Sex As Byte, _
ByVal ClassNum As Byte, _
ByVal CharNum As Long, _
ByVal Vila As String)
Dim f As Long

If Trim$(Player(Index).Char(CharNum).Name) = vbNullString Then
Player(Index).CharNum = CharNum
Player(Index).Char(CharNum).Name = Name
Player(Index).Char(CharNum).Sex = Sex
Player(Index).Char(CharNum).Class = ClassNum
Player(Index).Char(CharNum).Vila = Vila
Procure por:
Código:
Código:
Player(Index).Char(i).Class = Val(GetVar(FileName, "CHAR" & i, "Class")
Abaixo adicione:
Código:
Código:
Player(Index).Char(i).Vila = GetVar(FileName, "CHAR" & i, "Vila"
Procure por:
Código:
Código:
Call PutVar(FileName, "CHAR" & i, "Guildaccess", STR(Player(Index).Char(i).Guildaccess))
Abaixo adicione:
Código:
Código:
Call PutVar(FileName, "CHAR" & i, "Vila", Trim$(Player(Index).Char(i).Vila))
Procure por:
Código:
Código:
Type PlayerRec

' Geral
Name As String * NAME_LENGTH
Guild As String
Guildaccess As Byte
Abaixo adicione:
Código:
Código:
Vila As String
Procure por:
Código:
Código:
Player(Index).Char(CharNum).Guild = vbNullString
Embaixo adiicone:
Código:
Código:
Player(Index).Char(CharNum).Vila = vbNullString
Procure por:
Código:
Código:
Player(Index).Char(i).Guild = vbNullString
Abaixo adicione:
Código:
Código:
Player(Index).Char(i).Vila = vbNullString
Procure por:
Código:
Código:
Function GetPlayerExp(ByVal Index As Long) As Long
GetPlayerExp = Player(Index).Char(Player(Index).CharNum).Exp
End Function
Abaixo adicione:
Código:
Código:
Function GetPlayerVila(ByVal Index As Long) As String
GetPlayerVila = Trim$(Player(Index).Char(Player(Index).CharNum).Vila)
End Function
Procure por:
Código:
Código:
Sub SetPlayerExp(ByVal Index As Long, _
ByVal Exp As Long)
Player(Index).Char(Player(Index).CharNum).Exp = Exp
End Sub
Adicione abaixo:
Código:
Código:
Sub SetPlayerVila(ByVal Index As Long, _
ByVal Vila As String)
Player(Index).Char(Player(Index).CharNum).Vila = Vila
End Sub
Procure por:
Código:
Código:
Sub HandleData(ByVal Index As Long, ByVal Data As String)
Dim Parse() As String ' MODO DE SEGURANÇA -- "Descomente" para DESLIGÁ-LO, comente para LIGÁ-LO
Dim Name As String
Dim Password As String
Dim Sex As Long
Dim Class As Long
Dim CharNum As Long
Abaixo adicione:
Código:
Código:
Dim Vila As String
Procure por:
Código:
Código:
 Case "addachara"
Name = Parse(1)
Sex = Val(Parse(2))
Class = Val(Parse(3))
CharNum = Val(Parse(4))

For i = 1 To Len(Name)
N = Asc(Mid$(Name, i, 1))

If (N >= 65 And N <= 90) Or (N >= 97 And N <= 122) Or (N = 95) Or (N = 32) Or (N >= 48 And N <= 57) Then
Else
Call PlainMsg(Index, "Nome Inválido! Use apenas letras, números e espaços.", 4)
Exit Sub
End If

Next

If CharNum < 1 Or CharNum > MAX_CHARS Then
Call HackingAttempt(Index, "CharNum Inválido")
Exit Sub
End If

If (Sex < SEX_MALE) Or (Sex > SEX_FEMALE) Then
Call HackingAttempt(Index, "Sexo Inválido")
Exit Sub
End If

If Class < 1 Or Class > Max_Classes Then
Call HackingAttempt(Index, "Classe Inválida")
Exit Sub
End If

If CharExist(Index, CharNum) Then
Call PlainMsg(Index, "O personagem já existe!", 4)
Exit Sub
End If

If FindChar(Name) Then
Call PlainMsg(Index, "Desculpe, mas este nome já está em uso!", 4)
Exit Sub
End If

Call AddChar(Index, Name, Sex, Class, CharNum)
Call SavePlayer(Index)
Call AddLog("O personagem " & Name & " foi adicionado na conta de " & GetPlayerLogin(Index) & ".", PLAYER_LOG)
Call SendChars(Index)
Call PlainMsg(Index, "O personagem foi criado!", 5)
Exit Sub
Mude para:
Código:
Código:
 Case "addachara"
Name = Parse(1)
Sex = Val(Parse(2))
Class = Val(Parse(3))
CharNum = Val(Parse(4))
Vila = Parse(5)

For i = 1 To Len(Name)
N = Asc(Mid$(Name, i, 1))

If (N >= 65 And N <= 90) Or (N >= 97 And N <= 122) Or (N = 95) Or (N = 32) Or (N >= 48 And N <= 57) Then
Else
Call PlainMsg(Index, "Nome Inválido! Use apenas letras, números e espaços.", 4)
Exit Sub
End If

Next

If CharNum < 1 Or CharNum > MAX_CHARS Then
Call HackingAttempt(Index, "CharNum Inválido")
Exit Sub
End If

If (Sex < SEX_MALE) Or (Sex > SEX_FEMALE) Then
Call HackingAttempt(Index, "Sexo Inválido")
Exit Sub
End If

If Class < 1 Or Class > Max_Classes Then
Call HackingAttempt(Index, "Classe Inválida")
Exit Sub
End If

If CharExist(Index, CharNum) Then
Call PlainMsg(Index, "O personagem já existe!", 4)
Exit Sub
End If

If FindChar(Name) Then
Call PlainMsg(Index, "Desculpe, mas este nome já está em uso!", 4)
Exit Sub
End If

Call AddChar(Index, Name, Sex, Class, CharNum, Vila)
Call SavePlayer(Index)
Call AddLog("O personagem " & Name & " foi adicionado na conta de " & GetPlayerLogin(Index) & ".", PLAYER_LOG)
Call SendChars(Index)
Call PlainMsg(Index, "O personagem foi criado!", 5)
Exit Sub
Procure por:
Código:
Código:
Sub SendChars(ByVal Index As Long)
Dim Packet As String
Dim i As Long

Packet = "ALLCHARS" & SEP_CHAR

For i = 1 To MAX_CHARS
Packet
 = Packet & Trim$(Player(Index).Char(i).Name) & SEP_CHAR &
Trim$(Class(Player(Index).Char(i).Class).Name) & SEP_CHAR &
Player(Index).Char(i).Level & SEP_CHAR
Next

Packet = Packet & END_CHAR
Call SendDataTo(Index, Packet)
End Sub
Mude para:
Código:
Código:
Sub SendChars(ByVal Index As Long)
Dim Packet As String
Dim i As Long

Packet = "ALLCHARS" & SEP_CHAR

For i = 1 To MAX_CHARS
Packet
 = Packet & Trim$(Player(Index).Char(i).Name) & SEP_CHAR &
Trim$(Class(Player(Index).Char(i).Class).Name) & SEP_CHAR &
Player(Index).Char(i).Level & SEP_CHAR &
Player(Index).Char(i).Sprite & SEP_CHAR &
Trim$(Player(Index).Char(i).Vila) & SEP_CHAR
Next

Packet = Packet & END_CHAR
Call SendDataTo(Index, Packet)
End Sub
Procure por:
Código:
Código:
Packet = Packet & GetPlayerGuildAccess(i) & SEP_CHAR
Abaixo adicione:
Código:
Código:
Packet = Packet & GetPlayerVila(i) & SEP_CHAR
Procure por:
Código:
Código:
Packet = Packet & GetPlayerGuildAccess(Index) & SEP_CHAR
Você achará várias, e em ambas, adicione abaixo:
Código:
Código:
Packet = Packet & GetPlayerVila(Index) & SEP_CHAR
athos000
athos000
Membro
Membro

Mensagens : 101

Ir para o topo Ir para baixo

[Pedido]Sistema de Vila Empty Re: [Pedido]Sistema de Vila

Mensagem por [ADM] Cronos Dom 19 Jan 2014, 12:38

DOUBLE POST....
[ADM] Cronos
[ADM] Cronos
Novato
Novato

Mensagens : 9

Ir para o topo Ir para baixo

[Pedido]Sistema de Vila Empty Re: [Pedido]Sistema de Vila

Mensagem por Conteúdo patrocinado


Conteúdo patrocinado


Ir para o topo Ir para baixo

Ir para o topo

- Tópicos semelhantes

 
Permissões neste sub-fórum
Não podes responder a tópicos