Multiple Drop System

[Dark Echo]

Okay, since a lot more people are moving to Mirage Source from Elysium. They are quickly working out that not all the cool features in Elysium are in Mirage Source. One of those cool features, that GSD added in was the multi drop feature for npcs. Now, i've decided to make my own multi drop feature just for MSE. You can still get this to work with 303, but you would need to work that out on your own.

Now, before i start the tutorial i would just like to explain how this works. I changed the NPC drop system in MSE so instead of you choosing a specific item, value and chance you choose what type of drop combination you would like to use. Meaning drops are saved in a separate file from npcs. This way drop combinations can be used over and over again without the need to remake them. Now, this would mean you would need to make a drop editor and edit the npc editor slightly.

Tutorial Diffculty: 1/5

Easy, just a plain copy and paste tutorial. Sorry for those who want comments, i'll promise i'll comment this sometime later this year. Sorry people..

Part 1 - Server Side
Go into modConstants and add at the bottom:

Code:

' Drop constants
Public Const MAX_DROPS = 255
Public Const MAX_DROP_ITEMS = 10

Go into modDatabase and add:

Code:

Sub SaveDrop(ByVal DropNum As Long)
Dim FileName As String
Dim i As Long

    FileName = App.Path & "\Data\drops.ini"
  
    Call PutVar(FileName, "DROP" & DropNum, "Name", Trim(Drop(DropNum).Name))
    
    For i = 1 To MAX_DROP_ITEMS
        Call PutVar(FileName, "DROP" & DropNum, "ItemNum" & i, Trim(Drop(DropNum).ItemDrop(i).ItemNum))
        Call PutVar(FileName, "DROP" & DropNum, "Chance" & i, Trim(Drop(DropNum).ItemDrop(i).Chance))
        Call PutVar(FileName, "DROP" & DropNum, "ItemValue" & i, Trim(Drop(DropNum).ItemDrop(i).ItemValue))
    Next i
End Sub

Sub SaveDrops()
Dim i As Long

    For i = 1 To MAX_DROPS
        Call SaveDrop(i)
    Next i
End Sub

Sub LoadDrops()
Dim FileName As String
Dim i As Long, ii As Long

    Call CheckDrops
  
    FileName = App.Path & "\Data\drops.ini"
  
    For i = 1 To MAX_DROPS
        Drop(i).Name = Trim(GetVar(FileName, "DROP" & i, "Name"))
    
        For ii = 1 To MAX_DROP_ITEMS
            Drop(i).ItemDrop(ii).ItemNum = Val(GetVar(FileName, "DROP" & i, "ItemNum" & ii))
            Drop(i).ItemDrop(ii).Chance = Val(GetVar(FileName, "DROP" & i, "Chance" & ii))
            Drop(i).ItemDrop(ii).ItemValue = Val(GetVar(FileName, "DROP" & i, "ItemValue" & ii))
      
            DoEvents
        Next ii
    Next i
End Sub

Sub CheckDrops()
    If Not FileExist("Data\drops.ini") Then
        Call SaveDrops
    End If
End Sub

Find and change to:

Code:

Sub SaveNpc(ByVal NpcNum As Long)
Dim FileName As String

    FileName = App.Path & "\data\npcs.ini"
    
    Call PutVar(FileName, "NPC" & NpcNum, "Name", Trim(Npc(NpcNum).Name))
    Call PutVar(FileName, "NPC" & NpcNum, "AttackSay", Trim(Npc(NpcNum).AttackSay))
    Call PutVar(FileName, "NPC" & NpcNum, "Sprite", Trim(Npc(NpcNum).Sprite))
    Call PutVar(FileName, "NPC" & NpcNum, "SpawnSecs", Trim(Npc(NpcNum).SpawnSecs))
    Call PutVar(FileName, "NPC" & NpcNum, "Behavior", Trim(Npc(NpcNum).Behavior))
    Call PutVar(FileName, "NPC" & NpcNum, "Range", Trim(Npc(NpcNum).Range))
    Call PutVar(FileName, "NPC" & NpcNum, "Drop", Trim(Npc(NpcNum).Drop))
    Call PutVar(FileName, "NPC" & NpcNum, "STR", Trim(Npc(NpcNum).STR))
    Call PutVar(FileName, "NPC" & NpcNum, "DEF", Trim(Npc(NpcNum).DEF))
    Call PutVar(FileName, "NPC" & NpcNum, "SPEED", Trim(Npc(NpcNum).SPEED))
    Call PutVar(FileName, "NPC" & NpcNum, "MAGI", Trim(Npc(NpcNum).MAGI))
