Aldeia RPG

Gostaria de reagir a esta mensagem? Crie uma conta em poucos cliques ou inicie sessão para continuar.

Suporte ao desenvolvimento de jogos


2 participantes

    Sistema de Conquista (1.0)

    thales12
    thales12
    Membro de Honra
    Membro de Honra


    Mensagens : 322
    Créditos : 108

    Ficha do personagem
    Nível: 1
    Experiência:
    Sistema - Sistema de Conquista (1.0) Left_bar_bleue0/0Sistema - Sistema de Conquista (1.0) Empty_bar_bleue  (0/0)
    Vida:
    Sistema - Sistema de Conquista (1.0) Left_bar_bleue30/30Sistema - Sistema de Conquista (1.0) Empty_bar_bleue  (30/30)

    Sistema - Sistema de Conquista (1.0) Empty Sistema de Conquista (1.0)

    Mensagem por thales12 Sex Jun 30, 2023 10:59 am

    um sisteminha que eu acho muito interessante e quase obrigatorio ter em um jogo haha
    talvez eu atualize, mas fiquem a vontade para postarem atualização caso queiram
    qualquer dúvida podem perguntar
    sistema um pouquinho grande, vamos lá Wink

    Abra o Client~Side Adicione uma nova Form e mude o nome para: frmEditConquista

    dentro da frmEditConquista adicione:

    uma listbox chamada: lstindex
    uma textbox chamada txtName
    uma combobox chamada cmbType
    uma textbox chamada txtLevel
    um commandbutton chamado cmdSave com caption salvar
    um commandbutton chamado cmdDelete com caption Deletar
    um commandbutton chamado cmdCancel com caption Cancelar

    no código da frmEditConquista coloque o seguinte código:

    Código:
    Option Explicit

    Private Sub cmbType_Click()
        Conquista(EditorIndex).Type = cmbType.ListIndex
    End Sub

    Private Sub cmdCancel_Click()
        Call ConquistaEditorCancel
    End Sub

    Private Sub cmdSave_Click()
        Call ConquistaEditorOk
    End Sub

    Private Sub lstIndex_Click()
        ConquistaEditorInit
    End Sub

    Private Sub txtLevel_Change()
        Conquista(EditorIndex).Level = Trim$(txtLevel.text)
    End Sub

    Private Sub txtName_Validate(Cancel As Boolean)
    Dim tmpIndex As Long

        ' If debug mode, handle error then exit out
        If Options.Debug = 1 Then On Error GoTo errorhandler
        
        If EditorIndex = 0 Or EditorIndex > MAX_CONQUISTAS Then Exit Sub
        tmpIndex = lstIndex.ListIndex
        Conquista(EditorIndex).Name = Trim$(txtName.text)
        lstIndex.RemoveItem EditorIndex - 1
        lstIndex.AddItem EditorIndex & ": " & Conquista(EditorIndex).Name, EditorIndex - 1
        lstIndex.ListIndex = tmpIndex
      
       ' Error handler
        Exit Sub
    errorhandler:
        HandleError "txtName_Validate", "frmEditConquistas", Err.Number, Err.Description, Err.Source, Err.HelpContext
        Err.Clear
    End Sub

    na frmMain adicione:

    um commandbutton chamado OpenConq com caption Conquistas

    de dois cliques nele e adicione o seguinte código:

    Código:
    picConquistas.Visible = Not picConquistas.Visible

    ainda na frmMain crie uma picture chamada picConquistas
    dentro da picConquistas adicione uma label chamada lblConquista
    uma label chamada: lblNameConquista
    um commandbutton chamado: btnColetar com caption: Coletar e visible false


    de dois clicks no btnColetar e adicione:

    Código:
    SendColetar

    no painel admin add um commandbutton de 2 clicks nele e adicione:

    Código:
    SendRequestEditConquistas

    procure por:

    Código:
    Public Animation(1 To MAX_ANIMATIONS) As AnimationRec

    Abaixo adicione:

    Código:
    Public Conquista(1 To MAX_CONQUISTAS) As ConquistaRec

    dentro da Private Type PlayerRec adicione:

    Código:
    Conquistas As Byte

    ainda na modTypes adicione:

    Código:
    Private Type ConquistaRec
        Name As String * NAME_LENGTH
        Type As Byte
        Level As Byte
        num As Byte
    End Type

    no modClientTcp adicione:

    Código:
    Public Sub SendSaveConquistas(ByVal ConquistaNum As Long)
    Dim Buffer As clsBuffer
    Dim ConquistaSize As Long
    Dim ConquistaData() As Byte

        ' If debug mode, handle error then exit out
        If Options.Debug = 1 Then On Error GoTo errorhandler
        
        Set Buffer = New clsBuffer
        ConquistaSize = LenB(Conquista(ConquistaNum))
        ReDim ConquistaData(ConquistaSize - 1)
        CopyMemory ConquistaData(0), ByVal VarPtr(Conquista(ConquistaNum)), ConquistaSize
        Buffer.WriteLong CSaveConquistas
        Buffer.WriteLong ConquistaNum
        Buffer.WriteBytes ConquistaData
        SendData Buffer.ToArray()
        Set Buffer = Nothing
        
        ' Error handler
        Exit Sub
    errorhandler:
        HandleError "SendSaveConquistas", "modClientTCP", Err.Number, Err.Description, Err.Source, Err.HelpContext
        Err.Clear
        Exit Sub
    End Sub

    Public Sub SendRequestEditConquistas()
    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 CRequestEditConquistas
        SendData Buffer.ToArray()
        Set Buffer = Nothing
        
        ' Error handler
        Exit Sub
    errorhandler:
        HandleError "SendRequestEditConquistas", "modClientTCP", Err.Number, Err.Description, Err.Source, Err.HelpContext
        Err.Clear
        Exit Sub
    End Sub

    Sub SendRequestConquistas()
    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 CRequestConquistas
        SendData Buffer.ToArray()
        Set Buffer = Nothing
        
        ' Error handler
        Exit Sub
    errorhandler:
        HandleError "SendRequestConquistas", "modClientTCP", Err.Number, Err.Description, Err.Source, Err.HelpContext
        Err.Clear
        Exit Sub
    End Sub

    Function GetPlayerConq(ByVal Index As Long) As Long
        ' If debug mode, handle error then exit out
        If Options.Debug = 1 Then On Error GoTo errorhandler

        If Index > MAX_PLAYERS Then Exit Function
        GetPlayerConq = Player(Index).Conquistas
        
        ' Error handler
        Exit Function
    errorhandler:
        HandleError "GetPlayerConq", "modDatabase", Err.Number, Err.Description, Err.Source, Err.HelpContext
        Err.Clear
        Exit Function
    End Function

    Sub SetPlayerConq(ByVal Index As Long, ByVal num As Long)
        ' If debug mode, handle error then exit out
        If Options.Debug = 1 Then On Error GoTo errorhandler

        If Index > MAX_PLAYERS Then Exit Sub
        Player(Index).Conquistas = num
        
        ' Error handler
        Exit Sub
    errorhandler:
        HandleError "SetPlayerConq", "modDatabase", Err.Number, Err.Description, Err.Source, Err.HelpContext
        Err.Clear
        Exit Sub
    End Sub

    na modDataBase adicione:

    Código:
    Sub ClearConquista(ByVal Index As Long)
        ' If debug mode, handle error then exit out
        If Options.Debug = 1 Then On Error GoTo errorhandler

        Call ZeroMemory(ByVal VarPtr(Conquista(Index)), LenB(Conquista(Index)))
        Conquista(Index).Name = vbNullString
        
        ' Error handler
        Exit Sub
    errorhandler:
        HandleError "ClearConquista", "modDatabase", Err.Number, Err.Description, Err.Source, Err.HelpContext
        Err.Clear
        Exit Sub
    End Sub

    Sub ClearConquistas()
    Dim i As Long

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

        For i = 1 To MAX_CONQUISTAS
            Call ClearConquista(i)
        Next

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


    procure por:

    Código:
    Public Const MAX_PARTY_MEMBERS As Long = 4

    abaixo adicione:

    Código:
    Public Const MAX_CONQUISTAS As Long = 255

    procure por:

    Código:
    Public Const EDITOR_ANIMATION As Byte = 6

    abaixo adicione:

    Código:
    Public Const EDITOR_CONQUISTA As Byte = 7

    procure por:

    Código:
    Public Shop_Changed(1 To MAX_SHOPS) As Boolean

    abaixo adicione:

    Código:
    Public Conquista_Changed(1 To MAX_CONQUISTAS) As Boolean

    na modGameEditors adicione:

    Código:
    Public Sub ConquistaEditorInit()
    Dim i As Long
    Dim SoundSet As Boolean
        
        ' If debug mode, handle error then exit out
        If Options.Debug = 1 Then On Error GoTo errorhandler

        If frmEditConquista.Visible = False Then Exit Sub
        EditorIndex = frmEditConquista.lstIndex.ListIndex + 1
        
        ' populate the cache if we need to
        If Not hasPopulated Then
            PopulateLists
        End If
        
        With frmEditConquista
            .txtName.text = Trim$(Conquista(EditorIndex).Name)
            .cmbType.ListIndex = Conquista(EditorIndex).Type
            .txtLevel.text = Trim$(Conquista(EditorIndex).Level)
            EditorIndex = frmEditConquista.lstIndex.ListIndex + 1
        End With

        Conquista_Changed(EditorIndex) = True
        
        ' Error handler
        Exit Sub
    errorhandler:
        HandleError "ConquistaEditorInit", "modGameEditors", Err.Number, Err.Description, Err.Source, Err.HelpContext
        Err.Clear
        Exit Sub
    End Sub

    Public Sub ConquistaEditorOk()
    Dim i As Long

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

        For i = 1 To MAX_CONQUISTAS
            If Conquista_Changed(i) Then
                Call SendSaveConquistas(i)
            End If
        Next
        
        Unload frmEditConquista
        Editor = 0
        ClearChanged_Conquista
        
        ' Error handler
        Exit Sub
    errorhandler:
        HandleError "ConquistaEditorOk", "modGameEditors", Err.Number, Err.Description, Err.Source, Err.HelpContext
        Err.Clear
        Exit Sub
    End Sub

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

        Editor = 0
        Unload frmEditConquista
        ClearChanged_Conquista
        ClearConquistas
        SendRequestConquistas
        
        ' Error handler
        Exit Sub
    errorhandler:
        HandleError "ConquistaEditorCancel", "modGameEditors", Err.Number, Err.Description, Err.Source, Err.HelpContext
        Err.Clear
        Exit Sub
    End Sub

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

        ZeroMemory Conquista_Changed(1), MAX_CONQUISTAS * 2 ' 2 = boolean length
        
        ' Error handler
        Exit Sub
    errorhandler:
        HandleError "ClearChanged_Conquista", "modGameEditors", Err.Number, Err.Description, Err.Source, Err.HelpContext
        Err.Clear
        Exit Sub
    End Sub

    na Public Enum ServerPackets acima de ' Make sure SMSG_COUNT is below everything else adicione:

    Código:
    SConquistaEditor
    SUpdateConquista
    SPlayerConquistas

    na Public Enum ClientPackets acima de ' Make sure CMSG_COUNT is below everything else adicione:


    Código:
    CRequestEditConquistas
    CSaveConquistas
    CRequestConquistas
    CColetar

    na Public Sub InitMessages() adicione:

    Código:
    HandleDataSub(SConquistaEditor) = GetAddress(AddressOf HandleConquistaEditor)
    HandleDataSub(SUpdateConquista) = GetAddress(AddressOf HandleUpdateConquista)
    HandleDataSub(SPlayerConquistas) = GetAddress(AddressOf HandlePlayerConquistas)

    no final da modHandleData adicione:

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

        ' If debug mode, handle error then exit out
        If Options.Debug = 1 Then On Error GoTo errorhandler
        
        With frmEditConquista
            Editor = EDITOR_CONQUISTA
            .lstIndex.Clear

            ' Add the names
            For i = 1 To MAX_CONQUISTAS
                .lstIndex.AddItem i & ": " & Trim$(Conquista(i).Name)
            Next

            .Show
            .lstIndex.ListIndex = 0
            ConquistaEditorInit
        End With
        
        ' Error handler
        Exit Sub
    errorhandler:
        HandleError "HandleConquistaEditor", "modHandleData", Err.Number, Err.Description, Err.Source, Err.HelpContext
        Err.Clear
        Exit Sub
    End Sub

    Private Sub HandleUpdateConquista(ByVal Index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
    Dim n As Long
    Dim Buffer As clsBuffer
    Dim ConquistaSize As Long
    Dim ConquistaData() As Byte
        
        ' If debug mode, handle error then exit out
        If Options.Debug = 1 Then On Error GoTo errorhandler
        
        Set Buffer = New clsBuffer
        Buffer.WriteBytes Data()
        
        n = Buffer.ReadLong
        
        ConquistaSize = LenB(Conquista(n))
        ReDim ConquistaData(ConquistaSize - 1)
        ConquistaData = Buffer.ReadBytes(ConquistaSize)
        CopyMemory ByVal VarPtr(Conquista(n)), ByVal VarPtr(ConquistaData(0)), ConquistaSize
        
        Set Buffer = Nothing
        
        ' Error handler
        Exit Sub
    errorhandler:
        HandleError "HandleUpdateConquista", "modHandleData", Err.Number, Err.Description, Err.Source, Err.HelpContext
        Err.Clear
        Exit Sub
    End Sub

    Private Sub HandlePlayerConquistas(ByVal Index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
    Dim Buffer As clsBuffer, i As Long
    Dim Conquistas As Long
    Dim Level As Long
    Dim Nivel 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()
        Conquistas = Buffer.ReadByte
        Level = Buffer.ReadByte
        Nivel = Buffer.ReadByte
        
        frmMain.lblNameConquista.Caption = Conquista(1).Name
        
        If Nivel <= 6 Then
            frmMain.lblConquista.Caption = Nivel & " / " & Level
        Else
            frmMain.lblConquista.Caption = "6 " & " / " & Level
        End If
        
        If Conquistas = 1 Then
            frmMain.btnColetar.Visible = True
        End If
        
        
        Set Buffer = Nothing
        ' Error handler
        Exit Sub
    errorhandler:
        HandleError "HandlePlayerConquistas", "modHandleData", Err.Number, Err.Description, Err.Source, Err.HelpContext
        Err.Clear
        Exit Sub
    End Sub

    no final da modClientTcp adicione:

    Código:
    Public Sub SendColetar()
    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 CColetar
        SendData Buffer.ToArray()
        Set Buffer = Nothing
        
        ' Error handler
        Exit Sub
    errorhandler:
        HandleError "SendColetar", "modClientTCP", Err.Number, Err.Description, Err.Source, Err.HelpContext
        Err.Clear
        Exit Sub
    End Sub

    dentro da Private Sub HandlePlayerData adicione:

    Código:
    Call SetPlayerConq(i, Buffer.ReadByte)

    Cliente~Side finalizado, agora vamos para o Server~Side:

    na modTypes acima de: Public Options As OptionsRec

    adicione:

    Código:
    Public Conquista(1 To MAX_CONQUISTAS) As ConquistaRec

    dentro da Private Type PlayerRec adicione:

    Código:
    Conquistas As Byte
    ColetaOk(1 To 10) As Byte

    no final da modTypes adicione:

    Código:
    Private Type ConquistaRec
        Name As String * NAME_LENGTH
        Type As Byte
        Level As Byte
        Num As Byte
    End Type

    dentro da Public Enum ServerPackets acima de ' Make sure SMSG_COUNT is below everything else adicione:

    Código:
    SConquistaEditor
    SUpdateConquista
    SPlayerConquistas

    dentro da Public Enum ClientPackets acima de ' Make sure CMSG_COUNT is below everything else adicione:

    Código:
    CRequestEditConquistas
    CSaveConquistas
    CRequestConquistas
    CColetar

    dentro da Public Sub InitMessages() adicione:

    Código:
    HandleDataSub(CRequestEditConquistas) = GetAddress(AddressOf HandleRequestEditConquistas)
    HandleDataSub(CSaveConquistas) = GetAddress(AddressOf HandleSaveConquistas)
    HandleDataSub(CRequestConquistas) = GetAddress(AddressOf HandleRequestConquistas)
    HandleDataSub(CColetar) = GetAddress(AddressOf HandleColetar)

    no final da modHandleData adicione:

    Código:
    Sub HandleRequestEditConquistas(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
        Dim Buffer As clsBuffer

        ' Prevent hacking
        If GetPlayerAccess(index) < ADMIN_DEVELOPER Then
            Exit Sub
        End If

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

    Private Sub HandleSaveConquistas(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
        Dim ConquistaNum As Long
        Dim Buffer As clsBuffer
        Dim ConquistaSize As Long
        Dim ConquistaData() As Byte

        ' Prevent hacking
        If GetPlayerAccess(index) < ADMIN_DEVELOPER Then
            Exit Sub
        End If

        Set Buffer = New clsBuffer
        Buffer.WriteBytes Data()
        ConquistaNum = Buffer.ReadLong

        ' Prevent hacking
        If ConquistaNum < 0 Or ConquistaNum > MAX_CONQUISTAS Then
            Exit Sub
        End If

        ConquistaSize = LenB(Conquista(ConquistaNum))
        ReDim ConquistaData(ConquistaSize - 1)
        ConquistaData = Buffer.ReadBytes(ConquistaSize)
        CopyMemory ByVal VarPtr(Conquista(ConquistaNum)), ByVal VarPtr(ConquistaData(0)), ConquistaSize
        ' Save it
        Call SendUpdateConquistasToAll(ConquistaNum)
        Call SaveConquista(ConquistaNum)
        Call AddLog(GetPlayerName(index) & " saved Conquista #" & ConquistaNum & ".", ADMIN_LOG)
    End Sub


    Sub HandleRequestConquistas(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
        SendConquistas index
    End Sub

    Sub HandleColetar(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
        Dim i As Long
        For i = 1 To Player_HighIndex
            If IsPlaying(i) Then
                If GetPlayerConq(i) = 1 Then
                    If Player(i).ColetaOk(1) = 0 Then
                        GiveInvItem i, 1, 2 ' 1 = numero do item | 2 = quantidade do item
                        Player(i).ColetaOk(1) = 1
                        PlayerMsg index, "Você recebeu: " & Trim$(Item(index).Name) & " x: 2", BrightBlue
                    Else
                        PlayerMsg index, "Você já pegou a recompensa desta conquista", BrightRed
                    End If
                Else
                    PlayerMsg index, "Você não desbloqueou esta conquista", BrightRed
                End If
            End If
        Next
        
    End Sub

    dentro da Function PlayerData adicione:

    Código:
    Buffer.WriteByte GetPlayerConq(index)

    no final da modServerTcp adicione:

    Código:
    Sub SendConquistas(ByVal index As Long)
        Dim i As Long

        For i = 1 To MAX_CONQUISTAS
            If LenB(Trim$(Conquista(i).Name)) > 0 Then
                Call SendUpdateConquistasTo(index, i)
            End If
        Next

    End Sub

    Sub SendUpdateConquistasToAll(ByVal ConquistaNum As Long)
        Dim packet As String
        Dim Buffer As clsBuffer
        Dim ConquistaSize As Long
        Dim ConquistaData() As Byte
        Set Buffer = New clsBuffer
        ConquistaSize = LenB(Conquista(ConquistaNum))
        ReDim ConquistaData(ConquistaSize - 1)
        CopyMemory ConquistaData(0), ByVal VarPtr(Conquista(ConquistaNum)), ConquistaSize
        Buffer.WriteLong SUpdateConquista
        Buffer.WriteLong ConquistaNum
        Buffer.WriteBytes ConquistaData
        SendDataToAll Buffer.ToArray()
        Set Buffer = Nothing
    End Sub

    Sub SendUpdateConquistasTo(ByVal index As Long, ByVal ConquistaNum As Long)
        Dim packet As String
        Dim Buffer As clsBuffer
        Dim ConquistaSize As Long
        Dim ConquistaData() As Byte
        Set Buffer = New clsBuffer
        ConquistaSize = LenB(Conquista(ConquistaNum))
        ReDim ConquistaData(ConquistaSize - 1)
        CopyMemory ConquistaData(0), ByVal VarPtr(Conquista(ConquistaNum)), ConquistaSize
        Buffer.WriteLong SUpdateConquista
        Buffer.WriteLong ConquistaNum
        Buffer.WriteBytes ConquistaData
        SendDataTo index, Buffer.ToArray()
        Set Buffer = Nothing
    End Sub

    Sub SendPlayerConquista(ByVal index As Long)
        Dim Buffer As clsBuffer
        
        Set Buffer = New clsBuffer
        Buffer.WriteLong SPlayerConquistas
        Buffer.WriteByte Player(index).Conquistas
        Buffer.WriteByte Conquista(index).Level
        Buffer.WriteByte Player(index).Level
        SendDataTo index, Buffer.ToArray()
        Set Buffer = Nothing
    End Sub

    dentro da Sub JoinGame adicione:

    Código:
    Call SendConquistas(index)
    SendPlayerConquista index

    na Sub CheckPlayerLevelUp acima do end sub adicione:

    Código:
    ChecarConquista index

    no final da modPlayer adicione:

    Código:
    Function GetPlayerConq(ByVal index As Long) As Long
        If index > MAX_PLAYERS Then Exit Function
        GetPlayerConq = Player(index).Conquistas
    End Function

    Sub SetPlayerConq(ByVal index As Long, ByVal Num As Long)
        Player(index).Conquistas = Num
    End Sub

    Sub ChecarConquista(ByVal index As Long)
        If GetPlayerConq(index) = 0 Then
            If GetPlayerLevel(index) >= Conquista(index).Level Then
                PlayerMsg index, "Você acaba de completar a conquista " & Trim$(Conquista(index).Name), Yellow
                SetPlayerConq index, 1
                SendPlayerData index
            End If
        End If
        SendPlayerConquista index
    End Sub

    abaixo de Public Const MAX_PARTY_MEMBERS As Long = 4 adicione:

    Código:
    Public Const MAX_CONQUISTAS As Long = 255

    abaixo de Public Const EDITOR_ANIMATION As Byte = 6 adicione:

    Código:
    Public Const EDITOR_CONQUISTA As Byte = 7

    na modDataBase adicione:

    Código:
    Sub SaveConquistas()
        Dim i As Long

        For i = 1 To MAX_CONQUISTAS
            Call SaveConquista(i)
        Next
    End Sub

    Sub SaveConquista(ByVal ConquistaNum As Long)
        Dim filename As String
        Dim F As Long
        filename = App.Path & "\data\conquistas\conquista" & ConquistaNum & ".dat"
        F = FreeFile
        Open filename For Binary As #F
        Put #F, , Conquista(ConquistaNum)
        Close #F
    End Sub

    Sub LoadConquistas()
        Dim filename As String
        Dim i As Long
        Dim F As Long
        Call CheckConquistas

        For i = 1 To MAX_CONQUISTAS
            filename = App.Path & "\data\conquistas\conquista" & i & ".dat"
            F = FreeFile
            Open filename For Binary As #F
            Get #F, , Conquista(i)
            Close #F
        Next
    End Sub

    Sub CheckConquistas()
        Dim i As Long

        For i = 1 To MAX_CONQUISTAS
            If Not FileExist("\Data\conquistas\conquista" & i & ".dat") Then
                Call SaveConquista(i)
            End If
        Next
    End Sub

    Sub ClearConquista(ByVal index As Long)
        Call ZeroMemory(ByVal VarPtr(Conquista(index)), LenB(Conquista(index)))
        Conquista(index).Name = vbNullString
    End Sub

    Sub ClearConquistas()
        Dim i As Long

        For i = 1 To MAX_CONQUISTAS
            Call ClearConquista(i)
        Next

    End Sub

    abaixo de ChkDir App.Path & "\Data\", "spells" adicione:

    Código:
    ChkDir App.Path & "\Data\", "conquistas"

    abaixo de:

    Código:
    Call SetStatus("Clearing animations...")
    Call ClearAnimations

    adicione:

    Código:
    Call SetStatus("Clearing conquistas...")
    Call ClearConquistas

    abaixo de:

    Código:
    Call SetStatus("Loading animations...")
    Call LoadAnimations

    adicione:

    Código:
    Call SetStatus("Loading conquistas...")
    Call LoadConquistas

    pronto agora é so usar, atualizar, colocar novas opções, etc
    código podendo ser atualizado para usar select case, for entre outras coisas
    expandam suas mentes haha, a base já tem rsrs

    Créditos: A mim Thales12 pelo Sistema/Tutorial


    _________________
    Meu fã ? Meu Amigo ? Entao Use !

    Sistema - Sistema de Conquista (1.0) Thalesfan
    Sistema - Sistema de Conquista (1.0) Mv0yg8

    Minha Sign:

    Sistema - Sistema de Conquista (1.0) Zkqt5e

    Valentine gosta desta mensagem

    Profane ~
    Profane ~
    Colaborador
    Colaborador


    Mensagens : 818
    Créditos : 130

    Sistema - Sistema de Conquista (1.0) Empty Re: Sistema de Conquista (1.0)

    Mensagem por Profane ~ Qui Jul 06, 2023 5:47 pm

    Vou testar ;3


    _________________
    "Mistress of shattered hopes and forever broken dreams"

      Data/hora atual: Qui maio 02, 2024 9:52 am