New Vip System

Código:

PK As Byte

Código:

VIP As Byte

Código:

Else
        Color = QBColor(BrightRed)
    End If

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

Código:

Else
        Color = QBColor(BrightRed)
    End If

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

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)))

Código:

Call SetPlayerVIP(I, Val(Parse(13)))

Código:

Sub SetPlayerPK(ByVal Index As Long, ByVal PK As Long)
    Player(Index).PK = PK
End Sub

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

Código:

PK As Byte

Código:

VIP As Byte

Código:

Function GetPlayerPK(ByVal Index As Long) As Long
    GetPlayerPK = Player(Index).Char(Player(Index).CharNum).PK
End Function

Código:

Function GetPlayerVIP(ByVal Index As Long) As Byte
    GetPlayerVIP = Player(Index).Char(Player(Index).CharNum).VIP
End Function

Código:

Sub SetPlayerPK(ByVal Index As Long, _
  ByVal PK As Long)
    Player(Index).Char(Player(Index).CharNum).PK = PK
End Sub

Código:

Sub SetPlayerVIP(ByVal Index As Long, _
  ByVal VIPAccess As Byte)
    Player(Index).Char(Player(Index).CharNum).VIP = VIPAccess
End Sub

Código:

Sub SetPlayerPK(ByVal Index As Long, ByVal PK As Long)
    Player(Index).Char(Player(Index).CharNum).PK = PK
End Sub

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

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

Código:

Packet = Packet & GetPlayerVIP(Index) & SEP_CHAR

Código:

Sub AddChar(ByVal Index As Long, _

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

Código:

Call AddChar(Index, Name, Sex, Class, CharNum)

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

Código:

Player(Index).Char(i).Guildaccess = Val(GetVar(FileName, "CHAR" & i, "Guildaccess"))

Código:

Player(Index).Char(i).VIP = Val(GetVar(FileName, "CHAR" & i, "VIP"))

Código:

Call PutVar(FileName, "CHAR" & i, "Guildaccess", STR(Player(Index).Char(i).Guildaccess))

Código:

Call PutVar(FileName, "CHAR" & i, "VIP", STR(Player(Index).Char(i).VIP))

Código:

' Ter certeza que não dar experiência menor que 0.
        If Exp < 0 Then
            Exp = 1
        End If

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

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

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

Código:

CharInfo(20).Caption = "Index: " & Index

Código:

CharInfo(23).Caption = "Acesso VIP: " & GetPlayerVIP(Index)

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

Código:

Private Sub scrlX_Change()

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

Créditos: Renanr (eu)

goldeen escreveu:ai no caso no sistema de vips por data apenas mudo o setplayeraccess por um setplayervip ? ou algo do genero ?

EDIT 1

sistema funcionando perfeitamente menos as cores que nao aparecem no nome

GuiinhoLP escreveu:

Bom. renan poderia me explicar como ele funciona .. Pois pelo que vi Se eu kiser. Adicionar. ele com vip Por. data no caso. teria que mudar muita coisa. certo ?

goldeen escreveu:Esse não é por data, porém não interfere acessos e tem suas qualidades -qq'
E as cores aparecem sim, refaz ai pra ver se não faltou alguma coisa pois está certinho xD.

Obrigado aos que deram créditos ;p

eu refiz o sistema mais a cor não foi msm assim.
Enquanto ao vip por data eu fiz uma adaptação no sistema aqui do forum mesmo e funcionou

RenanR escreveu:

Ótimo ;')
Vê se vc realmente lhe deu vip, e tente retirar seu acesso e ficar só com vip pra ver se a cor aparece