End Sub

Sub LoadNpcs()
On Error Resume Next

Dim FileName As String
Dim i As Long

    Call CheckNpcs
    
    FileName = App.Path & "\data\npcs.ini"
    
    For i = 1 To MAX_NPCS
        Npc(i).Name = GetVar(FileName, "NPC" & i, "Name")
        Npc(i).AttackSay = GetVar(FileName, "NPC" & i, "AttackSay")
        Npc(i).Sprite = GetVar(FileName, "NPC" & i, "Sprite")
        Npc(i).SpawnSecs = GetVar(FileName, "NPC" & i, "SpawnSecs")
        Npc(i).Behavior = GetVar(FileName, "NPC" & i, "Behavior")
        Npc(i).Range = GetVar(FileName, "NPC" & i, "Range")
        Npc(i).Drop = GetVar(FileName, "NPC" & i, "Drop")
        Npc(i).STR = GetVar(FileName, "NPC" & i, "STR")
        Npc(i).DEF = GetVar(FileName, "NPC" & i, "DEF")
        Npc(i).SPEED = GetVar(FileName, "NPC" & i, "SPEED")
        Npc(i).MAGI = GetVar(FileName, "NPC" & i, "MAGI")
    
        DoEvents
    Next i
End Sub

Go into modgameLogic and add:

Code:

Sub ClearDrop(ByVal Index As Long)
Dim i As Long

    Drop(Index).Name = ""
        
    For i = 1 To MAX_DROP_ITEMS
        Drop(Index).ItemDrop(i).ItemNum = 0
        Drop(Index).ItemDrop(i).Chance = 0
        Drop(Index).ItemDrop(i).ItemValue = 0
    Next i
End Sub

Sub ClearDrops()
Dim i As Long

    For i = 1 To MAX_DROPS
        Call ClearDrop(i)
    Next i
End Sub

Go into Sub AttackNpc and find:

Code:

Dim Name As String
Dim Exp As Long
Dim n As Long, i As Long
Dim STR As Long, DEF As Long, MapNum As Long, NpcNum As Long

Make it so it looks like this:

Code:

Dim Name As String
Dim Exp As Long
Dim n As Long, i As Long
Dim STR As Long, DEF As Long, MapNum As Long, NpcNum As Long, DropNum As Long

Find:

Code:

' Drop the goods if they get it
        n = Int(Rnd * Npc(NpcNum).DropChance) + 1
        If n = 1 Then
            Call SpawnItem(Npc(NpcNum).DropItem, Npc(NpcNum).DropItemValue, MapNum, MapNpc(MapNum, MapNpcNum).x, MapNpc(MapNum, MapNpcNum).y)
        End If

Make it so it looks like this:

Code:

' Drop the goods if they get it
        DropNum = Npc(NpcNum).Drop
                
        For i = 1 To MAX_DROP_ITEMS
            n = Int(Rnd * Drop(DropNum).ItemDrop(i).Chance) + 1
            If n = 1 Then
                Call SpawnItem(Drop(DropNum).ItemDrop(i).ItemNum, Drop(DropNum).ItemDrop(i).ItemValue, MapNum, MapNpc(MapNum, MapNpcNum).x, MapNpc(MapNum, MapNpcNum).y)
            End If
        Next i

Find and change to:

Code:

Sub ClearNpc(ByVal Index As Long)
    Npc(Index).Name = ""
    Npc(Index).AttackSay = ""
    Npc(Index).Sprite = 0
    Npc(Index).SpawnSecs = 0
    Npc(Index).Behavior = 0
    Npc(Index).Range = 0
    Npc(Index).Drop = 0
    Npc(Index).STR = 0
    Npc(Index).DEF = 0
    Npc(Index).SPEED = 0
    Npc(Index).MAGI = 0
