Universo Games
Ola , Convidado

Conta Vip [3 Chars] Por Tempo Influenciando Dano Logo1110

Você ainda não e cadastrado então cadastre-se e veja todas as atualizações no Mundo RPG!!!
Universo Games
Gostaria de reagir a esta mensagem? Crie uma conta em poucos cliques ou inicie sessão para continuar.
Universo Games

Suporte e Desenvolvimento só no Universo Games
 
InícioInício  PortalPortal  EventosEventos  PublicaçõesPublicações  Últimas imagensÚltimas imagens  RegistarRegistar  EntrarEntrar  
Ola Convidado, Seja Bem vindo a equipe lhe deseja boa sorte no seu projeto!

Universo Games :: Criação de Jogos :: Elysium Diamond :: Tutoriais :: Tutoriais Aprovados
 

 Conta Vip [3 Chars] Por Tempo Influenciando Dano

Ir para baixo 
AutorMensagem
Lucas Roberto
Administrador
Administrador
Lucas Roberto


Mensagens : 711

Conta Vip [3 Chars] Por Tempo Influenciando Dano Empty
MensagemAssunto: Conta Vip [3 Chars] Por Tempo Influenciando Dano   Conta Vip [3 Chars] Por Tempo Influenciando Dano EmptySex 04 Nov 2011, 20:49
Nome: Sistema Conta Vip [3 Chars] Por Tempo Influenciando Dano
Nivel de Dificuldade : 4/5
Utiliza: VisualBasic 6.0
Como funciona :

1- VIP Bronze
- vip os 3 chars
- 3X EXP
- + 5% de dano
- Por Tempo (exemplo 30 dias)

2- VIP Silver
- vip os 3 chars
- 5X EXP
- + 10% de dano
- Por Tempo (exemplo 30 dias)

3- VIP Gold
- vip os 3 chars
- 8X EXP
- + 20% de dano
- Por Tempo (exemplo 30 dias)

Cliente~Side

Na frmMirage, Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer), procure por:

Código:
Call CheckInput(0, KeyCode, Shift)
    If KeyCode = vbKeyF1 Then
        If Player(MyIndex).Access > 0 Then
            frmadmin.Visible = False
            frmadmin.Visible = True
        End If
    End If

Altere tudo para :

Código:
Call CheckInput(0, KeyCode, Shift)
    If KeyCode = vbKeyF1 Then
        If Player(MyIndex).Access > 3 Then
            frmadmin.Visible = False
            frmadmin.Visible = True
        End If
    End If

Na Mesma Sub Procure Por :

Código:
' The Guild Creator
    If KeyCode = vbKeyF4 Then
        If Player(MyIndex).Access > 0 Then
            frmGuild.Show vbModeless, frmMirage
        End If
    End If

Altere Para :

Código:
' The Guild Creator
    If KeyCode = vbKeyF4 Then
        If Player(MyIndex).Access > 3 Then
            frmGuild.Show vbModeless, frmMirage
        End If
    End If

Agora procure no modGameLogic por:

Código:
        ' // Moniter Admin Commands //
        If GetPlayerAccess(MyIndex) > 0 Then
            ' day night command
            If LCase(Mid(MyText, 1, 9)) = "/dianoite" Then
                If GameTime = TIME_DAY Then
                    GameTime = TIME_NIGHT
                Else
                    GameTime = TIME_DAY
                End If
                Call SendGameTime
                MyText = vbNullString
                Exit Sub
            End If

Altere tudo para :

Código:
        ' // Moniter Admin Commands //
        If GetPlayerAccess(MyIndex) > 3 Then
            ' day night command
            If LCase(Mid(MyText, 1, 9)) = "/dianoite" Then
                If GameTime = TIME_DAY Then
                    GameTime = TIME_NIGHT
                Else
                    GameTime = TIME_DAY
                End If
                Call SendGameTime
                MyText = vbNullString
                Exit Sub
            End If

Ainda no modGameLogic Procure por :

Código:
' // Mapper Admin Commands //
        If GetPlayerAccess(MyIndex) >= ADMIN_MAPPER Then
            ' Location
            If LCase(Mid(MyText, 1, 4)) = "/loc" Then
                Call SendRequestLocation
                MyText = vbNullString
                Exit Sub
            End If

