Gostaria de reagir a esta mensagem? Crie uma conta em poucos cliques ou inicie sessão para continuar.

Sistema de Guild 1.0

3 participantes

Ir para baixo

Sistema de Guild 1.0 Empty Sistema de Guild 1.0

Mensagem  Pablo Qua Out 10, 2012 10:41 pm

Exemplo:

Guild = Wars Guild
Nome = Eduardo - lv: 30

Client~Side

frmMain crie 3 TextBox , e 1 CommandButton

CommandButton
Nome: cmbGuild
Caption : Criar Guild

Dentro do cmbGuild coloque:

Código:
SendCriaGuild txtNome.text, txtGuildNome.text, txtGuildAcesso.text
SendRequestPlayerData

TextBox
Nome: txtNome

TextBox 2
Nome:txtGuildNome

TextBox 3
Nome:txtGuildAcesso

no fim do ModText coloque

Código:
Public Sub DrawPlayerGuild(ByVal Index As Long)
Dim TextX As Long
Dim TextY As Long
Dim color As Long
Dim Guild As String

' If debug mode, handle error then exit out
If Options.Debug = 1 Then On Error GoTo errorhandler

Select Case GetPlayerGuildAccesso(Index)
Case 0
color = QBColor(Black)
Case 1
color = QBColor(Green)
Case 2
color = QBColor(Cyan)
Case 3
color = QBColor(Green)
Case 4
color = QBColor(White)
End Select

Guild = Trim$(Player(Index).Guild)
' calc pos
TextX = ConvertMapX(GetPlayerX(Index) * PIC_X) + Player(Index).XOffset + (PIC_X \ 2) - getWidth(TexthDC, (Trim$(Guild)))
If GetPlayerSprite(Index) < 1 Or GetPlayerSprite(Index) > NumCharacters Then
TextY = ConvertMapY(GetPlayerY(Index) * PIC_Y) + Player(Index).YOffset - 16
Else
' Determine location for text
TextY = ConvertMapY(GetPlayerY(Index) * PIC_Y) + Player(Index).YOffset - (DDSD_Character(GetPlayerSprite(Index)).lHeight / 4) + 3
End If

' Draw name
Call DrawText(TexthDC, TextX, TextY, Guild, color)

' Error handler
Exit Sub
errorhandler:
HandleError "DrawPlayerGuild", "modText", Err.Number, Err.Description, Err.Source, Err.HelpContext
Err.Clear
Exit Sub
End Sub

Procure por: no ModTypes - PlayerRec

Código:
PK As Byte

abaixo coloque

Código:
Guild As String
Código:
GuildAcesso As Byte

Agora no final do modClientTCP coloque

Código:
Sub SendCriaGuild(ByVal Nome As String, ByVal Guild As String, ByVal Acesso As Byte)
Dim Buffer As clsBuffer

Set Buffer = New clsBuffer

Buffer.WriteLong CGuild
Buffer.WriteString Nome
Buffer.WriteString Guild
Buffer.WriteByte Acesso
SendData Buffer.ToArray()

Set Buffer = Nothing
End Sub

No Final do ModDataBase Coloque

Código:
Function GetPlayerGuild(ByVal Index As Long) As String
' If debug mode, handle error then exit out
If Options.Debug = 1 Then On Error GoTo errorhandler

If Index > MAX_PLAYERS Then Exit Function
GetPlayerGuild = Trim$(Player(Index).Guild)

' Error handler
Exit Function
errorhandler:
HandleError "GetPlayerGuild", "modDatabase", Err.Number, Err.Description, Err.Source, Err.HelpContext
Err.Clear
Exit Function
End Function

Sub SetPlayerGuild(ByVal Index As Long, ByVal Guild As String) ' lol 4 hora nem vi kk
' If debug mode, handle error then exit out
If Options.Debug = 1 Then On Error GoTo errorhandler

If Index > MAX_PLAYERS Then Exit Sub
Player(Index).Guild = Guild

' Error handler
Exit Sub
errorhandler:
HandleError "SetPlayerGuild", "modDatabase", Err.Number, Err.Description, Err.Source, Err.HelpContext
Err.Clear
Exit Sub
End Sub

Function GetPlayerGuildAcesso(ByVal Index As Long) As Byte
' If debug mode, handle error then exit out
If Options.Debug = 1 Then On Error GoTo errorhandler

If Index > MAX_PLAYERS Then Exit Function
GetPlayerGuildAcesso = Trim$(Player(Index).GuildAcesso)

' Error handler
Exit Function
errorhandler:
HandleError "GetPlayerGuildAcesso ", "modDatabase", Err.Number, Err.Description, Err.Source, Err.HelpContext
Err.Clear
Exit Function
End Function

Sub SetPlayerGuildAcesso(ByVal Index As Long, ByVal GuildAcesso As Byte)
' If debug mode, handle error then exit out
If Options.Debug = 1 Then On Error GoTo errorhandler

If Index > MAX_PLAYERS Then Exit Sub
Player(Index).GuildAcesso = GuildAcesso