End Sub

Go into modGeneral and find:

Code:

Call SetStatus("Clearing spells...")
    Call ClearSpells

Add below that this:

Code:

Call SetStatus("Clearing drops...")
    Call ClearDrops

Find:

Code:

Call SetStatus("Loading spells...")
    Call LoadSpells

Add below that this:

Code:

Call SetStatus("Loading drops...")
    Call LoadDrops

Go into modGlobals and add:

Code:

Public Drop(1 To MAX_DROPS) As DropRec

Go into modHandleData and add:

Code:

Dim DropNum As Long

And add:

Code:

' ::::::::::::::::::::::::::::::
    ' :: Request edit drop packet ::
    ' ::::::::::::::::::::::::::::::
    If LCase(Parse(0)) = "requesteditdrop" Then
        ' Prevent hacking
        If GetPlayerAccess(Index) < ADMIN_DEVELOPER Then
            Call HackingAttempt(Index, "Admin Cloning")
            Exit Sub
        End If
      
        Call SendDataTo(Index, "DROPEDITOR" & SEP_CHAR & END_CHAR)
        Exit Sub
    End If
  
    ' ::::::::::::::::::::::
    ' :: Edit drop packet ::
    ' ::::::::::::::::::::::
    If LCase(Parse(0)) = "editdrop" Then
        ' Prevent hacking
        If GetPlayerAccess(Index) < ADMIN_DEVELOPER Then
            Call HackingAttempt(Index, "Admin Cloning")
            Exit Sub
        End If
      
        ' The drop #
        n = Val(Parse(1))
      
        ' Prevent hacking
        If n < 0 Or n > MAX_DROPS Then
            Call HackingAttempt(Index, "Invalid Drop Index")
            Exit Sub
        End If
      
        Call AddLog(GetPlayerName(Index) & " editing drop #" & n & ".", ADMIN_LOG)
        Call SendEditDropTo(Index, n)
    End If
  
    ' ::::::::::::::::::::::
    ' :: Save drop packet ::
    ' ::::::::::::::::::::::
    If (LCase(Parse(0)) = "savedrop") Then
        ' Prevent hacking
        If GetPlayerAccess(Index) < ADMIN_DEVELOPER Then
            Call HackingAttempt(Index, "Admin Cloning")
            Exit Sub
        End If
      
        ' Drop #
        DropNum = Val(Parse(1))
      
        ' Prevent hacking
        If n < 0 Or n > MAX_DROPS Then
            Call HackingAttempt(Index, "Invalid Drop Index")
            Exit Sub
        End If
      
        ' Update the drop
        Drop(DropNum).Name = Trim(Parse(2))
        
        n = 3
        For i = 1 To MAX_DROP_ITEMS
            Drop(DropNum).ItemDrop(i).ItemNum = (Parse(n))
            Drop(DropNum).ItemDrop(i).Chance = (Parse(n + 1))
            Drop(DropNum).ItemDrop(i).ItemValue = (Parse(n + 2))
            n = n + 3
        Next i
        
        ' Save it
        Call SendUpdateDropToAll(DropNum)
        Call SaveDrop(DropNum)
        Call AddLog(GetPlayerName(Index) & " saving drop #" & n & ".", ADMIN_LOG)
        Exit Sub
    End If

Find and change to:

Code:

' :::::::::::::::::::::
    ' :: Save npc packet ::
    ' :::::::::::::::::::::
    If LCase(Parse(0)) = "savenpc" Then
        ' Prevent hacking
        If GetPlayerAccess(Index) < ADMIN_DEVELOPER Then
            Call HackingAttempt(Index, "Admin Cloning")
            Exit Sub
        End If
        
        n = Val(Parse(1))
        
        ' Prevent hacking
        If n < 0 Or n > MAX_NPCS Then
            Call HackingAttempt(Index, "Invalid NPC Index")
            Exit Sub
        End If
        
        ' Update the npc
        Npc(n).Name = Parse(2)
        Npc(n).AttackSay = Parse(3)
        Npc(n).Sprite = Val(Parse(4))
        Npc(n).SpawnSecs = Val(Parse(5))
        Npc(n).Behavior = Val(Parse(6))
        Npc(n).Range = Val(Parse(7))
        Npc(n).Drop = Val(Parse(8))
        Npc(n).STR = Val(Parse(11))
        Npc(n).DEF = Val(Parse(12))
        Npc(n).SPEED = Val(Parse(13))
        Npc(n).MAGI = Val(Parse(14))
        
        ' Save it
        Call SendUpdateNpcToAll(n)
        Call SaveNpc(n)
        Call AddLog(GetPlayerName(Index) & " saved npc #" & n & ".", ADMIN_LOG)
        Exit Sub
    End If