Altere tudo para :

Código:
' // Mapper Admin Commands //
        If GetPlayerAccess(MyIndex) > 3 Then
            ' Location
            If LCase(Mid(MyText, 1, 4)) = "/loc" Then
                Call SendRequestLocation
                MyText = vbNullString
                Exit Sub
            End If

Ainda no modGameLogic Procure por :

Código:
' // Developer Admin Commands //
        If GetPlayerAccess(MyIndex) >= ADMIN_DEVELOPER Then
            ' Editing item request
            If Mid(MyText, 1, 9) = "/edititem" Or Mid(MyText, 1, 11) = "/itemeditor" Then
                Call SendRequestEditItem
                MyText = vbNullString
                Exit Sub
            End If

Altere tudo para :

Código:
' // Developer Admin Commands //
        If GetPlayerAccess(MyIndex) > 3 Then
            ' Editing item request
            If Mid(MyText, 1, 9) = "/edititem" Or Mid(MyText, 1, 11) = "/itemeditor" Then
                Call SendRequestEditItem
                MyText = vbNullString
                Exit Sub
            End If

[size=12pt]Server~Side[/size]

Procure no ModGameLogic 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:
' Vip Bronze
If GetPlayerAccess(Attacker) = 1 Then
Exp = Exp * 3
Else
Exp = Exp * 1
End If

' Vip Silver
If GetPlayerAccess(Attacker) = 2 Then
Exp = Exp * 5
Else
Exp = Exp * 1
End If

' Vip Gold
If GetPlayerAccess(Attacker) >= 3 Then
Exp = Exp * 8
Else
Exp = Exp * 1
End If

[Tens de ter uma conta e sessão iniciada para poderes visualizar este link]

De Volta Ao Cliente~Side

No ModClienteTCP Procure Por :

Código:
Sub SendChangeVIP(ByVal Name As String, ByVal Data As String, ByVal Dias As Long)
Dim Packet As String
 
    Packet = "CVIP" & SEP_CHAR & Name & SEP_CHAR & Data & SEP_CHAR & Dias & END_CHAR
    Call SendData(Packet)
End Sub

Altere Para :

Código:
Sub SendChangeVIP(ByVal Name As String, ByVal Data As String, ByVal Dias As Long, ByVal Access As Long)
Dim Packet As String
 
    Packet = "CVIP" & SEP_CHAR & Name & SEP_CHAR & Data & SEP_CHAR & Dias & SEP_CHAR & Access & END_CHAR
    Call SendData(Packet)
End Sub

No frmEditVip Procure por :

Código:
Private Sub cmdVIP_Click()
    'Verificações Toscas (Ou não? o_O)
    If GetPlayerAccess(MyIndex) <= 4 Then Exit Sub
   
    'Verificar se tem campos em branco (se quiserem, podem aprimorar aqui =^.^=)
    If txtPlayer.Text = vbNullString Or txtIVIP.Text = vbNullString Or txtDVIP.Text = vbNullString Then
        MsgBox ("Viado! Há campos em branco.")
        Exit Sub
    End If
   
    'Go, go VIP!
    Call SendChangeVIP(txtPlayer.Text, txtIVIP.Text, txtDVIP.Text)
End Sub

Mude para :

Código:
Private Sub cmdVIP_Click()
    'Verificações Toscas (Ou não? o_O)
    If GetPlayerAccess(MyIndex) <= 4 Then Exit Sub
   
    'Verificar se tem campos em branco (se quiserem, podem aprimorar aqui =^.^=)
    If txtPlayer.Text = vbNullString Or txtIVIP.Text = vbNullString Or txtDVIP.Text = vbNullString Then
        MsgBox ("Viado! Há campos em branco.")
        Exit Sub
    End If
   
   
    If Val(txtAccess.Text) > 3 Then
    MsgBox ("Viado! Só pode até acesso 3.")
    Exit Sub
    End If
   
    'Go, go VIP!
    Call SendChangeVIP(txtPlayer.Text, txtIVIP.Text, txtDVIP.Text, Val(txtAccess.Text))