' Error handler
Exit Sub
errorhandler:
HandleError "SetPlayerGuildGuildAcesso", "modDatabase", Err.Number, Err.Description, Err.Source, Err.HelpContext
Err.Clear
Exit Sub
End Sub

Procure por

Código:
 ' draw player names
For i = 1 To Player_HighIndex
If IsPlaying(i) And GetPlayerMap(i) = GetPlayerMap(MyIndex) Then
Call DrawPlayerName(i)
End If
Next

mude para

Código:
 ' draw player names
For i = 1 To Player_HighIndex
If IsPlaying(i) And GetPlayerMap(i) = GetPlayerMap(MyIndex) Then
Call DrawPlayerName(i)
Call DrawPlayerGuild(i)
End If
Next

Procure por:

Código:
' Make sure CMSG_COUNT is below everything else

Acima coloque

Código:
CGuild

Procure por :

Código:
Call SetPlayerPK(i, Buffer.ReadLong)

abaixo coloque:

Código:
Call SetPlayerGuild(i, Buffer.ReadString)
Código:
Call SetPlayerGuildAcesso(i, Buffer.ReadByte)

Fim do Client agora vamos ao Server~Side

Procure por:

Código:
Buffer.WriteString GetPlayerAccess(index)

abaixo coloca

Código:
Buffer.WriteString GetPlayerGuild(index)
Código:
Buffer.WriteByte GetPlayerGuildAcesso(index)

Procure por :

Código:
PK as Byte

abaixo coloca:

Código:
Guild As String
Código:
GuildAcesso as Byte

procure por:

Código:
' Make sure CMSG_COUNT is below everything else

acima coloca:

Código:
CGuild

No final do ModDataBase coloca

Código:
Function GetPlayerGuild(ByVal index As Long) As String

If index > MAX_PLAYERS Then Exit Function
GetPlayerGuild = Trim$(Player(index).Guild)
End Function

Sub SetPlayerGuild(ByVal index As Long, ByVal Guild As String)
Player(index).Guild = Guild
End Sub

Código:
Function GetPlayerGuildAcesso(ByVal index As Long) As Byte

If index > MAX_PLAYERS Then Exit Function
GetPlayerGuildAcesso = Trim$(Player(index).GuildAcesso)
End Function

Sub SetPlayerGuildAcesso(ByVal index As Long, ByVal GuildAcesso As Byte)
Player(index).GuildAcesso = GuildAcesso
End Sub

Procure por:

Código:
Player(index).Class = ClassNum

abaixo coloque

Código:
Player(index).Guild = vbNullString

Procure por:

Código:
HandleDataSub(CPartyLeave) = GetAddress(AddressOf HandlePartyLeave)

abaixo coloca:

Código:
HandleDataSub(CGuild) = GetAddress(AddressOf HandleGuild)

Agora no final do HandleData coloque

Código:
Public Sub HandleGuild(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
Dim Buffer As New clsBuffer
Dim Guild As String
Dim Nome As String
Dim Acesso As Byte

Set Buffer = New clsBuffer
Buffer.WriteBytes Data()

Nome = FindPlayer(Buffer.ReadString)
Guild = Buffer.ReadString
Acesso = Buffer.ReadByte

If Nome = 0 Then
PlayerMsg index, "O Jogador Selecionado não está online", Red
Exit Sub
End If

If GetPlayerGuild(Nome) <> vbNullString Then
PlayerMsg index, "O Jogador já Esta Em Uma guild!", Red
Exit Sub
End If

SetPlayerGuild Nome, Guild,Acesso
PlayerMsg index, "Sua guild: " & Guild & " - Acesso: " & Acesso, Red
Set Buffer = Nothing
End Sub

Server~Side Terminada Sistema Finalizado

Créditos: Eduardo
Créditos: M.Dutra pela ideia do sistema
Pablo
Pablo
Admin

Mensagens : 1
Agradecimentos : 1
Data de inscrição : 21/08/2012

http://worldrpgbr.ativoforum.com

Ir para o topo Ir para baixo

Sistema de Guild 1.0 Empty Re: Sistema de Guild 1.0

Mensagem  Myke ~ Qua Out 10, 2012 11:20 pm

Bom Sistema, Eduardo é Fodastico.....
+1 Por Disponibilizar

Atenciosamente ~
Eu lol!

Myke ~
Novato
Novato

Mensagens : 7
Agradecimentos : -1
Data de inscrição : 10/10/2012

Ir para o topo Ir para baixo

Sistema de Guild 1.0 Empty Re: Sistema de Guild 1.0

Mensagem  Eduardo Qui Out 11, 2012 5:43 am

Topico modificado adicionado Guild Acesso ao sistema logogo logo atualizarei novamente
Eduardo
Eduardo
Admin

Mensagens : 12
Agradecimentos : 2
Data de inscrição : 22/08/2012
Idade : 27

Ir para o topo Ir para baixo

Sistema de Guild 1.0 Empty Re: Sistema de Guild 1.0

Mensagem  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