Go into modServerTCP and add:

Code:

Sub SendDrops(ByVal Index As Long)
Dim i As Long

    For i = 1 To MAX_DROPS
        If Trim(Drop(i).Name)  "" Then
            Call SendUpdateDropTo(Index, i)
        End If
    Next i
End Sub

Sub SendUpdateDropToAll(ByVal DropNum As Long)
Dim Packet As String

    Packet = "UPDATEDROP" & SEP_CHAR & DropNum & SEP_CHAR & Trim(Drop(DropNum).Name) & SEP_CHAR & END_CHAR
    Call SendDataToAll(Packet)
End Sub

Sub SendUpdateDropTo(ByVal Index As Long, ByVal DropNum As Long)
Dim Packet As String

    Packet = "UPDATEDROP" & SEP_CHAR & DropNum & SEP_CHAR & Trim(Drop(DropNum).Name) & SEP_CHAR & END_CHAR
    Call SendDataTo(Index, Packet)
End Sub

Sub SendEditDropTo(ByVal Index As Long, ByVal DropNum As Long)
Dim Packet As String
Dim i As Long
    
    Packet = "EDITDROP" & SEP_CHAR & DropNum & SEP_CHAR & Drop(DropNum).Name & SEP_CHAR
    
    For i = 1 To MAX_DROP_ITEMS
        Packet = Packet & (Drop(DropNum).ItemDrop(i).ItemNum) & SEP_CHAR & Drop(DropNum).ItemDrop(i).Chance & SEP_CHAR & Drop(DropNum).ItemDrop(i).ItemValue & SEP_CHAR
    Next i
    
    Packet = Packet & END_CHAR
    
    Call SendDataTo(Index, Packet)
End Sub

Find and change to:

Code:

Sub SendEditNpcTo(ByVal Index As Long, ByVal NpcNum As Long)
Dim Packet As String

    Packet = "EDITNPC" & SEP_CHAR & NpcNum & SEP_CHAR & Trim(Npc(NpcNum).Name) & SEP_CHAR & Trim(Npc(NpcNum).AttackSay) & SEP_CHAR & Npc(NpcNum).Sprite & SEP_CHAR & Npc(NpcNum).SpawnSecs & SEP_CHAR & Npc(NpcNum).Behavior & SEP_CHAR & Npc(NpcNum).Range & SEP_CHAR & Npc(NpcNum).Drop & SEP_CHAR & Npc(NpcNum).STR & SEP_CHAR & Npc(NpcNum).DEF & SEP_CHAR & Npc(NpcNum).SPEED & SEP_CHAR & Npc(NpcNum).MAGI & SEP_CHAR & END_CHAR
    Call SendDataTo(Index, Packet)
End Sub

Go into modTypes and find:

Code:

Type MapItemRec
    Num As Byte
    Value As Long
    Dur As Integer
    
    x As Byte
    y As Byte
End Type

Add below that this (remove the old npc rec):

Code:

Type DropItemRec
    ItemNum As Byte
    Chance As Integer
    ItemValue As Integer
End Type

Type DropRec
    Name As String
    ItemDrop(1 To MAX_DROP_ITEMS) As DropItemRec
End Type

Type NpcRec
    Name As String * NAME_LENGTH
    AttackSay As String * 255
    
    Sprite As Integer
    SpawnSecs As Long
    Behavior As Byte
    Range As Byte
    
    Drop As Byte
    
    STR  As Byte
    DEF As Byte
    SPEED As Byte
    MAGI As Byte
