Warp on quest completion
From VbGORE Visual Basic Online RPG Engine
This tutorial will help you to add a new feature on your quest system.
It's simple: When the quest is finished, the player will be warped to the place that you choose.
In Server, Declares.bas, Find : <vb> '************ Quest ************ Public Type Quest
Name As String 'The quest's name StartTxt As String 'What the NPC says to the player to explain the crisis AcceptTxt As String 'What the NPC says when the player accepts the quest IncompleteTxt As String 'What the NPC says to the player when they return without completing the quest FinishTxt As String 'What the NPC says when the player finishes the quest AcceptReqLvl As Long 'What level the user is required to be to accept AcceptReqObj As Integer 'Index of the object the user is required to have to accept AcceptReqObjAmount As Integer 'How much of the object the user must have before accepting AcceptReqFinishQuest As Integer 'Quest that must be finished prior to accepting this quest AcceptRewExp As Long 'Amount of Exp the user gets for accepting the quest AcceptRewGold As Long 'Amount of gold the user gets for accepting the quest AcceptRewObj As Integer 'Object the user gets for accepting the quest AcceptRewObjAmount As Integer 'Amount of the object the user gets for accepting the quest AcceptLearnSkill As Byte 'Skill the user learns for accepting the quest (by SkID value) FinishReqObj As Integer 'Object the user must have to finish the quest FinishReqObjAmount As Integer 'Amount of the object the user must have to finish the quest FinishReqNPC As Integer 'Index of the NPC the user must kill to finish the quest FinishReqNPCAmount As Integer 'How many of the NPCs the user must kill to finish the quest FinishRewExp As Long 'Exp the user gets for finishing the quest FinishRewGold As Long 'How much gold the user gets for finishing the quest FinishRewObj As Integer 'The index of the object the user gets for finishing the quest FinishRewObjAmount As Integer 'The amount of the object the user gets for finishing the quest FinishLearnSkill As Byte 'Skill the user learns for finishing the quest (by SkID value) Redoable As Byte 'If the quest can be done infinite times
End Type </vb> Append The following <vb> FinishWarpMap As Integer FinishWarpX As Byte FinishWarpY As Byte </vb> Very Easy, Then go to Server,FileIO.bas Find this: <vb> Public Sub Load_Quests() </vb> If you have not modified the code before, Replace The whole sub with : Getting SQL DATA INIT <vb> Public Sub Load_Quests()
Log "Call Load_Quests", CodeTracker '//\\LOGLINE//\\
'Get the number of quests (Sort by id, descending, only get 1 entry, only return id)
DB_RS.Open "SELECT id FROM quests ORDER BY id DESC LIMIT 1", DB_Conn, adOpenStatic, adLockOptimistic
If DB_RS.EOF Then MsgBox "Oh crap, you don't have any quests! This isn't going to be pretty...", vbOKOnly
NumQuests = DB_RS(0)
DB_RS.Close
Log "Load_Quests: Resizing QuestData array by NumQuests (" & NumQuests & ")", CodeTracker '//\\LOGLINE//\\
'Resize the quests array
ReDim QuestData(1 To NumQuests)
'Retrieve the data from the database
DB_RS.Open "SELECT * FROM quests", DB_Conn, adOpenStatic, adLockOptimistic
'Fill in the information
Do While Not DB_RS.EOF 'Loop until we reach the end of the recordset
With QuestData(DB_RS!id)
Log "Load_Quests: Filling QuestData for quest " & DB_RS!id, CodeTracker '//\\LOGLINE//\\
.Name = Trim$(DB_RS!Name)
.Redoable = Val(DB_RS!Redoable)
.StartTxt = Trim$(DB_RS!text_start)
.AcceptTxt = Trim$(DB_RS!text_accept)
.IncompleteTxt = Trim$(DB_RS!text_incomplete)
.FinishTxt = Trim$(DB_RS!text_finish)
.AcceptReqLvl = Val(DB_RS!accept_req_level)
.AcceptReqObj = Val(DB_RS!accept_req_obj)
.AcceptReqObjAmount = Val(DB_RS!accept_req_objamount)
.AcceptReqFinishQuest = Val(DB_RS!accept_req_finishquest)
.AcceptRewExp = Val(DB_RS!accept_reward_exp)
.AcceptRewGold = Val(DB_RS!accept_reward_gold)
.AcceptRewObj = Val(DB_RS!accept_reward_obj)
.AcceptRewObjAmount = Val(DB_RS!accept_reward_objamount)
.AcceptLearnSkill = Val(DB_RS!accept_reward_learnskill)
.FinishReqObj = Val(DB_RS!finish_req_obj)
.FinishReqObjAmount = Val(DB_RS!finish_req_objamount)
.FinishReqNPC = Val(DB_RS!finish_req_killnpc)
.FinishReqNPCAmount = Val(DB_RS!finish_req_killnpcamount)
.FinishRewExp = Val(DB_RS!finish_reward_exp)
.FinishRewGold = Val(DB_RS!finish_reward_gold)
.FinishRewObj = Val(DB_RS!finish_reward_obj)
.FinishRewObjAmount = Val(DB_RS!finish_reward_objamount)
.FinishLearnSkill = Val(DB_RS!finish_reward_learnskill)
.FinishWarpMap = Val(DB_RS!finish_warpmap)
.FinishWarpX = Val(DB_RS!finish_warpx)
.FinishWarpY = Val(DB_RS!finish_warpy)
End With
DB_RS.MoveNext
Loop
'Close the recordset
DB_RS.Close
End Sub
</vb> Now we move on to Server, Quest.bas Find <vb> Private Sub Quest_CheckIfComplete(ByVal UserIndex As Integer, ByVal NPCIndex As Integer, ByVal UserQuestSlot As Byte) </vb> If you have not modified this part of code, Replace the whole sub with : <vb> Private Sub Quest_CheckIfComplete(ByVal UserIndex As Integer, ByVal NPCIndex As Integer, ByVal UserQuestSlot As Byte)
'***************************************************************** 'Checks if a quest is ready to be completed '***************************************************************** Dim ReqObjSlot As Byte Dim Slot As Byte Dim s As String Dim i As Long Dim tPos As WorldPos Dim nPos As WorldPos
Log "Call Quest_CheckIfComplete(" & UserIndex & "," & NPCIndex & "," & UserQuestSlot & ")", CodeTracker '//\\LOGLINE//\\
'Check NPC kills
If QuestData(NPCList(NPCIndex).Quest).FinishReqNPC Then
If UserList(UserIndex).QuestStatus(UserQuestSlot).NPCKills < QuestData(NPCList(NPCIndex).Quest).FinishReqNPCAmount Then
Quest_SayIncomplete UserIndex, NPCIndex
Exit Sub
End If
End If
'Check objects If QuestData(NPCList(NPCIndex).Quest).FinishReqObj Then
'Check through the user's slots looking for the object of the same index
For Slot = 1 To MAX_INVENTORY_SLOTS
If UserList(UserIndex).Object(Slot).ObjIndex = QuestData(NPCList(NPCIndex).Quest).FinishReqObj Then
'Cache the required object slot (we will be using it later if the quest is complete)
ReqObjSlot = Slot
'Check the amount the user has
If UserList(UserIndex).Object(Slot).Amount < QuestData(NPCList(NPCIndex).Quest).FinishReqObjAmount Then
Quest_SayIncomplete UserIndex, NPCIndex
Exit Sub
Else
'We will set the slot to 0 so we can check if we ran out of slots or found the object we were looking for
Slot = 0
Exit For
End If
'And now we check! lawlz! ^_^
If Slot <> 0 Then
Quest_SayIncomplete UserIndex, NPCIndex
Exit Sub
End If
End If
Next Slot
'If we made it through the whole loop without finding a slot (that is, if the slot = MAX_INVENTORY_SLOTS + 1) then
'the object was not found in the user's inventory at all, so give them the missing error and abort
If Slot = MAX_INVENTORY_SLOTS + 1 Then
Quest_SayIncomplete UserIndex, NPCIndex
Exit Sub
End If
End If
'*** Quest was completed! ***
'Say the finishing text ConBuf.PreAllocate 5 + Len(NPCList(NPCIndex).Name) + Len(QuestData(UserList(UserIndex).Quest(UserQuestSlot)).FinishTxt) ConBuf.Put_Byte DataCode.Comm_Talk ConBuf.Put_String NPCList(NPCIndex).Name & ": " & QuestData(UserList(UserIndex).Quest(UserQuestSlot)).FinishTxt ConBuf.Put_Byte DataCode.Comm_FontType_Talk Data_Send ToNPCArea, NPCIndex, ConBuf.Get_Buffer, NPCList(NPCIndex).Pos.Map
'The user is done, give them the rewards
'EXP reward
If QuestData(UserList(UserIndex).Quest(UserQuestSlot)).FinishRewExp > 0 Then
User_RaiseExp UserIndex, QuestData(UserList(UserIndex).Quest(UserQuestSlot)).FinishRewExp
ConBuf.PreAllocate 6
ConBuf.Put_Byte DataCode.Server_Message
ConBuf.Put_Byte 3
ConBuf.Put_Long QuestData(UserList(UserIndex).Quest(UserQuestSlot)).FinishRewExp
Data_Send ToIndex, UserIndex, ConBuf.Get_Buffer
End If
'Gold reward
If QuestData(UserList(UserIndex).Quest(UserQuestSlot)).FinishRewGold > 0 Then
UserList(UserIndex).Stats.BaseStat(SID.Gold) = UserList(UserIndex).Stats.BaseStat(SID.Gold) + QuestData(UserList(UserIndex).Quest(UserQuestSlot)).FinishRewGold
ConBuf.PreAllocate 6
ConBuf.Put_Byte DataCode.Server_Message
ConBuf.Put_Byte 4
ConBuf.Put_Long QuestData(UserList(UserIndex).Quest(UserQuestSlot)).FinishRewGold
Data_Send ToIndex, UserIndex, ConBuf.Get_Buffer
End If
'Remove the quest object
If ReqObjSlot > 0 Then
User_RemoveObj UserIndex, ReqObjSlot, QuestData(NPCList(NPCIndex).Quest).FinishReqObjAmount
End If
'Give the object reward
If QuestData(UserList(UserIndex).Quest(UserQuestSlot)).FinishRewObj > 0 Then
User_GiveObj UserIndex, QuestData(UserList(UserIndex).Quest(UserQuestSlot)).FinishRewObj, QuestData(UserList(UserIndex).Quest(UserQuestSlot)).FinishRewObjAmount
End If
'Learn skill reward
If QuestData(UserList(UserIndex).Quest(UserQuestSlot)).FinishLearnSkill > 0 Then
User_GiveSkill UserIndex, QuestData(UserList(UserIndex).Quest(UserQuestSlot)).FinishLearnSkill
End If
'After Quest Warp
If QuestData(UserList(UserIndex).Quest(UserQuestSlot)).FinishWarpMap > 0 Then
tpos.Map = QuestData(UserList(UserIndex).Quest(UserQuestSlot)).FinishWarpMap tpos.X = QuestData(UserList(UserIndex).Quest(UserQuestSlot)).FinishWarpX tpos.Y = QuestData(UserList(UserIndex).Quest(UserQuestSlot)).FinishWarpY Server_ClosestLegalPos tpos, npos
If Server_LegalPos(tpos.Map, tpos.X,tpos.Y, 1) Then
User_WarpChar UserIndex, npos.Map, npos.X, npos.Y, False 'You may Put Your Own Message To the client here End If End If
'Add the quest to the user's finished quest list If QuestData(UserList(UserIndex).Quest(UserQuestSlot)).Redoable Then
'Only add a redoable quest in the list once
Log "Quest_CheckIfComplete: Using InStr() operation", CodeTracker '//\\LOGLINE//\\
If UserList(UserIndex).NumCompletedQuests > 0 Then
For i = 1 To UserList(UserIndex).NumCompletedQuests
'If we find the quest in here, leave and don't add it to the list
If UserList(UserIndex).CompletedQuests(i) = UserList(UserIndex).Quest(UserQuestSlot) Then Exit For
'We hit the end of the loop and no match found, set the add to list flag and leave
If i = UserList(UserIndex).NumCompletedQuests Then
i = -1
Exit For
End If
Next i
Else
'The user has never completed a quest before, so we have to add this one
i = -1
End If
Else
'Set the flag to add to the list
i = -1
End If
'Add to the list if needed
If i = -1 Then
UserList(UserIndex).NumCompletedQuests = UserList(UserIndex).NumCompletedQuests + 1
ReDim Preserve UserList(UserIndex).CompletedQuests(1 To UserList(UserIndex).NumCompletedQuests)
UserList(UserIndex).CompletedQuests(UserList(UserIndex).NumCompletedQuests) = UserList(UserIndex).Quest(UserQuestSlot)
End If
'Clear the quest slot so it can be used again
UserList(UserIndex).QuestStatus(UserQuestSlot).NPCKills = 0
UserList(UserIndex).Quest(UserQuestSlot) = 0
'Update the quest text
Quest_SendText UserIndex, UserQuestSlot
End Sub
</vb> Finally, Add these row to SQL:VBGORE:QUESTS (and you can use those tags when making the quest) <vb> finish_warpmap finish_warpx finish_warpy </vb>