Class Change
From VbGORE Visual Basic Online RPG Engine
Ok First Tutorial I have ever done Based off of Spodi's Plague Dead Source Code,
Change Classes
Thanks to Spodi for giving me permission to do this.
So lets begin.
First
in your gameserver.vbp
Find: Code:
Case .User_Blink: Data_User_Blink Index
Case .User_CancelQuest: Data_User_CancelQuest rBuf, Index
Case .User_CastSkill: Data_User_CastSkill rBuf, Index
Underneath it add:
Code:
Case .User_ChangeClass: Data_User_ChangeClass rBuf, Index
In TCP.bas
Note: In the Select Case NewClassID Those are your classes which you will set up later
Add this sub Code:
Sub Data_User_ChangeClass(ByRef rBuf As DataBuffer, ByVal UserIndex As Integer)
'***************************************************************** 'User requests to change their class (such as at a job master) '<newClassID(B)> '***************************************************************** Dim NewClassID As Byte Dim X As Integer Dim Y As Integer Dim NPCIndex As Integer
'Get the class ID
NewClassID = rBuf.Get_Byte
'Check for a valid class to allow change
'If UserList(UserIndex).Class <> ClassID.Civilian Then Exit Sub
'Check for a valid new class ID
Select Case NewClassID
Case ClassID.Civilian
Case ClassID.Engineer
Case ClassID.Infiltrator
Case ClassID.Reaver
Case ClassID.SquadLeader
Case Else: Exit Sub 'If it is not one of the above its invalid
End Select
'Check if the user is near a job changing NPC (NPCChat = 1)
For X = (UserList(UserIndex).Pos.X - MaxServerDistanceX) + 1 To (UserList(UserIndex).Pos.X + MaxServerDistanceX) + 1
For Y = (UserList(UserIndex).Pos.Y - MaxServerDistanceY) + 1 To (UserList(UserIndex).Pos.Y + MaxServerDistanceY) + 1
'Make sure tile is legal
If X > 0 Then
If X <= MapInfo(UserList(UserIndex).Pos.Map).Width Then
If Y > 0 Then
If Y <= MapInfo(UserList(UserIndex).Pos.Map).Width Then
'Check for a NPC on the tile
NPCIndex = MapInfo(UserList(UserIndex).Pos.Map).Data(X, Y).NPCIndex
If NPCIndex > 0 Then
'Check for ChatID = 1
If NPCList(NPCIndex).ChatID = 1 Then GoTo NPCFound
End If
End If
End If
End If
End If
Next Y
Next X
'No NPC was found
Exit Sub
'NPC was found
NPCFound:
'Change the user's job UserList(UserIndex).Class = NewClassID 'Send the update packet ConBuf.PreAllocate 3 ConBuf.Put_Byte DataCode.User_SendClass ConBuf.Put_Integer UserList(UserIndex).Class Data_Send ToIndex, UserIndex, ConBuf.Get_Buffer 'Send the packet that will make the particle effect ConBuf.PreAllocate 3 ConBuf.Put_Byte DataCode.User_ChangeClass ConBuf.Put_Integer UserList(UserIndex).Char.CharIndex Data_Send ToMap, 0, ConBuf.Get_Buffer(), UserList(UserIndex).Pos.Map
End Sub
in data IDs
Under: Code:
User_Group_Invite As Byte User_Group_Info As Byte
Add: Code:
User_ChangeClass As Byte User_SendClass As Byte
now Find Code:
.Combo_ProjectileSoundRotateDamage = 107
.Combo_SoundRotateDamage = 108
.Combo_SlashSoundRotateDamage = 109
and add Code:
.User_ChangeClass = --- 'being w/e number u need
a lil bit further down before Code: .server_KeepAlive
Add
Code:
.User_SendClass = --- 'being w/e number u need
In Tcp Sub User_connects
Under Code:
'Send list of known skills User_SendKnownSkills UserIndex
Add: Code:
'Send the user their class ConBuf.PreAllocate 3 ConBuf.Put_Byte DataCode.User_SendClass ConBuf.Put_Integer UserList(UserIndex).Class Data_Send ToIndex, UserIndex, ConBuf.Get_Buffer
also look for
Change Code:
UserList(UserIndex).Class = Class
To [code]
UserList(UserIndex).Class = ClassID.Civilian 'Note this is based off of your starting class
[/code] Now In dataIDs Find
[code]With ClassID[/code]
And Change it to your classes remember this also goes by the power of 2
Same thing with [code] Public Type ClassID [/code] just remember to set them as integers
Make sure you take out the 'check for valid starting class, if u wanna know where it located choose start from a full compile and it will bring it up
Thats it Server Side
Now GameClient.vbp
Find [code]
Case .User_BaseStat: Data_User_BaseStat rBuf
Case .User_Blink: Data_User_Blink rBuf
Case .User_CastSkill: Data_User_CastSkill rBuf
[/code] Add [code]
Case .User_ChangeClass: Data_User_ChangeClass rBuf
Case .User_SendClass: Data_User_SendClass rBuf
[/code] In tcp add sub [code] Sub Data_User_ChangeClass(ByRef rBuf As DataBuffer)
'********************************************* 'Creates a particle effect for user changing classes '<UserIndex(I)> '********************************************* Dim TargetIndex As Integer
TargetIndex = rBuf.Get_Integer If Not Engine_ValidChar(TargetIndex) Then Exit Sub 'Create Effect_ChangeClass_Begin Engine_TPtoSPX(CharList(TargetIndex).Pos.X) + 16, Engine_TPtoSPY(CharList(TargetIndex).Pos.Y), 7, 100, 23
End Sub [/code] Change Sub Engine_ShowNPCChatWindow
to [code] Sub Engine_ShowNPCChatWindow(ByVal NPCName As String, ByVal ChatIndex As Byte, ByVal AskIndex As Byte)
'***************************************************************** 'Shows the NPC chat window '***************************************************************** Dim i As Long Dim Offset As Long
'Check for starting conditions If Not Engine_NPCChat_CanUse(ChatIndex) Then Exit Sub
'Set the window values
ActiveAsk.AskIndex = AskIndex
ActiveAsk.ChatIndex = ChatIndex
ActiveAsk.AskName = NPCName
ActiveAsk.QuestionTxt = NPCName & ": " & vbNewLine & Engine_WordWrap(NPCChat(ChatIndex).Ask.Ask(AskIndex).Question, GameWindow.NPCChat.Screen.Width - 10)
'Call the flags (if any)
For i = 1 To NPCChat(ChatIndex).Ask.Ask(AskIndex).NumAskFlags
Engine_NPCChat_PerformFlag NPCChat(ChatIndex).Ask.Ask(AskIndex).AskFlags(i)
Next i
'Set the window information
With GameWindow.NPCChat
.NumAnswers = NPCChat(ChatIndex).Ask.Ask(AskIndex).NumAnswers
ReDim .Answer(1 To .NumAnswers)
Offset = .Screen.Height - 5
For i = .NumAnswers To 1 Step -1
Offset = Offset - Font_Default.CharHeight
.Answer(i).Y = Offset
.Answer(i).Height = Font_Default.CharHeight
.Answer(i).X = 5
.Answer(i).Width = Engine_GetTextWidth(Font_Default, i & ". " & NPCChat(ChatIndex).Ask.Ask(AskIndex).Answer(i).Text)
Next i
End With
ShowGameWindow(NPCChatWindow) = 1
LastClickedWindow = NPCChatWindow
SelGameWindow = NPCChatWindow
End Sub [/code] add sub in tileengine [code] Private Function Engine_NPCChat_CanUse(ByVal ChatIndex As Byte) As Boolean
'***************************************************************** 'Checks for conditions to start NPC chats '*****************************************************************
Select Case ChatIndex
'Job master
Case 1
If UserClass <> ClassID.Civilian Then Exit Function
End Select
Engine_NPCChat_CanUse = True
End Function [/code] Also Add But take note, To change the classid.reaver or w/e to fit your code
[code] Private Sub Engine_NPCChat_PerformFlag(ByVal FlagIndex As Integer)
'***************************************************************** 'Performs the code for each NPC chat flag '*****************************************************************
'MAKE USE OF ME!!!
'Find what flag to use
Select Case FlagIndex
'Become a Reaver
Case 1
sndBuf.Put_Byte DataCode.User_ChangeClass
sndBuf.Put_Integer ClassID.Reaver
'Become an Infiltrator
Case 2
sndBuf.Put_Byte DataCode.User_ChangeClass
sndBuf.Put_Integer ClassID.Infiltrator
'Become an Engineer
Case 3
sndBuf.Put_Byte DataCode.User_ChangeClass
sndBuf.Put_Integer ClassID.Engineer
'Become a Squad Leader
Case 4
sndBuf.Put_Byte DataCode.User_ChangeClass
sndBuf.Put_Integer ClassID.SquadLeader
End Select
End Sub [/code] I'm sure you know what this is for
In Particles Find [code] Public Const EffectNum_Summon As Byte = 10 [/code] and add [code] Public Const EffectNum_ChangeClass As Byte = 11 [/code]
While in particles add [code] Function Effect_ChangeClass_Begin(ByVal X As Single, ByVal Y As Single, ByVal Gfx As Integer, ByVal Particles As Integer, Optional ByVal Progression As Single = 1) As Integer Dim EffectIndex As Integer Dim LoopC As Long
'Get the next open effect slot EffectIndex = Effect_NextOpenSlot If EffectIndex = -1 Then Exit Function
'Return the index of the used slot Effect_ChangeClass_Begin = EffectIndex
'Set The Effect's Variables Effect(EffectIndex).EffectNum = EffectNum_ChangeClass 'Set the effect number Effect(EffectIndex).ParticleCount = Particles 'Set the number of particles Effect(EffectIndex).Used = True 'Enable the effect Effect(EffectIndex).X = X 'Set the effect's X coordinate Effect(EffectIndex).Y = Y 'Set the effect's Y coordinate Effect(EffectIndex).Gfx = Gfx 'Set the graphic Effect(EffectIndex).Progression = Progression 'If we loop the effect
'Set the number of particles left to the total avaliable Effect(EffectIndex).ParticlesLeft = Effect(EffectIndex).ParticleCount
'Set the float variables Effect(EffectIndex).FloatSize = Effect_FToDW(8) 'Size of the particles
'Redim the number of particles ReDim Effect(EffectIndex).Particles(0 To Effect(EffectIndex).ParticleCount) ReDim Effect(EffectIndex).PartVertex(0 To Effect(EffectIndex).ParticleCount)
'Create the particles
For LoopC = 0 To Effect(EffectIndex).ParticleCount
Set Effect(EffectIndex).Particles(LoopC) = New Particle
Effect(EffectIndex).Particles(LoopC).Used = True
Effect(EffectIndex).PartVertex(LoopC).Rhw = 1
Effect_ChangeClass_Reset EffectIndex, LoopC
Next LoopC
'Set The Initial Time Effect(EffectIndex).PreviousFrame = timeGetTime
End Function
Private Sub Effect_ChangeClass_Reset(ByVal EffectIndex As Integer, ByVal Index As Long) Dim X As Single Dim Y As Single
Effect(EffectIndex).Sng = Effect(EffectIndex).Sng + 0.03 If Effect(EffectIndex).Sng > 360 * DegreeToRadian Then Effect(EffectIndex).Sng = Effect(EffectIndex).Sng - 360 * DegreeToRadian Effect(EffectIndex).Modifier = Effect(EffectIndex).Modifier + 1 'Get the positions X = Effect(EffectIndex).X - (Sin(Effect(EffectIndex).Sng) * 40) + Rnd * 10 Y = Effect(EffectIndex).Y + (Cos(Effect(EffectIndex).Sng) * 40) - (Effect(EffectIndex).Modifier / 10) + Rnd * 10 'Reset the particle Effect(EffectIndex).Particles(Index).ResetIt X, Y, 0, 0, 0, 0 Effect(EffectIndex).Particles(Index).ResetColor 1, 1, 0, 1, 0.2 + (Rnd * 0.2)
End Sub
Private Sub Effect_ChangeClass_Update(ByVal EffectIndex As Integer) Dim ElapsedTime As Single Dim LoopC As Long
'Calculate The Time Difference ElapsedTime = (timeGetTime - Effect(EffectIndex).PreviousFrame) * 0.01 Effect(EffectIndex).PreviousFrame = timeGetTime 'Update the life span If Effect(EffectIndex).Progression > 0 Then Effect(EffectIndex).Progression = Effect(EffectIndex).Progression - ElapsedTime
'Go Through The Particle Loop For LoopC = 0 To Effect(EffectIndex).ParticleCount
'Check If Particle Is In Use
If Effect(EffectIndex).Particles(LoopC).Used Then
'Update The Particle
Effect(EffectIndex).Particles(LoopC).UpdateParticle ElapsedTime
'Check if the particle is ready to die
If Effect(EffectIndex).Particles(LoopC).sngA <= 0 Then
'Check if the effect is ending
If Effect(EffectIndex).Progression > 0 Then
'Reset the particle
Effect_ChangeClass_Reset EffectIndex, LoopC
Else
'Disable the particle
Effect(EffectIndex).Particles(LoopC).Used = False
'Subtract from the total particle count
Effect(EffectIndex).ParticlesLeft = Effect(EffectIndex).ParticlesLeft - 1
'Check if the effect is out of particles
If Effect(EffectIndex).ParticlesLeft = 0 Then Effect(EffectIndex).Used = False
'Clear the color (dont leave behind any artifacts)
Effect(EffectIndex).PartVertex(LoopC).Color = 0
End If
Else
'Set the particle information on the particle vertex
Effect(EffectIndex).PartVertex(LoopC).Color = D3DColorMake(Effect(EffectIndex).Particles(LoopC).sngR, Effect(EffectIndex).Particles(LoopC).sngG, Effect(EffectIndex).Particles(LoopC).sngB, Effect(EffectIndex).Particles(LoopC).sngA)
Effect(EffectIndex).PartVertex(LoopC).X = Effect(EffectIndex).Particles(LoopC).sngX
Effect(EffectIndex).PartVertex(LoopC).Y = Effect(EffectIndex).Particles(LoopC).sngY
End If
End If
Next LoopC
End Sub [/code] Find [code] 'Find out which effect is selected, then update it [/code] and add to the bottom [code]
If Effect(LoopC).EffectNum = EffectNum_ChangeClass Then Effect_ChangeClass_Update LoopC
[/code] In DataIDs Find [code]
User_Group_Info As Byte[/code]
Add underneath it [code[
User_ChangeClass As Byte User_SendClass As Byte
in dataids find Code:
.Combo_ProjectileSoundRotateDamage = 107
.Combo_SoundRotateDamage = 108
.Combo_SlashSoundRotateDamage = 109
Add these Code:
.User_ChangeClass = --- '--- = w/e number u have free i just rearranged mine so it was 110 and 111 and renumbered the rest
.User_SendClass = ---
IN TCP add Code:
Sub Data_User_SendClass(ByRef rBuf As DataBuffer)
'********************************************* 'The user recieves what class they are '<ClassID(I)> '*********************************************
UserClass = rBuf.Get_Integer
End Sub
Now Remember server side we had to set the classes as integers in the dataids?
we have to do it again so find Public Type Classid and set ur classes again u can just copy from ur server
Same Thing with the With Classid in dataid
In TileEngine under Code:
'Get the answers
AnswerIndex = 0
Do
Line Input #FileNum, ln2
ln2 = Trim$(ln2)
If ln2 <> vbNullString Then
If UCase$(Left$(ln2, 6)) = "ASKEND" Then Exit Do
If UCase$(Left$(ln2, 7)) = "ANSWER " Then
TempSplit() = Split(ln2, " ", 3)
If UBound(TempSplit) < 2 Then
ErrTxt = "Invalid number of ANSWER parameters!" & """ & ln2 & """
GoTo ErrOut
End If
AnswerIndex = AnswerIndex + 1
With NPCChat(Index).Ask.Ask(AskIndex)
.NumAnswers = AnswerIndex
ReDim Preserve .Answer(1 To AnswerIndex)
.Answer(AnswerIndex).Text = Trim$(TempSplit(2))
.Answer(AnswerIndex).GotoID = Val(TempSplit(1))
End With
and before Code:
Else
ErrTxt = "Unknown command in ASK block!" & vbNewLine & """ ln2 & """
GoTo ErrOut
End If
End If
Loop
End If
NextLine:
add
Code:
ElseIf UCase$(Left$(ln2, 8)) = "ASKFLAG " Then
NPCChat(Index).Ask.Ask(AskIndex).NumAskFlags = NPCChat(Index).Ask.Ask(AskIndex).NumAskFlags + 1
ReDim Preserve NPCChat(Index).Ask.Ask(AskIndex).AskFlags(1 To NPCChat(Index).Ask.Ask(AskIndex).NumAskFlags)
NPCChat(Index).Ask.Ask(AskIndex).AskFlags(NPCChat(Index).Ask.Ask(AskIndex).NumAskFlags) = Val(Right$(ln2, Len(ln2) - 8))
ok in the Declares find Code:
Public Type NPCChatAskLine 'Individual chat input lines
Question As String 'The question text NumAnswers As Byte 'Number of answers that can be used Answer() As NPCChatAskAnswer
and add Code:
AskFlags() As Integer NumAskFlags As Integer
In particles
find Code:
Private Type Effect
X As Single 'Location of effect Y As Single GoToX As Single 'Location to move to GoToY As Single KillWhenAtTarget As Boolean 'If the effect is at its target (GoToX/Y), then Progression is set to 0 KillWhenTargetLost As Boolean 'Kill the effect if the target is lost (sets progression = 0) Gfx As Byte 'Particle texture used Used As Boolean 'If the effect is in use EffectNum As Byte 'What number of effect that is used Modifier As Integer 'Misc variable (depends on the effect) FloatSize As Long 'The size of the particles Direction As Integer 'Misc variable (depends on the effect) Particles() As Particle 'Information on each particle Progression As Single 'Progression state, best to design where 0 = effect ends PartVertex() As TLVERTEX 'Used to point render particles PreviousFrame As Long 'Tick time of the last frame ParticleCount As Integer 'Number of particles total ParticlesLeft As Integer 'Number of particles left - only for non-repetitive effects BindToChar As Integer 'Setting this value will bind the effect to move towards the character BindSpeed As Single 'How fast the effect moves towards the character BoundToMap As Byte 'If the effect is bound to the map or not (used only by the map editor)
End Type
Thanks to Spodi for pointing this out
add this in there Code:
Sng As Single 'Misc variable
Almost Done now in the frmNew Delete the cmbClass and remove all of these
Code:
Located: frmnew
With ClassCmb
.Clear
.AddItem "Warrior", 0
.AddItem "Mage", 1
.AddItem "Rogue", 2
.ListIndex = 0
End With
UserClass = ClassCmb.ListIndex
'Convert the class by listbox index to the class number
Select Case UserClass
Case 0: UserClass = ClassID.Warrior
Case 1: UserClass = ClassID.Mage
Case 2: UserClass = ClassID.Rogue
Case Else: UserClass = ClassID.Warrior
End Select
Located picturetextbox
Case frmNew.ClassCmb.hwnd
With frmNew.ClassCmb
SetBkMode wParam, 1
BitBlt wParam, 0, 0, .Width, .Height, frmNew.hDC, .Left, .Top, vbSrcCopy
End With
I have fully tested this 3 times... My friend tested it, and i gave the client to some of my users no Errors were found