End Type

Thats all for server side, i'll work on client side tomorrow.. Im going to write up a much more explained and commented version later. I started writing one, but realised i was putting way too much explaination and need to clean it up, and finish it off. Enjoy!!

Part 2 - Client Side
Go into modClientTCP and add:

Code:

Sub SendRequestEditDrop()
Dim Packet As String

    Packet = "REQUESTEDITDROP" & SEP_CHAR & END_CHAR
    Call SendData(Packet)
End Sub

Public Sub SendSaveDrop(ByVal DropNum As Long)
Dim Packet As String
Dim i As Long

    With Drop(DropNum)
        Packet = "SAVEDROP" & SEP_CHAR & DropNum & SEP_CHAR & Trim(.Name) & SEP_CHAR
    End With
    
    For i = 1 To MAX_DROP_ITEMS
        With Drop(DropNum).ItemDrop(i)
            Packet = Packet & .ItemNum & SEP_CHAR & .Chance & SEP_CHAR & .ItemValue & SEP_CHAR
        End With
    Next i
    
    Packet = Packet & END_CHAR
    Call SendData(Packet)
End Sub

Find and change to:

Code:

Public Sub SendSaveNpc(ByVal NpcNum As Long)
'****************************************************************
'* WHEN        WHO        WHAT
'* ----        ---        ----
'* 07/12/2005  Shannara   Optimized function.
'****************************************************************

Dim Packet As String
    
    With Npc(NpcNum)
        Packet = "SAVENPC" & SEP_CHAR & NpcNum & SEP_CHAR & Trim(.Name) & SEP_CHAR & Trim(.AttackSay) & SEP_CHAR & .Sprite & SEP_CHAR & .SpawnSecs & SEP_CHAR & .Behavior & SEP_CHAR & .Range & SEP_CHAR & .Drop & SEP_CHAR & .STR & SEP_CHAR & .DEF & SEP_CHAR & .SPEED & SEP_CHAR & .MAGI & SEP_CHAR & END_CHAR
    End With
    
    Call SendData(Packet)
End Sub

Go into modConstants and add:

Code:

' Drop constants
Public Const MAX_DROPS = 255
Public Const MAX_DROP_ITEMS = 10

Go into modGameLogic and find and change to:

Code:

Public Sub NpcEditorInit()
'****************************************************************
'* WHEN        WHO        WHAT
'* ----        ---        ----
'* 07/12/2005  Shannara   Added gfx constant.
'****************************************************************
    
    frmNpcEditor.picSprites.Picture = LoadPicture(App.Path & GFX_PATH & "sprites" & GFX_EXT)
    
    frmNpcEditor.txtName.Text = Trim(Npc(EditorIndex).Name)
    frmNpcEditor.txtAttackSay.Text = Trim(Npc(EditorIndex).AttackSay)
    frmNpcEditor.scrlSprite.Value = Npc(EditorIndex).Sprite
    frmNpcEditor.txtSpawnSecs.Text = STR(Npc(EditorIndex).SpawnSecs)
    frmNpcEditor.cmbBehavior.ListIndex = Npc(EditorIndex).Behavior
    frmNpcEditor.scrlRange.Value = Npc(EditorIndex).Range
    frmNpcEditor.scrlDrop.Value = Npc(EditorIndex).Drop
    frmNpcEditor.scrlSTR.Value = Npc(EditorIndex).STR
    frmNpcEditor.scrlDEF.Value = Npc(EditorIndex).DEF
    frmNpcEditor.scrlSPEED.Value = Npc(EditorIndex).SPEED
    frmNpcEditor.scrlMAGI.Value = Npc(EditorIndex).MAGI
    
    frmNpcEditor.Show vbModal
End Sub

