Isto é uma pré-visualização de um tema em Hitskin.com
Instalar o tema • Voltar para a ficha do tema
[GL]Titulos 0.1.0
+6
Motodark
Snoopy
Spooky
Valentine
Hashirama
Dooolly
10 participantes
Página 1 de 2
Página 1 de 2 • 1, 2
[GL]Titulos 0.1.0
Nome: Sistema de Títulos
Versão: 0.1.0
Criador: GameLoop
Creditos: Dooolly
Informações
Esse sistema dá títulos para os jogadores, e cada titulo
poderia ter uma bonificação diferente.
Exemplo
- Spoiler:
- Spoiler:
Tutorial
Server-Side
Em modCombat procure por:
- Código:
Function GetPlayerMaxVital(ByVal index As Long, ByVal Vital As Vitals) As Long
If index > MAX_PLAYERS Then Exit Function
Abaixo adicione:
- Código:
Dim AddHP As Byte
If Player(index).UseTitulo > 0 Then
AddHP = Titulo(Player(index).UseTitulo).AddHP
End If
Em modConstant procure por:
- Código:
Public Const MAX_PARTY_MEMBERS As Long = 4
Abaixo adicione:
- Código:
Public Const MAX_TITULOS As Long = 50
No final de modDatabase adicione:
- Código:
' *************
' ** Titulos **
' *************
Sub SaveTitulo(ByVal TituloNum As Long)
Dim filename As String
Dim F As Long
filename = App.Path & "\data\titulos\titulo" & TituloNum & ".dat"
F = FreeFile
Open filename For Binary As #F
Put #F, , Titulo(TituloNum)
Close #F
End Sub
Sub SaveTitulos()
Dim i As Long
Call SetStatus("Salvando Titulos... ")
For i = 1 To MAX_TITULOS
Call SaveTitulo(i)
Next
End Sub
Sub LoadTitulos()
Dim filename As String
Dim i As Long
Dim F As Long
Call CheckTitulos
For i = 1 To MAX_TITULOS
filename = App.Path & "\data\titulos\titulo" & i & ".dat"
F = FreeFile
Open filename For Binary As #F
Get #F, , Titulo(i)
Close #F
Next
End Sub
Sub CheckTitulos()
Dim i As Long
For i = 1 To MAX_TITULOS
If Not FileExist("\Data\titulos\titulo" & i & ".dat") Then
Call SaveTitulo(i)
End If
Next
End Sub
Sub ClearTitulo(ByVal index As Long)
Call ZeroMemory(ByVal VarPtr(Titulo(index)), LenB(Titulo(index)))
Titulo(index).Nome = vbNullString
End Sub
Sub ClearTitulos()
Dim i As Long
For i = 1 To MAX_TITULOS
Call ClearTitulo(i)
Next
End Sub
Em modEnumerations antes de SMSG_COUNT adicione:
- Código:
STitulos
SUpdateTitulo
STituloEditor
Ainda em modEnumerations antes de CMSG_COUNT adicione:
- Código:
CRequestTitulos
CSaveTitulo
CRequestEditTitulo
CTitulos
CUseTitulo
Em modGeneral procure por:
- Código:
ChkDir App.Path & "\Data", "spells"
Abaixo adicione:
- Código:
ChkDir App.Path & "\Data", "titulos"
Ainda em modGeneral procure por:
- Código:
Call ClearAnimations
Abaixo adicione:
- Código:
Call SetStatus("Limpando Titulos...")
Call ClearTitulos
Ainda em modGeneral procure por:
- Código:
Call LoadAnimations
Abaixo adicione:
- Código:
Call SetStatus("Carregando Titulos...")
Call LoadTitulos
Em modHandleData procure por:
- Código:
HandleDataSub(CPartyLeave) = GetAddress(AddressOf HandlePartyLeave)
Abaixo adicione:
- Código:
HandleDataSub(CRequestTitulos) = GetAddress(AddressOf HandleRequestTitulos)
HandleDataSub(CSaveTitulo) = GetAddress(AddressOf HandleSaveTitulo)
HandleDataSub(CRequestEditTitulo) = GetAddress(AddressOf HandleRequestEditTitulo)
HandleDataSub(CTitulos) = GetAddress(AddressOf HandleTitulos)
HandleDataSub(CUseTitulo) = GetAddress(AddressOf HandleUseTitulo)
No final de modHandleData adicione:
- Código:
' Titulos
Sub HandleRequestTitulos(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
SendTitulos index
End Sub
Sub HandleSaveTitulo(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
Dim TituloNum As Long
Dim Buffer As clsBuffer
Dim TituloSize As Long
Dim TituloData() As Byte
' Prevent hacking
If GetPlayerAccess(index) < ADMIN_DEVELOPER Then
Exit Sub
End If
Set Buffer = New clsBuffer
Buffer.WriteBytes Data()
TituloNum = Buffer.ReadLong
' Prevent hacking
If TituloNum < 0 Or TituloNum > MAX_TITULOS Then
Exit Sub
End If
TituloSize = LenB(Titulo(TituloNum))
ReDim TituloData(TituloSize - 1)
TituloData = Buffer.ReadBytes(TituloSize)
CopyMemory ByVal VarPtr(Titulo(TituloNum)), ByVal VarPtr(TituloData(0)), TituloSize
' Save it
Call SendUpdateTituloToAll(TituloNum)
Call SaveTitulo(TituloNum)
Call AddLog(GetPlayerName(index) & " saved Titulo #" & TituloNum & ".", ADMIN_LOG)
End Sub
Sub HandleRequestEditTitulo(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 STituloEditor
SendDataTo index, Buffer.ToArray()
Set Buffer = Nothing
End Sub
Sub HandleTitulos(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
Call SendPlayerTitulos(index)
End Sub
Sub HandleUseTitulo(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
Dim n As Long
Dim Player As Long
Dim Buffer As clsBuffer
Set Buffer = New clsBuffer
Buffer.WriteBytes Data()
' The sprite
n = Buffer.ReadLong 'CLng(Parse(1))
Player = Buffer.ReadLong
Set Buffer = Nothing
Call SetPlayerTitulo(Player, n)
Call SendPlayerData(index)
Exit Sub
End Sub
Em modPlayer procure por:
- Código:
Call SendHotbar(index)
Abaixo adicione:
- Código:
Call SendTitulos(index)
No final de modPlayer adicione:
- Código:
Sub SetPlayerTitulo(ByVal index As Long, ByVal TituloNum As Long)
If Player(index).UseTitulo > 0 Then
Player(index).Vital(1) = Player(index).Vital(1) - Titulo(Player(index).UseTitulo).AddHP
End If
Player(index).UseTitulo = TituloNum
If Titulo(Player(index).UseTitulo).AddHP > 0 Then
Player(index).Vital(1) = Player(index).Vital(1) + Titulo(Player(index).UseTitulo).AddHP
End If
End Sub
Function GetPlayerTitulos(ByVal index As Long, ByVal TituloSlot As Long) As Long
If index > MAX_PLAYERS Then Exit Function
GetPlayerTitulos = Player(index).Titulos(TituloSlot)
End Function
Function GetPlayerTitulo(ByVal index As Long) As Long
If index > MAX_PLAYERS Then Exit Function
GetPlayerTitulo = Player(index).UseTitulo
End Function
Sub AddPlayerTitulo(ByVal index As Long, ByVal TituloNum As Long)
Dim i As Long
If index > MAX_PLAYERS Then Exit Sub
For i = 1 To MAX_TITULOS
If Player(index).Titulos(i) = TituloNum Then
PlayerMsg index, "Você já tem esse titulo!", BrightRed
Exit Sub
End If
If Player(index).Titulos(i) <= 0 Then
Player(index).Titulos(i) = TituloNum
PlayerMsg index, "Parabéns você ganhou um novo titulo: " & Titulo(TituloNum).Nome, BrightGreen
Exit Sub
End If
Next
End Sub
Em modServerTCP procure por:
- Código:
Buffer.WriteLong GetPlayerClass(index)
Abaixo adicione:
- Código:
Buffer.WriteLong GetPlayerTitulo(index)
No final de modServerTCP adicione:
- Código:
'///////////////////////////////////////////////
'///// Titulos /////////////////////////////////
'///////////////////////////////////////////////
Sub SendTitulos(ByVal index As Long)
Dim i As Long
For i = 1 To MAX_TITULOS
If LenB(Trim$(Titulo(i).Nome)) > 0 Then
Call SendUpdateTituloTo(index, i)
End If
Next
End Sub
Sub SendUpdateTituloToAll(ByVal TituloNum As Long)
Dim packet As String
Dim Buffer As clsBuffer
Set Buffer = New clsBuffer
Dim TituloSize As Long
Dim TituloData() As Byte
Set Buffer = New clsBuffer
TituloSize = LenB(Titulo(TituloNum))
ReDim TituloData(TituloSize - 1)
CopyMemory TituloData(0), ByVal VarPtr(Titulo(TituloNum)), TituloSize
Buffer.WriteLong SUpdateTitulo
Buffer.WriteLong TituloNum
Buffer.WriteBytes TituloData
SendDataToAll Buffer.ToArray()
Set Buffer = Nothing
End Sub
Sub SendUpdateTituloTo(ByVal index As Long, ByVal TituloNum As Long)
Dim packet As String
Dim Buffer As clsBuffer
Dim TituloSize As Long
Dim TituloData() As Byte
Set Buffer = New clsBuffer
TituloSize = LenB(Titulo(TituloNum))
ReDim TituloData(TituloSize - 1)
CopyMemory TituloData(0), ByVal VarPtr(Titulo(TituloNum)), TituloSize
Buffer.WriteLong SUpdateTitulo
Buffer.WriteLong TituloNum
Buffer.WriteBytes TituloData
SendDataTo index, Buffer.ToArray()
Set Buffer = Nothing
End Sub
Sub SendPlayerTitulos(ByVal index As Long)
Dim packet As String
Dim i As Long
Dim Buffer As clsBuffer
Set Buffer = New clsBuffer
Buffer.WriteLong STitulos
For i = 1 To MAX_TITULOS
Buffer.WriteLong GetPlayerTitulos(index, i)
Next
SendDataTo index, Buffer.ToArray()
Set Buffer = Nothing
End Sub
'//////////////////////////////////////////////
Em modTypes procure por:
- Código:
Public Party(1 To MAX_PARTYS) As PartyRec
Abaixo adicione:
- Código:
Public Titulo(1 To MAX_TITULOS) As TitulosRec
Ainda na modTypes logo na PlayeRec procure por:
- Código:
Dir As Byte
Abaixo adicione:
- Código:
' Titulos
UseTitulo As Long
Titulos(1 To MAX_TITULOS) As Long
No final da modTypes adicione:
- Código:
Public Type TitulosRec
Nome As String * NAME_LENGTH
Cor As Byte
AddHP As Byte
End Type
Servidor Terminado!
Client-Side
Baixe esse arquivo antes: Titulo Files.rar
Adicione as duas forms em seu projeto!
Dê um CTRL + X no picTitulos que está dentro do Form1
Depois dê um CTRL + V na frmMain
Posicione onde você quiser. Lembre-se de verificar se você está com
o frmMain selecionado, você não pode por dentro de outra coisa, apenas no frmMain
Crie um botão e adicione:
- Código:
picCharacter.Visible = False
picInventory.Visible = False
picSpells.Visible = False
picOptions.Visible = False
picParty.Visible = False
' picQuestLog.Visible = False
picTitulo.Visible = True
' send packet
Set Buffer = New clsBuffer
Buffer.WriteLong CTitulos
SendData Buffer.ToArray()
Set Buffer = Nothing
' show the window
PlaySound Sound_ButtonClick
Abra o código dá frmMain e no final adicione:
- Código:
' Titulos
Private Sub cmbUsarTitulo_Click()
Dim Titulo As Long
' If debug mode, handle error then exit out
If Options.Debug = 1 Then On Error GoTo errorhandler
If Trim$(lstTitulo.text) = vbNullString Then Exit Sub
Titulo = GetTituloNum(lstTitulo.text)
UseTitulo MyIndex, Titulo
' Error handler
Exit Sub
errorhandler:
HandleError "cmbUsarTitulo_Click", "frmMain", Err.Number, Err.Description, Err.Source, Err.HelpContext
Err.Clear
Exit Sub
End Sub
Em modConstant procure por:
- Código:
Public Const MAX_PARTY_MEMBERS As Long = 4
Abaixo adicione:
- Código:
Public Const MAX_TITULOS As Long = 50
Ainda em modConstant procure por:
- Código:
Public Const EDITOR_ANIMATION As Byte = 6
Abaixo adicione:
- Código:
Public Const EDITOR_TITULOS As Byte = 7
Em modEnumerations antes de SMSG_COUNT adicione:
- Código:
STitulos
SUpdateTitulo
STituloEditor
Ainda em modEnumerations antes de CMSG_COUNT adicione:
- Código:
CRequestTitulos
CSaveTitulo
CRequestEditTitulo
CTitulos
CUseTitulo
No final do modClientTCP adicione:
- Código:
' ##### Titulo #####
Public Sub UseTitulo(ByVal Index As Long, ByVal TituloNum 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 CUseTitulo
Buffer.WriteLong TituloNum
Buffer.WriteLong Index
SendData Buffer.ToArray()
Set Buffer = Nothing
' Error handler
Exit Sub
errorhandler:
HandleError "UseTitulo", "modClientTCP", Err.Number, Err.Description, Err.Source, Err.HelpContext
Err.Clear
Exit Sub
End Sub
Public Sub SendRequestEditTitulo()
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 CRequestEditTitulo
SendData Buffer.ToArray()
Set Buffer = Nothing
' Error handler
Exit Sub
errorhandler:
HandleError "SendRequestEditTitulo", "modClientTCP", Err.Number, Err.Description, Err.Source, Err.HelpContext
Err.Clear
Exit Sub
End Sub
Public Sub SendSaveTitulo(ByVal TituloNum As Long)
Dim Buffer As clsBuffer
Dim TituloSize As Long
Dim TituloData() As Byte
' If debug mode, handle error then exit out
If Options.Debug = 1 Then On Error GoTo errorhandler
Set Buffer = New clsBuffer
TituloSize = LenB(Titulo(TituloNum))
ReDim TituloData(TituloSize - 1)
CopyMemory TituloData(0), ByVal VarPtr(Titulo(TituloNum)), TituloSize
Buffer.WriteLong CSaveTitulo
Buffer.WriteLong TituloNum
Buffer.WriteBytes TituloData
SendData Buffer.ToArray()
Set Buffer = Nothing
' Error handler
Exit Sub
errorhandler:
HandleError "SendSaveTitulo", "modClientTCP", Err.Number, Err.Description, Err.Source, Err.HelpContext
Err.Clear
Exit Sub
End Sub
Sub SendRequestTitulos()
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 CRequestTitulos
SendData Buffer.ToArray()
Set Buffer = Nothing
' Error handler
Exit Sub
errorhandler:
HandleError "SendRequestTitulos", "modClientTCP", Err.Number, Err.Description, Err.Source, Err.HelpContext
Err.Clear
Exit Sub
End Sub
' #################
No final de modDatabase adicione:
- Código:
' ##### Titulos #####
Sub ClearTitulos()
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_TITULOS
Call ClearTitulo(i)
Next
' Error handler
Exit Sub
errorhandler:
HandleError "ClearTitulos", "modDatabase", Err.Number, Err.Description, Err.Source, Err.HelpContext
Err.Clear
Exit Sub
End Sub
Sub ClearTitulo(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(Titulo(Index)), LenB(Titulo(Index)))
Titulo(Index).Nome = vbNullString
' Error handler
Exit Sub
errorhandler:
HandleError "ClearTitulo", "modDatabase", Err.Number, Err.Description, Err.Source, Err.HelpContext
Err.Clear
Exit Sub
End Sub
Sub SetPlayerTitulo(ByVal Index As Long, ByVal Titulo As String)
' 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).UseTitulo = Titulo
' Error handler
Exit Sub
errorhandler:
HandleError "SetPlayerTitulo", "modDatabase", Err.Number, Err.Description, Err.Source, Err.HelpContext
Err.Clear
Exit Sub
End Sub
Public Function GetTituloNum(ByVal TituloName As String) As Long
Dim i As Long
GetTituloNum = 0
For i = 1 To MAX_TITULOS
If Trim$(Titulo(i).Nome) = Trim$(TituloName) Then
GetTituloNum = i
Exit For
End If
Next
End Function
'###############
No final de modGameEditors adicione:
- Código:
' ////////////////////
' // Titulos Editor //
' ////////////////////
Public Sub TituloEditorInit()
' If debug mode, handle error then exit out
If Options.Debug = 1 Then On Error GoTo errorhandler
If frmEditor_Titulos.Visible = False Then Exit Sub
EditorIndex = frmEditor_Titulos.lstIndex.ListIndex + 1
With frmEditor_Titulos
' set values
.txtNome.text = Trim$(Titulo(EditorIndex).Nome)
.optCor(Titulo(EditorIndex).Cor).Value = True
.scrlHP.Value = Titulo(EditorIndex).AddHP
End With
Titulo_Changed(EditorIndex) = True
' Error handler
Exit Sub
errorhandler:
HandleError "TituloEditorInit", "modGameEditors", Err.Number, Err.Description, Err.Source, Err.HelpContext
Err.Clear
Exit Sub
End Sub
Public Sub TitulosEditorOk()
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_TITULOS
If Titulo_Changed(i) Then
Call SendSaveTitulo(i)
End If
Next
Unload frmEditor_Titulos
Editor = 0
ClearChanged_Titulo
' Error handler
Exit Sub
errorhandler:
HandleError "TitulosEditorOk", "modGameEditors", Err.Number, Err.Description, Err.Source, Err.HelpContext
Err.Clear
Exit Sub
End Sub
Public Sub TituloEditorCancel()
' If debug mode, handle error then exit out
If Options.Debug = 1 Then On Error GoTo errorhandler
Editor = 0
Unload frmEditor_Titulos
ClearChanged_Titulo
ClearTitulos
SendRequestTitulos
' Error handler
Exit Sub
errorhandler:
HandleError "TituloEditorCancel", "modGameEditors", Err.Number, Err.Description, Err.Source, Err.HelpContext
Err.Clear
Exit Sub
End Sub
Public Sub ClearChanged_Titulo()
' If debug mode, handle error then exit out
If Options.Debug = 1 Then On Error GoTo errorhandler
ZeroMemory Titulo_Changed(1), MAX_TITULOS * 2 ' 2 = boolean length
' Error handler
Exit Sub
errorhandler:
HandleError "ClearChanged_Titulo", "modGameEditors", Err.Number, Err.Description, Err.Source, Err.HelpContext
Err.Clear
Exit Sub
End Sub
No final de modGlobals adicione:
- Código:
' Titulos
Public PlayerTitulos(1 To MAX_TITULOS) As Long
Public Titulo_Changed(1 To MAX_TITULOS) As Boolean
Em modHandledata procure por:
- Código:
HandleDataSub(SPartyVitals) = GetAddress(AddressOf HandlePartyVitals)
Abaixo adicione:
- Código:
'/////////////////////
HandleDataSub(STitulos) = GetAddress(AddressOf HandleTitulos)
HandleDataSub(SUpdateTitulo) = GetAddress(AddressOf HandleUpdateTitulo)
HandleDataSub(STituloEditor) = GetAddress(AddressOf HandleTituloEditor)
Ainda em modHandledata procure por:
- Código:
Call SetPlayerClass(i, Buffer.ReadLong)
Abaixo adicione:
- Código:
Call SetPlayerTitulo(i, Buffer.ReadLong)
No final do modHandledata adicione:
- Código:
' ##### Titulos #####
Private Sub HandleUpdateTitulo(ByVal Index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
Dim TituloNum As Long
Dim Buffer As clsBuffer
Dim TituloSize As Long
Dim TituloData() 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()
TituloNum = Buffer.ReadLong
TituloSize = LenB(Titulo(TituloNum))
ReDim TituloData(TituloSize - 1)
TituloData = Buffer.ReadBytes(TituloSize)
CopyMemory ByVal VarPtr(Titulo(TituloNum)), ByVal VarPtr(TituloData(0)), TituloSize
Set Buffer = Nothing
' Update the spells on the pic
Set Buffer = New clsBuffer
Buffer.WriteLong CTitulos
SendData Buffer.ToArray()
Set Buffer = Nothing
' Error handler
Exit Sub
errorhandler:
HandleError "HandleUpdateTitulo", "modHandleData", Err.Number, Err.Description, Err.Source, Err.HelpContext
Err.Clear
Exit Sub
End Sub
Private Sub HandleTituloEditor()
Dim i As Long
' If debug mode, handle error then exit out
If Options.Debug = 1 Then On Error GoTo errorhandler
With frmEditor_Titulos
Editor = EDITOR_TITULOS
.lstIndex.Clear
' Add the names
For i = 1 To MAX_TITULOS
.lstIndex.AddItem i & ": " & Trim$(Titulo(i).Nome)
Next
.Show
.lstIndex.ListIndex = 0
TituloEditorInit
End With
' Error handler
Exit Sub
errorhandler:
HandleError "HandleTituloEditor", "modHandleData", Err.Number, Err.Description, Err.Source, Err.HelpContext
Err.Clear
Exit Sub
End Sub
Sub HandleTitulos(ByVal Index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
Dim i As Long, TituloName 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.WriteBytes Data()
frmMain.lstTitulo.Clear
For i = 1 To MAX_TITULOS
Player(MyIndex).Titulos(i) = Buffer.ReadLong
If Player(MyIndex).Titulos(i) > 0 Then
TituloName = Trim$(Titulo(Player(MyIndex).Titulos(i)).Nome)
frmMain.lstTitulo.AddItem TituloName
TituloName = vbNullString
End If
Next
Set Buffer = Nothing
' Error handler
Exit Sub
errorhandler:
HandleError "HandleTitulos", "modHandleData", Err.Number, Err.Description, Err.Source, Err.HelpContext
Err.Clear
Exit Sub
End Sub
' ###############
Em modText procure por:
- Código:
' Draw name
Call DrawText(TexthDC, TextX, TextY, Name, color)
Abaixo adicione:
- Código:
If Player(Index).UseTitulo > 0 Then
If GetPlayerSprite(Index) < 1 Or GetPlayerSprite(Index) > NumCharacters Then
TextY = ConvertMapY(GetPlayerY(Index) * PIC_Y) + Player(Index).YOffset - 16 - 14
Else
' Determine location for text
TextY = ConvertMapY(GetPlayerY(Index) * PIC_Y) + Player(Index).YOffset - (DDSD_Character(GetPlayerSprite(Index)).lHeight / 4) + 16 - 14
End If
Select Case Titulo(Player(Index).UseTitulo).Cor
Case 0
color = QBColor(BrightRed)
Case 1
color = QBColor(BrightBlue)
Case 2
color = QBColor(Green)
Case 3
color = QBColor(Yellow)
Case 4
color = QBColor(Pink)
End Select
Name = Trim$(Titulo(Player(Index).UseTitulo).Nome)
TextX = ConvertMapX(GetPlayerX(Index) * PIC_X) + Player(Index).XOffset + (PIC_X \ 2) - getWidth(TexthDC, (Trim$(Name)))
Call DrawText(TexthDC, TextX, TextY, Name, color)
End If
Em modTypes procure por:
- Código:
Public Animation(1 To MAX_ANIMATIONS) As AnimationRec
Abaixo adicione:
- Código:
Public Titulo(1 To MAX_TITULOS) As TitulosRec
Ainda na modTypes procure por:
- Código:
Dir As Byte
Abaixo adicione:
- Código:
' Titulos
UseTitulo As Long
Titulos(1 To MAX_TITULOS) As Long
No final de modTypes adicione:
- Código:
Public Type TitulosRec
Nome As String * NAME_LENGTH
Cor As Byte
AddHP As Byte
End Type
Cliente Terminado!
Informações
Para você adicionar um titulo é só você usar o seguinte codigo no Serve-Side
- Código:
AddPlayerTitulo index, 1 'Onde tem o numero 1 você muda para o numero do titulo.
Para abrir a frmTitulos é só utilizar o codigo:
- Código:
If GetPlayerAccess(MyIndex) < ADMIN_DEVELOPER Then
Exit Sub
End If
SendRequestEditTitulo
O Sistema está na versão 0.1.0 então é só um teste, vou está sempre atualizando o sistema, espero que não tenha erros, se tiver comenta ai!
Depois faço a parte de ganhar o títulos por item, ou por missões dê sua opinião ai!
Lembrando que se for por missões terá que ser o sistema de quests do alatar.
Última edição por Dooolly em Sex Mar 18, 2016 10:20 pm, editado 4 vez(es)
Re: [GL]Titulos 0.1.0
Gostei =D
mais 1 crédito por compartilhar
mais 1 crédito por compartilhar
_________________
Apoia nosso projeto? use nossa assinatura
Hashirama- Membro de Honra
- Mensagens : 413
Créditos : 133
Re: [GL]Titulos 0.1.0
Muito bom, mas seria mais interessante modificar a cor RGB digitando em 3 textboxs e essa cor aparecer em uma picturebox.
Re: [GL]Titulos 0.1.0
Valentine escreveu:Muito bom, mas seria mais interessante modificar a cor RGB digitando em 3 textboxs e essa cor aparecer em uma picturebox.
as cores RGB funcionaria no DX7?
se sim me passa o codigo que eu modifico isso, e ainda ponho um exemplo em uma picture box...
Re: [GL]Titulos 0.1.0
Cara, cria ai 3 variáveis em byte ai na hora de desenhar o nome usa isso:Dooolly escreveu:Valentine escreveu:Muito bom, mas seria mais interessante modificar a cor RGB digitando em 3 textboxs e essa cor aparecer em uma picturebox.
as cores RGB funcionaria no DX7?
se sim me passa o codigo que eu modifico isso, e ainda ponho um exemplo em uma picture box...
- Código:
color = RGB(color1, color2, color3)
Última edição por Valentine em Ter Jan 20, 2015 6:28 pm, editado 1 vez(es)
Re: [GL]Titulos 0.1.0
Uma Dica, ao usar um item conseguir rank e spell (tipo usa o item na categoria de Spell da cmbtype
e ganha a spell e título. :)
+2
e ganha a spell e título. :)
+2
_________________
Sign
- Sign¹:
- Sign²:
Spooky- Membro Ativo
- Mensagens : 267
Créditos : 24
Re: [GL]Titulos 0.1.0
aqui está dando o erro "sub or function not defined" no cliente
Snoopy- Iniciante
- Mensagens : 58
Créditos : 7
Re: [GL]Titulos 0.1.0
Snoopy escreveu:aqui está dando o erro "sub or function not defined" no cliente
Desculpe amigo, erro meu!
Acima de:
- Código:
Sub SetPlayerTitulo(ByVal Index As Long, ByVal Titulo As String)
Adicione:
- Código:
Public Function GetTituloNum(ByVal TituloName As String) As Long
Dim i As Long
GetTituloNum = 0
For i = 1 To MAX_TITULOS
If Trim$(Titulo(i).Nome) = Trim$(TituloName) Then
GetTituloNum = i
Exit For
End If
Next
End Function
Atualizei o tópico!
Re: [GL]Titulos 0.1.0
Muito legal esse seu tutorial, doolly só queria saber como eu deixo meus graficos melhores ? está muito ruim
Motodark- Ocasional
- Mensagens : 169
Créditos : 5
Re: [GL]Titulos 0.1.0
Legal, tudo tão bem feito '-'
só faltou uma coisa
ps: nem testei o sistema, mas pela parte programada não vi nada parecido
só faltou uma coisa
- Suspense:
- + Suspense:
- Climax:
- Pausa Dramatica:
- Desfecho:
- Um botão para retirar o titulo que tá usando ou ficar sem titulo
ps: nem testei o sistema, mas pela parte programada não vi nada parecido
_________________
Assinatura removida pela Staff
^ Tenho nova, surprise
Página 1 de 2 • 1, 2
Tópicos semelhantes
» [EO] Titulos 1.1
» [PEDIDO]Sistema de Titulos
» Sistema de Títulos selecionáveis
» Sistema de Titulos Beta [TESTEM]
» Sistema de Titulos Beta [TESTEM]
» [PEDIDO]Sistema de Titulos
» Sistema de Títulos selecionáveis
» Sistema de Titulos Beta [TESTEM]
» Sistema de Titulos Beta [TESTEM]
Página 1 de 2
Permissões neste sub-fórum
Não podes responder a tópicos
|
|