Suporte no desenvolvimento de jogos


    Sistema de Premium por Data

    Eduardo01
    Eduardo01
    Iniciante
    Iniciante

    Mensagens : 46
    Créditos : 10

    Sistema de Premium por Data Empty Sistema de Premium por Data

    Mensagem por Eduardo01 em Qui Jul 26, 2012 4:23 pm

    Olá Galera!

    Hoje estou aqui para ensinar vocês a como criar um sistema de Premium para seu jogo onde o Premium é retirado automaticamente por datas. O sistema de Premium é um sistema que muitos conhecem, só que pelo nome Sistema Vip. Neste tutorial o Sistema Premium dá somente duas vezes mais experiência do que o player normal. Outras características devem ser adicionadas por vocês.

    Vamos ao tutorial.

    Cliente Side

    No Cliente crie uma nova Form com o nome frmEditor_Premium. Deixe-a da seguinte forma :

    Sistema de Premium por Data TutorialPremium

    Dê as seguintes propriedades para os textbox na ordem de cima para baixo :

    Name : txtPlayer
    Name : txtSPremium
    Name : txtDPremium

    Agora, dê as seguintes propriedades para os commands buttons na ordem da esquerda pra direita :

    Name : cmdPremium
    Name : cmdRPremium
    Name : cmdExit

    Agora insira esse código na frmEditor_Premium :
    Código:
    ' Sistema de Premium By : Guardian
    Option Explicit

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

    Me.Visible = False

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

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

        'Check Access
        If GetPlayerAccess(MyIndex) < ADMIN_DEVELOPER Then
            Exit Sub
        End If
       
        'Check for blanks fields
        If txtPlayer.text = vbNullString Or txtSPremium.text = vbNullString Or txtDPremium.text = vbNullString Then
            MsgBox ("There are blank fields, please fill out.")
            Exit Sub
        End If
       
        'If all right, go for the Premium
        Call SendChangePremium(txtPlayer.text, txtSPremium.text, txtDPremium.text)
       
    ' Error handler
        Exit Sub
    errorhandler:
        HandleError "cmdPremium_Click", "frmEditor_Premium", Err.Number, Err.Description, Err.Source, Err.HelpContext
        Err.Clear
        Exit Sub
    End Sub

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

        'Check Access
        If GetPlayerAccess(MyIndex) < ADMIN_DEVELOPER Then
            Exit Sub
        End If
       
        'Check for blanks fields
        If txtPlayer.text = vbNullString Then
            MsgBox ("The name of the player is required for this operation.")
            Exit Sub
        End If
       
        'If all is right, remove the Premium
        Call SendRemovePremium(txtPlayer.text)
       
    ' Error handler
        Exit Sub
    errorhandler:
        HandleError "cmdRPremium_Click", "frmEditor_Premium", Err.Number, Err.Description, Err.Source, Err.HelpContext
        Err.Clear
        Exit Sub
    End Sub


    Agora, na frmMain. Na PicAdmin, crie um botão com o nome cmdAPremium, nele adicione :
    Código:
    ' If debug mode, handle error then exit out
        If Options.Debug = 1 Then On Error GoTo errorhandler

        ' Check Access
        If GetPlayerAccess(MyIndex) < ADMIN_DEVELOPER Then
            Exit Sub
        End If

        Call SendRequestEditPremium
       
        ' Error handler
        Exit Sub
    errorhandler:
        HandleError "cmdAPremium_Click", "frmMain", Err.Number, Err.Description, Err.Source, Err.HelpContext
        Err.Clear
        Exit Sub


    Agora, no final do ModClientTCP adicione :
    Código:
    Sub SendRequestEditPremium()
    Dim Buffer As clsBuffer

        ' If debug mode, handle error then exit out
        If Options.Debug = 1 Then On Error GoTo errorhandler
       
        Set Buffer = New clsBuffer
        Buffer.WriteLong CRequestEditPremium
        SendData Buffer.ToArray()
        Set Buffer = Nothing

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

    Sub SendChangePremium(ByVal Name As String, ByVal Start As String, ByVal Days As Long)
    Dim Buffer As clsBuffer

        ' If debug mode, handle error then exit out
        If Options.Debug = 1 Then On Error GoTo errorhandler
       
        Set Buffer = New clsBuffer
        Buffer.WriteLong CChangePremium
        Buffer.WriteString Name
        Buffer.WriteString Start
        Buffer.WriteLong Days
        SendData Buffer.ToArray()
        Set Buffer = Nothing

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

    Sub SendRemovePremium(ByVal Name As String)
    Dim Buffer As clsBuffer

        ' If debug mode, handle error then exit out
        If Options.Debug = 1 Then On Error GoTo errorhandler
       
        Set Buffer = New clsBuffer
        Buffer.WriteLong CRemovePremium
        Buffer.WriteString Name
        SendData Buffer.ToArray()
        Set Buffer = Nothing

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


    No ModDirectDraw7, procure isso :
    Código:
    For i = 1 To Action_HighIndex
            Call BltActionMsg(i)
        Next i


    Abaixo adicione :
    Código:
    If Premium <> vbNullString Then
        Call DrawPremium
        End If


    Então, no ModEnumerations. Acima disso :
    Código:
    ' Make sure SMSG_COUNT is below everything else
        SMSG_COUNT


    Adicione :
    Código:
    SPlayerDPremium
        SPremiumEditor


    Ainda no ModEnumerations, acima disso :
    Código:
    ' Make sure CMSG_COUNT is below everything else
        CMSG_COUNT


    Adicione :
    Código:
    CRequestEditPremium
        CChangePremium
        CRemovePremium


    Agora, no final do ModGlobals, adicione :
    Código:
    ' Premium
    Public Premium As String
    Public RPremium As String


    No ModHandleData, procure isso :
    Código:
    HandleDataSub(SPartyVitals) = GetAddress(AddressOf HandlePartyVitals)


    Abaixo adicione :
    Código:
    HandleDataSub(SPlayerDPremium) = GetAddress(AddressOf HandlePlayerDPremium)
        HandleDataSub(SPremiumEditor) = GetAddress(AddressOf HandlePremiumEditor)


    Então, no final do ModHandleData adicione :
    Código:
    Private Sub HandlePlayerDPremium(ByVal Index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
    Dim Buffer As clsBuffer
    Dim A As String
    Dim B As Long, c As Long

        ' If debug mode, handle error then exit out
        If Options.Debug = 1 Then On Error GoTo errorhandler
       
        Set Buffer = New clsBuffer
        Buffer.WriteBytes Data()
       
        ' Catch Data
        A = Buffer.ReadString
        B = Buffer.ReadLong
        c = Buffer.ReadLong
       
        ' Changing global variables
        If A = "Sim" Then
        Premium = "Premium : " & A
        RPremium = "You have : " & c - B & " days of Premium."
        Else
        Premium = vbNullString
        RPremium = vbNullString
        End If
       
        ' Error handler
        Exit Sub
    errorhandler:
        HandleError "HandlePlayerDPremium", "modHandleData", Err.Number, Err.Description, Err.Source, Err.HelpContext
        Err.Clear
        Exit Sub
    End Sub

    Private Sub HandlePremiumEditor()
    Dim i As Long

        ' If debug mode, handle error then exit out
        If Options.Debug = 1 Then On Error GoTo errorhandler
       
        ' Check Access
        If GetPlayerAccess(MyIndex) < ADMIN_DEVELOPER Then
        Exit Sub
        End If
       
        ' If you have everything right, up the Editor.
        With frmeditor_Premium
        .Visible = True
        End With
       
        ' Error handler
        Exit Sub
    errorhandler:
        HandleError "HandlePremiumEditor", "modHandleData", Err.Number, Err.Description, Err.Source, Err.HelpContext
        Err.Clear
        Exit Sub
    End Sub


    Agora, no final do ModText adicione :
    Código:
    Public Sub DrawPremium()
    Dim x As Long
    Dim x2 As Long
    Dim y As Long

    x = Camera.Left + ((MAX_MAPX + 1) * PIC_X / 2) - getWidth(TexthDC, Trim$(Premium))
    x2 = Camera.Left + ((MAX_MAPX + 1) * PIC_X / 2) - getWidth(TexthDC, Trim$(RPremium))
    y = Camera.top + 1

    Call DrawText(TexthDC, x - 190, y, Premium, QBColor(BrightBlue))
    Call DrawText(TexthDC, x2 - 145, y + 20, RPremium, QBColor(BrightRed))
    End Sub


    Para finalizar o cliente, no ModTypes, procure isso :
    Código:
    ' Client use only


    Acima adicione :
    Código:
    ' Premium
        Premium As String
        StartPremium As String
        DaysPremium As Long




    Server Side

    No ModCombat, Na Sub PlayerAttackNpc, ache isso :
    Código:
    ' Calculate exp to give attacker
            exp = Npc(npcNum).exp


    Abaixo adicione :
    Código:
    ' Premium
            If GetPlayerPremium(attacker) = "Sim" Then
            exp = exp * 2
            End If


    Agora, Na ModEnumerations. Ache isso :
    Código:
    ' Make sure SMSG_COUNT is below everything else
        SMSG_COUNT


    Acima, adicione :
    Código:
    SPlayerDPremium
        SPremiumEditor


    Ainda na ModEnumerations, ache isso :
    Código:
    ' Make sure CMSG_COUNT is below everything else
        CMSG_COUNT


    Acima, adicione :
    Código:
    CRequestEditPremium
        CChangePremium
        CRemovePremium


    Na ModHandleData, ache isso :
    Código:
    HandleDataSub(CPartyLeave) = GetAddress(AddressOf HandlePartyLeave)


    Abaixo adicione :
    Código:
    HandleDataSub(CRequestEditPremium) = GetAddress(AddressOf HandleRequestEditPremium)
        HandleDataSub(CChangePremium) = GetAddress(AddressOf HandleChangePremium)
        HandleDataSub(CRemovePremium) = GetAddress(AddressOf HandleRemovePremium)


    Ainda na ModHandleData, la no final adicione :
    Código:
    Sub HandleRequestEditPremium(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)

    ' Check Access
    If GetPlayerAccess(index) < ADMIN_DEVELOPER Then
        Call PlayerMsg(index, "You do not have access to complete this action!", White)
        Exit Sub
    End If

    Call SendPremiumEditor(index)
    End Sub

    Sub HandleChangePremium(ByVal Index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
    Dim Buffer As clsBuffer
    Dim A As String
    Dim B As String
    Dim C As Long
    Dim D As String
       
        Set Buffer = New clsBuffer
        Buffer.WriteBytes Data()
       
        A = Buffer.ReadString
        B = Buffer.ReadString
        C = Buffer.ReadLong
       
        D = FindPlayer(A)
       
        If IsPlaying(D) Then
               
        ' Check access if everything is right, change Premium
        If GetPlayerAccess(Index) < ADMIN_DEVELOPER Then
            Call PlayerMsg(Index, "You do not have access to complete this action!", White)
            Exit Sub
        Else
            Call SetPlayerPremium(D, "Sim")
            Call SetPlayerStartPremium(D, B)
            Call SetPlayerDaysPremium(D, C)
            GlobalMsg "The player " & GetPlayerName(D) & " became Premium. Congratulations!", BrightCyan
        End If
       
        SendPlayerData D
        SendDataPremium D
       
        End If
       
        Set Buffer = Nothing
    End Sub

    Sub HandleRemovePremium(ByVal Index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
    Dim Buffer As clsBuffer
    Dim A As String
    Dim B As String
       
        Set Buffer = New clsBuffer
        Buffer.WriteBytes Data()
       
        A = Buffer.ReadString
       
        B = FindPlayer(A)
       
        If IsPlaying(B) Then
               
        ' Check access if everything is right, change Premium
        If GetPlayerAccess(Index) < ADMIN_DEVELOPER Then
            Call PlayerMsg(Index, "You do not have access to complete this action!", White)
            Exit Sub
        Else
            Call SetPlayerPremium(B, "Não")
            Call SetPlayerStartPremium(B, vbNullString)
            Call SetPlayerDaysPremium(B, 0)
            PlayerMsg B, "His days of premium sold out.", BrightCyan
        End If
       
        SendPlayerData B
        SendDataPremium B
       
        End If
       
        Set Buffer = Nothing
    End Sub


    Agora no final da ModPlayer, adicione :
    Código:
    ' Premium
    Function GetPlayerPremium(ByVal index As Long) As String
        GetPlayerPremium = Trim$(Player(index).Premium)
    End Function
     
    Sub SetPlayerPremium(ByVal index As Long, ByVal Premium As String)
        Player(index).Premium = Premium
    End Sub
     
    ' Start Premium
    Function GetPlayerStartPremium(ByVal index As Long) As String
        GetPlayerStartPremium = Trim$(Player(index).StartPremium)
    End Function
     
    Sub SetPlayerStartPremium(ByVal index As Long, ByVal StartPremium As String)
        Player(index).StartPremium = StartPremium
    End Sub
     
    ' Days Premium
    Function GetPlayerDaysPremium(ByVal index As Long) As Long
        GetPlayerDaysPremium = Player(index).DaysPremium
    End Function
     
    Sub SetPlayerDaysPremium(ByVal index As Long, ByVal DaysPremium As Long)
        Player(index).DaysPremium = DaysPremium
    End Sub

    Sub CheckPremium(ByVal index As Long)

        ' Check Premium
        If GetPlayerPremium(index) = "Sim" Then
            If DateDiff("d", GetPlayerStartPremium(index), Date) < GetPlayerDaysPremium(index) Then
                If GetPlayerPremium(index) = "Sim" Then
                    Call PlayerMsg(index, "Thank you for purchasing the Premium Plan, Good Game!", White)
                End If
            ElseIf DateDiff("d", GetPlayerStartPremium(index), Date) >= GetPlayerDaysPremium(index) Then
                If GetPlayerPremium(index) = "Sim" Then
                    Call SetPlayerPremium(index, "Não")
                    Call PlayerMsg(index, "His days with the Premium plan exhausted, Good Game!", White)
                End If
            End If
        End If
    End Sub


    Agora no final do ModServerTCP, adicione :
    Código:
    Sub SendDataPremium(ByVal index As Long)
    Dim Buffer As clsBuffer
    Dim A As Long

        If GetPlayerPremium(index) = "Sim" Then
            A = DateDiff("d", GetPlayerStartPremium(index), Now)
        Else
            A = 0
        End If

        Set Buffer = New clsBuffer
        Buffer.WriteLong SPlayerDPremium
        Buffer.WriteString GetPlayerPremium(index)
        Buffer.WriteLong A
        Buffer.WriteLong GetPlayerDaysPremium(index)
       
        SendDataTo index, Buffer.ToArray()
        Set Buffer = Nothing
    End Sub

    Sub SendPremiumEditor(ByVal index As Long)
    Dim Buffer As clsBuffer

        Set Buffer = New clsBuffer
        Buffer.WriteLong SPremiumEditor
       
        SendDataTo index, Buffer.ToArray()
        Set Buffer = Nothing
    End Sub


    No ModTypes, Na Type PlayerRec, ache isso :
    Código:
    Dir As Byte


    Abaixo adicione :
    Código:
    ' Premium
        Premium As String
        StartPremium As String
        DaysPremium As Long


    No ModPlayer, ache isso :
    Código:
    Call SendWornEquipment(index)
        Call SendMapEquipment(index)
        Call SendPlayerSpells(index)
        Call SendHotbar(index)


    Abaixo, adicione :
    Código:
    Call CheckPremium(index)


    No ModDatabase, Na Sub AddChar, ache isso :
    Código:
    Player(index).Class = ClassNum


    Abaixo, adicione :
    Código:
    Player(index).Premium = "Não"
            Player(index).StartPremium = "00/00/0000"
            Player(index).DaysPremium = 0


    Ainda no ModDatabase, Na Sub ClearPlayer, ache isso :
    Código:
    Player(index).Class = 1


    Abaixo adicione :
    Código:
    Player(index).Premium = "Não"
        Player(index).StartPremium = "00/00/0000"
        Player(index).DaysPremium = 0


    Na ModHandleData, Na Sub HandleLogin, ache isso :
    Código:
    ' Show the player up on the socket status


    Acima, adicione :
    Código:
    Call SendDataPremium(index)


    Ainda na ModHandleData, na HandleAddChar, ache :
    Código:
    Call AddChar(index, Name, Sex, Class, Sprite)


    Abaixo adicione :
    Código:
    Call SendDataPremium(index)


    Créditos : Guardian
    avatar
    Corrupted
    Semi-Experiente
    Semi-Experiente

    Mensagens : 126
    Créditos : 8

    Sistema de Premium por Data Empty Re: Sistema de Premium por Data

    Mensagem por Corrupted em Qui Jan 26, 2017 6:18 am

    Como faço pra apenas quem é premium quado clicar em um botão que aparece um picturebox mas precisa ser premium
    e se não for premium aparecer uma mensagem " você não é Premium"?
    Edit: Desculpa reviver o topico, é que não achei o codigo.


    Última edição por makthoxz em Sex Jan 27, 2017 9:00 am, editado 1 vez(es)
    avatar
    gui408
    Ocasional
    Ocasional

    Mensagens : 227
    Créditos : 10

    Sistema de Premium por Data Empty Re: Sistema de Premium por Data

    Mensagem por gui408 em Qui Jan 26, 2017 4:12 pm

    Parceiro olha a data do topico, area errada, vai em duvidas e pedidos, e se vc procurar em tutoriais vc vai achar isso que vc quer, da uma pesquisada antes Very Happy

    Conteúdo patrocinado

    Sistema de Premium por Data Empty Re: Sistema de Premium por Data

    Mensagem por Conteúdo patrocinado


      Data/hora atual: Qua Jan 22, 2020 12:10 am