Public Sub NpcEditorOk()
    Npc(EditorIndex).Name = frmNpcEditor.txtName.Text
    Npc(EditorIndex).AttackSay = frmNpcEditor.txtAttackSay.Text
    Npc(EditorIndex).Sprite = frmNpcEditor.scrlSprite.Value
    Npc(EditorIndex).SpawnSecs = Val(frmNpcEditor.txtSpawnSecs.Text)
    Npc(EditorIndex).Behavior = frmNpcEditor.cmbBehavior.ListIndex
    Npc(EditorIndex).Range = frmNpcEditor.scrlRange.Value
    Npc(EditorIndex).Drop = frmNpcEditor.scrlDrop.Value
    Npc(EditorIndex).STR = frmNpcEditor.scrlSTR.Value
    Npc(EditorIndex).DEF = frmNpcEditor.scrlDEF.Value
    Npc(EditorIndex).SPEED = frmNpcEditor.scrlSPEED.Value
    Npc(EditorIndex).MAGI = frmNpcEditor.scrlMAGI.Value
    
    Call SendSaveNpc(EditorIndex)
    InNpcEditor = False
    Unload frmNpcEditor
End Sub

Find:

Code:

' Editing spell request
            If Mid(MyText, 1, 10) = "/editspell" Then
                Call SendRequestEditSpell
                MyText = ""
                Exit Sub
            End If

Add below that this:

Code:

' Editing drop request
            If Mid(MyText, 1, 10) = "/editdrop" Then
                Call SendRequestEditDrop
                MyText = ""
                Exit Sub
            End If

Go into modGlobals and find:

Code:

Public EditorIndex As Long

Add below that this:

Code:

Public InDropEditor As Boolean

Find:

Code:

Public Spell(1 To MAX_SPELLS) As SpellRec

Add below that this:

Code:

Public Drop(1 To MAX_DROPS) As DropRec

Add at the bottom of modGameLogic:

Code:

Public Sub DropEditorInit()
    frmDropEditor.txtDropName.Text = Trim(Drop(EditorIndex).Name)
    frmDropEditor.scrlItemNum.Value = Drop(EditorIndex).ItemDrop(1).ItemNum
    frmDropEditor.txtChance.Text = Trim(Drop(EditorIndex).ItemDrop(1).Chance)
    frmDropEditor.scrlValue.Value = Drop(EditorIndex).ItemDrop(1).ItemValue
    
    frmDropEditor.Show vbModal
End Sub

Public Sub DropEditorOk()
    Drop(EditorIndex).Name = frmDropEditor.txtDropName.Text
  
    Call SendSaveDrop(EditorIndex)
    InDropEditor = False
    Unload frmDropEditor
End Sub

Public Sub DropEditorCancel()
    InDropEditor = False
    Unload frmDropEditor
End Sub

Go to modHandleData and add:

Code:

Dim DropNum As Long

And add:

Code:

' ::::::::::::::::::::::::
    ' :: Drop editor packet ::
    ' ::::::::::::::::::::::::
    If (LCase(Parse(0)) = "dropeditor") Then
        InDropEditor = True
        
        frmIndex.Show
        frmIndex.lstIndex.Clear
        
        ' Add the names
        For i = 1 To MAX_DROPS
            frmIndex.lstIndex.AddItem i & ": " & Trim(Drop(i).Name)
        Next i
        
        frmIndex.lstIndex.ListIndex = 0
        Exit Sub
    End If
    
    ' ::::::::::::::::::::::::
    ' :: Update drop packet ::
    ' ::::::::::::::::::::::::
    If (LCase(Parse(0)) = "updatedrop") Then
        n = Val(Parse(1))
        
        ' Update the drop
        Drop(n).Name = Parse(2)
        Exit Sub
    End If

    ' ::::::::::::::::::::::
    ' :: Edit drop packet ::  0 Then
        lblItemName.Caption = Trim(Item(scrlItemNum.Value).Name)
    End If
    
    Drop(EditorIndex).ItemDrop(scrlItemDrop.Value).ItemNum = scrlItemNum.Value
End Sub

Private Sub scrlValue_Change()
    lblValue.Caption = STR(scrlValue.Value)
    
    Drop(EditorIndex).ItemDrop(scrlItemDrop.Value).ItemValue = scrlValue.Value
End Sub

Private Sub txtChance_Change()
    Drop(EditorIndex).ItemDrop(scrlItemDrop.Value).Chance = Val(txtChance.Text)
End Sub

And now you should be done.. Enjoy!! If there are any bugs please let me know and i'll fix them right away.. Thanks guys