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á
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:
na frmMain adicione:
um commandbutton chamado OpenConq com caption Conquistas
de dois cliques nele e adicione o seguinte código:
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:
no painel admin add um commandbutton de 2 clicks nele e adicione:
procure por:
Abaixo adicione:
dentro da Private Type PlayerRec adicione:
ainda na modTypes adicione:
no modClientTcp adicione:
na modDataBase adicione:
procure por:
abaixo adicione:
procure por:
abaixo adicione:
procure por:
abaixo adicione:
na modGameEditors adicione:
na Public Enum ServerPackets acima de ' Make sure SMSG_COUNT is below everything else adicione:
na Public Enum ClientPackets acima de ' Make sure CMSG_COUNT is below everything else adicione:
na Public Sub InitMessages() adicione:
no final da modHandleData adicione:
no final da modClientTcp adicione:
dentro da Private Sub HandlePlayerData adicione:
Cliente~Side finalizado, agora vamos para o Server~Side:
na modTypes acima de: Public Options As OptionsRec
adicione:
dentro da Private Type PlayerRec adicione:
no final da modTypes adicione:
dentro da Public Enum ServerPackets acima de ' Make sure SMSG_COUNT is below everything else adicione:
dentro da Public Enum ClientPackets acima de ' Make sure CMSG_COUNT is below everything else adicione:
dentro da Public Sub InitMessages() adicione:
no final da modHandleData adicione:
dentro da Function PlayerData adicione:
no final da modServerTcp adicione:
dentro da Sub JoinGame adicione:
na Sub CheckPlayerLevelUp acima do end sub adicione:
no final da modPlayer adicione:
abaixo de Public Const MAX_PARTY_MEMBERS As Long = 4 adicione:
abaixo de Public Const EDITOR_ANIMATION As Byte = 6 adicione:
na modDataBase adicione:
abaixo de ChkDir App.Path & "\Data\", "spells" adicione:
abaixo de:
adicione:
abaixo de:
adicione:
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
talvez eu atualize, mas fiquem a vontade para postarem atualização caso queiram
qualquer dúvida podem perguntar
sistema um pouquinho grande, vamos lá
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