Renanr
Membro
Mensagens : 19
Moeda : 31
Pontos : 5
Data de inscrição : 17/01/2013
 |  Assunto: New VIP System  Dom Jan 20, 2013 7:11 pm | |
| Novo sistema vip - não interfere os acessos =) Cliente Side .. Na Type PlayerRec procure por: - Código:
-
PK As Byte Abaixo adicione: - Código:
-
VIP As Byte Na Sub BltPetName(ByVal Index As Long) abaixo de: - Código:
-
Else
Color = QBColor(BrightRed)
End If Adicione: - Código:
-
If GetPlayerVIP(Index) = 1 Then
Color = QBColor(BrightBlue)
ElseIf GetPlayerVIP(Index) = 2 Then
Color = QBColor(BrightCyan)
ElseIf GetPlayerVIP(Index) >= 3 Then
Color = QBColor(BrightGreen)
End If Na Sub BltPlayerName(ByVal Index As Long) abaixo de: - Código:
-
Else
Color = QBColor(BrightRed)
End If Adicione: - Código:
-
If GetPlayerVIP(Index) = 1 Then
Color = QBColor(BrightBlue)
ElseIf GetPlayerVIP(Index) = 2 Then
Color = QBColor(BrightCyan)
ElseIf GetPlayerVIP(Index) >= 3 Then
Color = QBColor(BrightGreen)
End If Procure por: - Código:
-
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(12))) Abaixo adicione: - Código:
-
Call SetPlayerVIP(I, Val(Parse(13))) No ModTypes procure por: - Código:
-
Sub SetPlayerPK(ByVal Index As Long, ByVal PK As Long)
Player(Index).PK = PK
End Sub Abaixo adicione: - Código:
-
Function GetPlayerVIP(ByVal Index As Long) As Byte
GetPlayerVIP = Player(Index).VIP
End Function
Sub SetPlayerVIP(ByVal Index As Long, ByVal VIPAccess As Byte)
Player(Index).VIP = VIPAccess
End Sub Cliente side finalizado - Abrindo ServerSide Na Type PlayerRec procure por: - Código:
-
PK As Byte Abaixo adicione: - Código:
-
VIP As Byte No modTypes procure por: - Código:
-
Function GetPlayerPK(ByVal Index As Long) As Long
GetPlayerPK = Player(Index).Char(Player(Index).CharNum).PK
End Function Abaixo adicione: - Código:
-
Function GetPlayerVIP(ByVal Index As Long) As Byte
GetPlayerVIP = Player(Index).Char(Player(Index).CharNum).VIP
End Function Ainda no modTypes procure: - Código:
-
Sub SetPlayerPK(ByVal Index As Long, _
ByVal PK As Long)
Player(Index).Char(Player(Index).CharNum).PK = PK
End Sub Abaixo adicione: - Código:
-
Sub SetPlayerVIP(ByVal Index As Long, _
ByVal VIPAccess As Byte)
Player(Index).Char(Player(Index).CharNum).VIP = VIPAccess
End Sub Agora na clsCommands procure: - Código:
-
Sub SetPlayerPK(ByVal Index As Long, ByVal PK As Long)
Player(Index).Char(Player(Index).CharNum).PK = PK
End Sub Abaixo ponha: - Código:
-
Function GetPlayerVIP(ByVal Index As Long) As Byte
GetPlayerVIP = Player(Index).Char(Player(Index).CharNum).VIP
End Function
Sub SetPlayerVIP(ByVal Index As Long, ByVal VIPAccess As Byte)
Player(Index).Char(Player(Index).CharNum).VIP = VIPAccess
End Sub Agora procure por: - Código:
-
Sub SendPlayerData(ByVal Index As Long)
Dim Packet As String
' Send index's player data to everyone including himself on the map
Packet = "PLAYERDATA" & SEP_CHAR
Packet = Packet & Index & SEP_CHAR
Packet = Packet & GetPlayerName(Index) & SEP_CHAR
Packet = Packet & GetPlayerSprite(Index) & SEP_CHAR
Packet = Packet & GetPlayerMap(Index) & SEP_CHAR
Packet = Packet & GetPlayerX(Index) & SEP_CHAR
Packet = Packet & GetPlayerY(Index) & SEP_CHAR
Packet = Packet & GetPlayerDir(Index) & SEP_CHAR
Packet = Packet & GetPlayerAccess(Index) & SEP_CHAR
Packet = Packet & GetPlayerPK(Index) & SEP_CHAR
Packet = Packet & GetPlayerGuild(Index) & SEP_CHAR
Packet = Packet & GetPlayerGuildAccess(Index) & SEP_CHAR
Packet = Packet & GetPlayerClass(Index) & SEP_CHAR Abaixo adicione: - Código:
-
Packet = Packet & GetPlayerVIP(Index) & SEP_CHAR Procure pela: - Código:
-
Sub AddChar(ByVal Index As Long, _ Mude ela toda para: - 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 PVIP As Byte)
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).VIP = PVIP
If Player(Index).Char(CharNum).Sex = SEX_MALE Then
Player(Index).Char(CharNum).Sprite = Class(ClassNum).MaleSprite
Else
Player(Index).Char(CharNum).Sprite = Class(ClassNum).FemaleSprite
End If
Player(Index).Char(CharNum).Level = 1
Player(Index).Char(CharNum).STR = Class(ClassNum).STR
Player(Index).Char(CharNum).DEF = Class(ClassNum).DEF
Player(Index).Char(CharNum).Speed = Class(ClassNum).Speed
Player(Index).Char(CharNum).Magi = Class(ClassNum).Magi
If Class(ClassNum).Map <= 0 Then Class(ClassNum).Map = 1
If Class(ClassNum).x < 0 Or Class(ClassNum).x > MAX_MAPX Then Class(ClassNum).x = Int(Class(ClassNum).x / 2)
If Class(ClassNum).y < 0 Or Class(ClassNum).y > MAX_MAPY Then Class(ClassNum).y = Int(Class(ClassNum).y / 2)
Player(Index).Char(CharNum).Map = Class(ClassNum).Map
Player(Index).Char(CharNum).x = Class(ClassNum).x
Player(Index).Char(CharNum).y = Class(ClassNum).y
Player(Index).Char(CharNum).HP = GetPlayerMaxHP(Index)
Player(Index).Char(CharNum).MP = GetPlayerMaxMP(Index)
Player(Index).Char(CharNum).SP = GetPlayerMaxSP(Index)
' Colocando nome no arquivo xD
f = FreeFile
Open App.Path & "\Contas\charlist.txt" For Append As #f
Print #f, Name
Close #f
Call SavePlayer(Index)
Exit Sub
End If
End Sub Na Case "addachara" ache: - Código:
-
Call AddChar(Index, Name, Sex, Class, CharNum) Mude para: - Código:
-
Call AddChar(Index, Name, Sex, Class, CharNum, 0) ' Costumizavel para jogos que dão VIP ao criar o character por exemplo em um evento do mesmo Na Sub LoadPlayer(ByVal Index As Long, _ abaixo de: - Código:
-
Player(Index).Char(i).Guildaccess = Val(GetVar(FileName, "CHAR" & i, "Guildaccess")) Adicione: - Código:
-
Player(Index).Char(i).VIP = Val(GetVar(FileName, "CHAR" & i, "VIP")) Na Sub SavePlayer(ByVal Index As Long) abaixo de: - Código:
-
Call PutVar(FileName, "CHAR" & i, "Guildaccess", STR(Player(Index).Char(i).Guildaccess)) Adicione: - Código:
-
Call PutVar(FileName, "CHAR" & i, "VIP", STR(Player(Index).Char(i).VIP)) Procure por: - Código:
-
' Ter certeza que não dar experiência menor que 0.
If Exp < 0 Then
Exp = 1
End If Abaixo adicione: - Código:
-
' Duplicar, Triplicar, Quadruplicar EXP - Sistema VIP
If GetPlayerVIP(Attacker) = 1 Then
Exp = Exp * 2
ElseIf GetPlayerVIP(Attacker) = 2 Then
Exp = Exp * 3
ElseIf GetPlayerVIP(Attacker) >= 3 Then
Exp = Exp * 4
End If No evento Private Sub Command10_Click() Procure por: - Código:
-
If Command10.Caption = "Warp" Then
If Index > 0 Then
If IsPlaying(Index) Then
Call PlayerMsg(Index, "Você foi warpado pelo servidor para o Mapa:" & scrlMap.Value & " X:" & scrlX.Value & " Y:" & scrlY.Value, White)
Call PlayerWarp(Index, scrlMap.Value, scrlX.Value, scrlY.Value)
End If
End If
picReason.Visible = False
picJail.Visible = False
Exit Sub
End If Abaixo ponha: - Código:
-
If Command10.Caption = "Setar VIP!" Then
If Index > 0 Then
If IsPlaying(Index) Then
Call SetPlayerVIP(Index, scrlX.Value)
Call SendPlayerData(Index)
Call PlayerMsg(Index, " O servidor lhe concedeu um jogador VIP" & scrlX.Value & ".", White)
Call AddLog("O Servidor concedeu " & GetPlayerName(Index) & " um jogador VIP" & scrlX.Value & ".", ADMIN_LOG)
End If
End If
txtMap.Visible = True
scrlMap.Visible = True
txtX.Caption = "X: 0"
scrlX.Value = 0
txtY.Visible = True
scrlY.Visible = True
picReason.Visible = False
picJail.Visible = False
End If Procure por: - Código:
-
CharInfo(20).Caption = "Index: " & Index Abaixo ponha: - Código:
-
CharInfo(23).Caption = "Acesso VIP: " & GetPlayerVIP(Index) Agora crie um botão embaixo do botão Setar Acesso na aba Jogadores da frmServer, e adicione isso dentro: - Código:
-
Command10.Caption = "Setar VIP!"
picReason.Height = 750
scrlX.Max = 15
txtMap.Visible = False
scrlMap.Visible = False
txtX.Caption = "Acesso VIP: 0"
scrlX.Value = 0
txtY.Visible = False
scrlY.Visible = False
picReason.Visible = False
picJail.Visible = True Ainda na aba Jogadores, embaqixo da label que tem o caption Index: na picStats, copie esta label e cole na pic e deixe embaixo da label Index:, mas mude o Caption para Acesso VIP: Procure por: - Código:
-
Private Sub scrlX_Change() Mude ela toda para: - Código:
-
Private Sub scrlX_Change()
If Command10.Caption = "Acesso" Then
txtX.Caption = "Acesso: " & scrlX.Value
ElseIf Command10.Caption = "Setar VIP!" Then
txtX.Caption = "Acesso VIP: " & scrlX.Value
Else
txtX.Caption = "X: " & scrlX.Value
End If
End Sub E pronto, se não esqueci de nada vai dar certo =)'  VIP tendo acessos vip, podendo por em até 15 Vips VIP1 tem cor azul, VIP2 tem cor Cyan(Azul claro), VIP3 ou mais tem cor Verde. Do pet tem as mesmas cores acima VIP1 Duplica a exp, vip2 triplica a exp, vip3 ou mais quadruplica a exp. Sistema vip não interfere o sistema de acessos. - Citação :
Créditos: Renanr (eu) | |
|
Sonart
Admin
Mensagens : 118
Moeda : 195
Pontos : 25
Data de inscrição : 08/01/2013
Idade : 29
Ficha de personagem
Experiência:
    (0/0)
Avatar: https://2img.net/h/oi63.tinypic.com/14tr6m8.png
| |
SSO
Moderador.G
Mensagens : 83
Moeda : 117
Pontos : 6
Data de inscrição : 06/01/2013
| | Assunto: Re: New VIP System Dom Jan 20, 2013 9:01 pm | |
| Legal, obrigado por compartilhar
+1 de credito | |
|
Conteúdo patrocinado
| | Assunto: Re: New VIP System | |
| |
|
...