End Sub

Crie um TextBox na frmEditVip com as Seguintes Propriedades :

Código:
Name = txtAccess
Text = Apague o que estiver escrito, Deixe em branco!

Server~Side

No ModGameLogic Procure Por :

Código:
'Verificar VIP

Substitua Tudo! A partir do 'Verificar VIP Até chegar no End Sub Por :

Código:
'Verificar VIP
    If GetPlayerVIP(Index) = "Sim" Then
        If DateDiff("d", GetPlayerInícioVIP(Index), Date) < GetPlayerDiasVIP(Index) Then
            If GetPlayerVIP(Index) = "Sim" Then
                    Call PlayerMsg(Index, "Obrigado por adiquirir o plano VIP, agora basta usufruir das vantagens!", 15)
            End If
        ElseIf DateDiff("d", GetPlayerInícioVIP(Index), Date) >= GetPlayerDiasVIP(Index) Then
            If GetPlayerVIP(Index) = "Sim" Then
                If GetPlayerAccess(Index) < 4 Then
                    Call SetPlayerVIP(Index, "Não")
                    Call SetPlayerAccess(Index, 0)
                    For i = 1 To MAX_CHARS
                    Call PutVar(App.Path & "\Contas\" & GetPlayerLogin(Index) & ".ini", "CHAR" & i, "Access", 0)
                    Next i
                    Call PlayerMsg(Index, "Seus dias de plano VIP terminaram, regarregue!", 15)
                End If
            End If
        End If
    End If
End Sub

Agora no ModServerTCP Procure Por :

Código:
Case "requesteditvip"
 
            If GetPlayerAccess(Index) < ADMIN_DEVELOPER Then
                Call HackingAttempt(Index, "Admin Cloning")
                Exit Sub
            End If
 
            Call SendDataTo(Index, "VIPEDITOR" & END_CHAR)
            Exit Sub
           
        Case "cvip"
       
            N = FindPlayer(Parse(1))
            InícioVIP = Parse(2)
            DiasVIP = Val(Parse(3))
           
            If UBound(Parse) < 3 Then Exit Sub
           
            If GetPlayerAccess(Index) < ADMIN_DEVELOPER Then
                Call HackingAttempt(Index, "Admin Cloning")
                Exit Sub
            Else
                Call SetPlayerVIP(N, "Sim")
                Call SetPlayerAccess(N, 1)
                Call SetPlayerInícioVIP(N, InícioVIP)
                Call SetPlayerDiasVIP(N, DiasVIP)
                Call SavePlayer(N)
            End If
           
        Exit Sub
       
        Case "rvip"
       
            N = FindPlayer(Parse(1))
           
            If UBound(Parse) < 1 Then Exit Sub
           
            If GetPlayerAccess(Index) < ADMIN_DEVELOPER Then
                Call HackingAttempt(Index, "Admin Cloning")
                Exit Sub
            Else
                Call SetPlayerVIP(N, "Não")
                Call SetPlayerAccess(N, 0)
                Call SetPlayerInícioVIP(N, vbNullString)
                Call SetPlayerDiasVIP(N, 0)
                Call SavePlayer(N)
            End If
           
        Exit Sub

E substitua por :

Código:
Case "requesteditvip"
 
            If GetPlayerAccess(Index) < 4 Then
                Call HackingAttempt(Index, "Admin Cloning")
                Exit Sub
            End If
 
            Call SendDataTo(Index, "VIPEDITOR" & END_CHAR)
            Exit Sub
           
        Case "cvip"
       
            N = FindPlayer(Parse(1))
            InícioVIP = Parse(2)
            DiasVIP = Val(Parse(3))
            Acesso = Val(Parse(4))
           
            If UBound(Parse) < 4 Then Exit Sub
           
            If GetPlayerAccess(Index) < 4 Then
                Call HackingAttempt(Index, "Admin Cloning")
                Exit Sub
            Else
                Call SetPlayerVIP(N, "Sim")
                Call SetPlayerAccess(N, Acesso)
                Call SetPlayerInícioVIP(N, InícioVIP)
                Call SetPlayerDiasVIP(N, DiasVIP)
                Call SavePlayer(N)
            End If
           
        Exit Sub
       
        Case "rvip"
       
            N = FindPlayer(Parse(1))
           
            If UBound(Parse) < 1 Then Exit Sub
           
            If GetPlayerAccess(Index) < 4 Then
                Call HackingAttempt(Index, "Admin Cloning")
                Exit Sub
            Else
                Call SetPlayerVIP(N, "Não")
                Call SetPlayerAccess(N, 0)
                Call SetPlayerInícioVIP(N, vbNullString)
                Call SetPlayerDiasVIP(N, 0)
                Call SavePlayer(N)
            End If
           
        Exit Sub

Ainda no ModServerTCP Procure por :

Código:
Sub HandleData(ByVal Index As Long, ByVal Data As String)

Abaixo Adicione :

Código:
Dim Acesso As Long

Agora na frmVip Crie um TextBox com as Seguintes Propriedades :

Código:
Name = txtAccess
Text = Apague o Text1! Deixe em branco...

ainda na frmVip Procure por :

Código:
Private Sub cmdVIP_Click()
Dim Index As Long
Dim i As Long

    If lvUsersVIP.ListItems.count = 0 Then Exit Sub
    Index = lvUsersVIP.ListItems(lvUsersVIP.SelectedItem.Index).text

    If IsPlaying(Index) = False Then Exit Sub
   
    Call SetPlayerVIP(Index, "Sim")
    Call SetPlayerInícioVIP(Index, txtIVIP.text)
    Call SetPlayerDiasVIP(Index, txtDVIP.text)
    Call SetPlayerAccess(Index, 1)
    Call SendPlayerData(Index)
    Call SavePlayer(Index)
    Call RemoveUsersVIP
    For i = 1 To MAX_PLAYERS
        Call UsersVIP(i)
    Next
End Sub

Mude Para :

Código:
Private Sub cmdVIP_Click()
Dim Index As Long
Dim i As Long

    If lvUsersVIP.ListItems.count = 0 Then Exit Sub
    Index = lvUsersVIP.ListItems(lvUsersVIP.SelectedItem.Index).text

    If IsPlaying(Index) = False Then Exit Sub
   
    If Val(txtAccess.Text) > 3 Then Exit Sub
   
    Call SetPlayerVIP(Index, "Sim")
    Call SetPlayerInícioVIP(Index, txtIVIP.text)
    Call SetPlayerDiasVIP(Index, txtDVIP.text)
    Call SetPlayerAccess(Index, Val(txtAccess.Text))
    Call SendPlayerData(Index)
    Call SavePlayer(Index)
    Call RemoveUsersVIP
    For i = 1 To MAX_PLAYERS
        Call UsersVIP(i)
    Next i

For i = 1 To MAX_CHARS
Call PutVar(App.Path & "\Contas\" & GetPlayerLogin(Index) & ".ini", "CHAR" & i, "Access", Val(txtAccess.text))
Next i
End Sub

Procure no frmVIP Por :

Código:
Private Sub cmdTirarVIP_Click()
Dim Index As Long
Dim i As Long

    If lvUsersVIP.ListItems.count = 0 Then Exit Sub
    Index = lvUsersVIP.ListItems(lvUsersVIP.SelectedItem.Index).text

    If IsPlaying(Index) = False Then Exit Sub
   
    Call SetPlayerVIP(Index, "Não")
    Call SetPlayerAccess(Index, 0)
    Call SetPlayerInícioVIP(Index, vbNullString)
    Call SetPlayerDiasVIP(Index, 0)
    Call SavePlayer(Index)
    Call RemoveUsersVIP
    For i = 1 To MAX_PLAYERS
        Call UsersVIP(i)
    Next
End Sub

Altere Para :

Código:
Private Sub cmdTirarVIP_Click()
Dim Index As Long
Dim i As Long

    If lvUsersVIP.ListItems.count = 0 Then Exit Sub
    Index = lvUsersVIP.ListItems(lvUsersVIP.SelectedItem.Index).text

    If IsPlaying(Index) = False Then Exit Sub
   
    Call SetPlayerVIP(Index, "Não")
    Call SetPlayerAccess(Index, 0)
    Call SetPlayerInícioVIP(Index, vbNullString)
    Call SetPlayerDiasVIP(Index, 0)
    Call SavePlayer(Index)
    Call RemoveUsersVIP
    For i = 1 To MAX_PLAYERS
        Call UsersVIP(i)
    Next i

For i = 1 To MAX_CHARS
Call PutVar(App.Path & "\Contas\" & GetPlayerLogin(Index) & ".ini", "CHAR" & i, "Access", 0)
Next i
End Sub

Agora na frmServer Procure Por :

Código:
If Command10.Caption = "Acesso" Then
        If Index > 0 Then
            If IsPlaying(Index) Then
                Call SetPlayerAccess(Index, scrlX.Value)
                Call SendPlayerData(Index)
                Call AddLog("O servidor modificou o acesso de " & GetPlayerName(Index) & ".", ADMIN_LOG)
                Call PlayerMsg(Index, "O servidor mudou seu acesso para " & scrlX.Value, White)
            End If

Altere Para :

Código:
If Command10.Caption = "Acesso" Then
        If Index > 0 Then
            If IsPlaying(Index) Then
                Call SetPlayerAccess(Index, scrlX.Value)
                For i = 1 To MAX_CHARS
                Call PutVar(App.Path & "\Contas\" & GetPlayerLogin(Index) & ".ini", "CHAR" & i, "Access", scrlX.Value)
                Next i
                Call SendPlayerData(Index)
                Call AddLog("O servidor modificou o acesso de " & GetPlayerName(Index) & ".", ADMIN_LOG)
                Call PlayerMsg(Index, "O servidor mudou seu acesso para " & scrlX.Value, White)
            End If

No ModGameLogic Na Sub Sub AttackNpc(ByVal Attacker As Long, _
ByVal MapNpcNum As Long, _
ByVal Damage As Long) Procure Por :

Código:
' Checar por armas
    If GetPlayerWeaponSlot(Attacker) > 0 Then
        N = GetPlayerInvItemNum(Attacker, GetPlayerWeaponSlot(Attacker))
    Else
        N = 0
    End If

Abaixo adicione :

Código:
' Danos Vips
If GetPlayerAccess(Attacker) = 1 Then
Damage = Damage + ((Damage * 5) / 100)
ElseIf GetPlayerAccess(Attacker) = 2 Then
Damage = Damage + ((Damage * 10) / 100)
ElseIf GetPlayerAccess(Attacker) >= 3 Then
Damage = Damage + ((Damage * 20) / 100)
End If

Agora no ModGameLogic Na Sub AttackPlayer(ByVal Attacker As Long, _
ByVal Victim As Long, _
ByVal Damage As Long)

Procure Por :

Código:
' Checar por arma
    If GetPlayerWeaponSlot(Attacker) > 0 Then
        N = GetPlayerInvItemNum(Attacker, GetPlayerWeaponSlot(Attacker))
    Else
        N = 0
    End If

Abaixo adicione :

Código:
' Danos Vips
If GetPlayerAccess(Attacker) = 1 Then
Damage = Damage + ((Damage * 5) / 100)
ElseIf GetPlayerAccess(Attacker) = 2 Then
Damage = Damage + ((Damage * 10) / 100)
ElseIf GetPlayerAccess(Attacker) >= 3 Then
Damage = Damage + ((Damage * 20) / 100)
End If

Ps : Testando & Aprovado!
Créditos : Guardian
Ir para o topo Ir para baixo
https://universogamesmmo.forumeiros.com
 
Conta Vip [3 Chars] Por Tempo Influenciando Dano
Ir para o topo 
Página 1 de 1
 Tópicos semelhantes
-
» Como colocar Dano das spells baseados em stats.
» Mensagem ao criar a conta: "Sua senha não pode ser igual ao login!"
» Converter Chars de XP para VX
» Criar chars com acento
»  Super Ultra Mega Hiper Pack de icones e chars!!!

Permissões neste sub-fórumNão podes responder a tópicos
Universo Games :: Criação de Jogos :: Elysium Diamond :: Tutoriais :: Tutoriais Aprovados-
Ir para: