Sistema de Conquista (1.0) Hitskin_logo Hitskin.com

Isto é uma pré-visualização de um tema em Hitskin.com
Instalar o temaVoltar para a ficha do tema

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

Sistema de Conquista (1.0)

2 participantes

Ir para baixo

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 de Conquista (1.0) Thalesfan
Sistema de Conquista (1.0) Mv0yg8

Minha Sign:

Sistema de Conquista (1.0) Zkqt5e
thales12
thales12
Membro de Honra
Membro de Honra

Mensagens : 322
Créditos : 108

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

http://www.rdmgames.tk

Valentine gosta desta mensagem

Ir para o topo Ir para baixo

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"
Profane ~
Profane ~
Colaborador
Colaborador

Mensagens : 818
Créditos : 130

Ir para o topo Ir para baixo

Ir para o topo

- Tópicos semelhantes

 
Permissões neste sub-fórum
Não podes responder a tópicos