InícioCalendárioFAQBuscarMembrosGruposRegistrar-seConectar-se
Os que mais criam tópicos
Sonart
 
Alenaldo
 
Over~
 
Warrior
 
Caio~
 
SSO
 
newbie123
 
Kaue
 
Jim
 
yuri godinho
 
Conectar-se
Nome de usuário:
Senha:
Conexão automática: 
:: Esqueci minha senha

Compartilhe | 
 

 New VIP System

Ir em baixo 
AutorMensagem
Renanr
Membro
Membro
avatar

Mensagens : 19
Moeda : 31
Pontos : 5
Data de inscrição : 17/01/2013

MensagemAssunto: 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 =)'

Arrow VIP tendo acessos vip, podendo por em até 15 Vips
Arrow VIP1 tem cor azul, VIP2 tem cor Cyan(Azul claro), VIP3 ou mais tem cor Verde.
Arrow Do pet tem as mesmas cores acima
Arrow VIP1 Duplica a exp, vip2 triplica a exp, vip3 ou mais quadruplica a exp.
Arrow Sistema vip não interfere o sistema de acessos.

Citação :

Créditos: Renanr (eu)
Voltar ao Topo Ir em baixo
Ver perfil do usuário
Sonart
Admin
Admin
avatar

Mensagens : 109
Moeda : 184
Pontos : 25
Data de inscrição : 08/01/2013
Idade : 23

MensagemAssunto: Re: New VIP System   Dom Jan 20, 2013 7:12 pm

Legal, vou da uma conferida no sistema qualquer erro post aqui, e claro vó está Very Happy...
muito bom +1 !

_________________
Convidado eu adoro você Sonart S2 S2!

[Você precisa estar registrado e conectado para ver esta imagem.]

''A Vida Imitar a Arte''
Voltar ao Topo Ir em baixo
Ver perfil do usuário
SSO
Moderador.G
Moderador.G
avatar

Mensagens : 83
Moeda : 117
Pontos : 6
Data de inscrição : 06/01/2013

MensagemAssunto: Re: New VIP System   Dom Jan 20, 2013 9:01 pm

Legal, obrigado por compartilhar
+1 de credito
Voltar ao Topo Ir em baixo
Ver perfil do usuário
Conteúdo patrocinado




MensagemAssunto: Re: New VIP System   

Voltar ao Topo Ir em baixo
 
New VIP System
Voltar ao Topo 
Página 1 de 1
 Tópicos similares
-
» System Of A Dilma
» Como que eu tiro o System Designer
» Qual a função de SYSTEM>LEDS ?
» Engine RPG Inventory Diablo System + Shop
» Taag' s recentes!

Permissão deste fórum:Você não pode responder aos tópicos neste fórum
 :: Desenvolvimento de Jogos :: Engines :: Elysium Diamond :: Tutoriais-
Ir para: