Getting the Bloody Job Done

GoreMania · **Joined:** Wed Oct 08, 2008 8:09 am **Posts:** 148

So here's my next tutorials: Jobs and blood spatters. I did talk to Spodi and got his permission to put the blood in here. If You change your mind about that Spodi, I'll take the blood tut out. Thanks

So, I implemented a new job system. I only have one example of a job in there, Blacksmithing. Hopefully you can get enough out of it to come up with more job stuff! I'll be making 2 more examples soon: Alchemy and crafting. Let's begin

Btw, there's a lot of code, so there's a good chance I miss something. Back up your code! I'm not responsible for bugs, breaks, cracks, blood spills, or random wormholes that may appear while using my code... unless I did so deliberately, in which case I shall not admit it :spin:

------------- MISC ----------
Download my resources. Note, replace the current blood graphic with the new one included.

Open GrhRaw.txt and these new grhs:

Code:

'**** Blue Wave GUI ****
Grh347=1-194-0-0-301-315-(128)
Grh348=1-194-317-0-150-250-(128)

'**** Liquid Red GUI ****
Grh351=1-196-0-0-301-315-(128)
Grh352=1-196-317-0-150-250-(128)


'**** Pinkish Love GUI ****
Grh353=1-197-0-0-301-315-(128)
Grh354=1-197-317-0-150-250-(128)


'**** Spirits GUI ****
Grh355=1-198-0-0-301-315-(128)
Grh356=1-198-317-0-150-250-(128)


'**** Storm Clouds GUI ****
Grh357=1-199-0-0-301-315-(128)
Grh358=1-199-317-0-150-250-(128)



'***** Blast Furnace *****
Grh300=1-190-17-15-102-100-(128)
Grh301=1-190-146-15-102-100-(128)
Grh302=1-190-273-15-102-100-(128)
Grh303=1-190-385-15-102-100-(128)

'***** Anvil *****
Grh304=1-191-17-10-49-44-(128)
Grh305=1-191-74-10-49-44-(128)
Grh306=1-191-133-10-49-44-(128)
Grh307=1-191-187-10-49-44-(128)


'***** Golem *****
'Walk South
Grh308=1-192-0-26-77-77-(128)
Grh309=1-192-70-26-77-77-(128)
Grh310=1-192-137-26-77-77-(128)
Grh311=1-192-205-26-77-77-(128)
'Walk East
Grh312=1-192-0-142-77-77-(128)
Grh313=1-192-65-142-77-77-(128)
Grh314=1-192-130-142-77-77-(128)
Grh315=1-192-200-142-77-77-(128)
'Walk North
Grh316=1-192-0-257-77-77-(128)
Grh317=1-192-67-257-77-77-(128)
Grh318=1-192-136-257-77-77-(128)
Grh319=1-192-204-257-77-77-(128)
'Walk West
Grh320=1-192-0-365-77-77-(128)
Grh321=1-192-65-365-77-77-(128)
Grh322=1-192-137-365-77-77-(128)
Grh323=1-192-203-365-77-77-(128)
'Attack South
Grh324=1-192-272-26-77-77-(128)
Grh325=1-192-342-26-77-77-(128)
Grh326=1-192-415-26-77-77-(128)
'Attack East
Grh327=1-192-266-142-77-77-(128)
Grh328=1-192-339-142-77-77-(128)
Grh329=1-192-426-142-77-77-(128)
'Attack North
Grh330=1-192-277-257-77-77-(128)
Grh331=1-192-347-257-77-77-(128)
Grh332=1-192-419-257-77-77-(128)
'Attack West
Grh333=1-192-277-365-77-77-(128)
Grh334=1-192-347-365-77-77-(128)
Grh335=1-192-425-365-77-77-(128)

'Animations
Grh336=4-308-309-310-311-8-(128)
Grh337=4-312-313-314-315-8-(128)
Grh338=4-316-317-318-319-8-(128)
Grh339=4-320-321-322-323-8-(128)
Grh340=4-308-324-325-326-8-(128)
Grh341=4-312-327-328-329-8-(128)
Grh342=4-316-330-331-332-8-(128)
Grh343=4-320-333-334-335-8-(128)



'***** Ore (rocks) *****
Grh345=1-193-0-0-32-32-(128)

'***** Metal Bar *****
Grh346=1-193-32-0-32-32-(128)

'***** JOB MENU SELECTION BORDER ******
Grh344=1-194-326-260-40-40-(128)

Now open each skin file (.ini) and add this:

Code:

[FURNACEMENU]
ScreenX=300
ScreenY=200
ScreenWidth=150
ScreenHeight=250

IronBarX=11
IronBarY=48
IronBarWidth=60
IronBarHeight=49

Locked=True
Grh=348


[ANVILMENU]
ScreenX=0
ScreenY=4
ScreenWidth=301
ScreenHeight=315

IronBarX=2
IronBarY=24
IronBarWidth=40
IronBarHeight=40

ShurikenX=44
ShurikenY=24
ShurikenWidth=40
ShurikenHeight=40

DaggerX=86
DaggerY=24
DaggerWidth=40
DaggerHeight=40

ShieldX=128
ShieldY=24
ShieldWidth=40
ShieldHeight=40

ArmorX=170
ArmorY=24
ArmorWidth=40
ArmorHeight=40


CreateX=124
CreateY=298
CreateWidth=43
CreateHeight=15


Locked=True
Grh=347
SelectGrh=344

but change the grh values appropriately:

'**** Blue Wave GUI ****
Grh347=1-194-0-0-301-315-(128)
Grh348=1-194-317-0-150-250-(128)

'**** Liquid Red GUI ****
Grh351=1-196-0-0-301-315-(128)
Grh352=1-196-317-0-150-250-(128)

'**** Pinkish Love GUI ****
Grh353=1-197-0-0-301-315-(128)
Grh354=1-197-317-0-150-250-(128)

'**** Spirits GUI ****
Grh355=1-198-0-0-301-315-(128)
Grh356=1-198-317-0-150-250-(128)

'**** Storm Clouds GUI ****
Grh357=1-199-0-0-301-315-(128)
Grh358=1-199-317-0-150-250-(128)

Now open the skin .dat files and add this to them

Code:

[ANVILMENU]
ScreenX= 0
ScreenY= 4
Locked=True

[FURNACEMENU]
ScreenX= 300
ScreenY= 200
Locked=True

GoreMania · **Joined:** Wed Oct 08, 2008 8:09 am **Posts:** 148

----------- CLIENT -------------
open particle.cls and replace the code in there with this:

Code:

Option Explicit

'Values Stored For Each Particle
Private mvarused As Boolean
Private mvarsngX As Single
Private mvarsngY As Single
Private mvarsngXSpeed As Single
Private mvarsngYSpeed As Single
Private mvarsngXAccel As Single
Private mvarsngYAccel As Single
Private mvarsngR As Single
Private mvarsngG As Single
Private mvarsngB As Single
Private mvarsngA As Single
Private mvarsngAlphaDecay As Single
Private mvarsngZ As Single
Private mvarsngZSpeed As Single
Private mvarsngZAccel As Single

Public Sub ResetColor(sngRed As Single, sngGreen As Single, sngBlue As Single, sngAlpha As Single, sngDecay As Single)

'Change the particle's color values

    sngR = sngRed
    sngG = sngGreen
    sngB = sngBlue
    sngA = sngAlpha
    sngAlphaDecay = sngDecay

End Sub

Public Sub ResetIt(X As Single, Y As Single, XSpeed As Single, YSpeed As Single, XAcc As Single, YAcc As Single, Optional Z As Single = 0, Optional ZSpeed As Single = 0, Optional ZAcc As Single = 0)

    'Reset the particle's variables
    sngX = X
    sngY = Y
    sngZ = Z
    sngXSpeed = XSpeed
    sngYSpeed = YSpeed
    sngZSpeed = ZSpeed
    sngXAccel = XAcc
    sngYAccel = YAcc
    sngZAccel = ZAcc

End Sub

Public Property Get sngA() As Single

    sngA = mvarsngA

End Property

Public Property Let sngA(ByVal vData As Single)

    mvarsngA = vData

End Property

Public Property Get sngAlphaDecay() As Single

    sngAlphaDecay = mvarsngAlphaDecay

End Property

Public Property Let sngAlphaDecay(ByVal vData As Single)

    mvarsngAlphaDecay = vData

End Property

Public Property Get sngB() As Single

    sngB = mvarsngB

End Property

Public Property Let sngB(ByVal vData As Single)

    mvarsngB = vData

End Property

Public Property Get sngG() As Single

    sngG = mvarsngG

End Property

Public Property Let sngG(ByVal vData As Single)

    mvarsngG = vData

End Property

Public Property Get sngR() As Single

    sngR = mvarsngR

End Property

Public Property Let sngR(ByVal vData As Single)

    mvarsngR = vData

End Property

Public Property Get sngX() As Single

    sngX = mvarsngX

End Property

Public Property Let sngX(ByVal vData As Single)

    mvarsngX = vData

End Property

Public Property Get sngXAccel() As Single

    sngXAccel = mvarsngXAccel

End Property

Public Property Let sngXAccel(ByVal vData As Single)

    mvarsngXAccel = vData

End Property

Public Property Get sngXSpeed() As Single

    sngXSpeed = mvarsngXSpeed

End Property

Public Property Let sngXSpeed(ByVal vData As Single)

    mvarsngXSpeed = vData

End Property

Public Property Get sngZSpeed() As Single

    sngZSpeed = mvarsngZSpeed

End Property

Public Property Let sngZSpeed(ByVal vData As Single)

    mvarsngZSpeed = vData

End Property

Public Property Get sngY() As Single

    sngY = mvarsngY

End Property

Public Property Let sngY(ByVal vData As Single)

    mvarsngY = vData

End Property

Public Property Get sngZ() As Single

    sngZ = mvarsngZ

End Property

Public Property Let sngZ(ByVal vData As Single)

    mvarsngZ = vData

End Property

Public Property Get sngYAccel() As Single

    sngYAccel = mvarsngYAccel

End Property

Public Property Let sngYAccel(ByVal vData As Single)

    mvarsngYAccel = vData

End Property

Public Property Get sngZAccel() As Single

    sngZAccel = mvarsngZAccel

End Property

Public Property Let sngZAccel(ByVal vData As Single)

    mvarsngZAccel = vData

End Property

Public Property Get sngYSpeed() As Single

    sngYSpeed = mvarsngYSpeed

End Property

Public Property Let sngYSpeed(ByVal vData As Single)

    mvarsngYSpeed = vData

End Property

Public Sub UpdateParticle(sngTime As Single)

    'Update the particle's variables
    sngX = sngX + (LastOffsetX - ParticleOffsetX) + sngXSpeed * sngTime
    sngY = sngY + (LastOffsetY - ParticleOffsetY) + sngYSpeed * sngTime
    sngZ = sngZ + sngZSpeed * sngTime
    sngXSpeed = sngXSpeed + sngXAccel * sngTime
    sngYSpeed = sngYSpeed + sngYAccel * sngTime
    sngZSpeed = sngZSpeed + sngZAccel * sngTime
    sngA = sngA - sngAlphaDecay * sngTime

End Sub

Public Property Get Used() As Boolean

    Used = mvarused

End Property

Public Property Let Used(ByVal vData As Boolean)

    mvarused = vData

End Property

This enables the 3D particle effect

Now, before we go on, you should go through the various .bas files, search for the word "blood" and remove the appropriate code. We are scrapping the old blood system. Once you finish, go to the next step:

Open TileEngine.bas

Add this to it:

Code:

'Blood list
Public Type BloodData
    v(0 To 5) As TLVERTEX
    Life As Long
    TileX As Byte
    TileY As Byte
End Type
Public LastBlood As Long
Public BloodList() As BloodData

Find "Public Type MapBlock" and add this to it:

Code:

Blood As Byte

Find "Public Const NumGameWindows As Byte =" and above it add this:

Code:

Public Const AnvilWindow As Byte = 20
Public Const FurnaceWindow As Byte = 21

change 20 and 21 to the next available numbers in your code and update NumGameWindows.

Now add this code to above the line "Private Type WindowNPCChat":

Code:

Private Type AnvilWindow
    Screen As Rectangle
    
    IronBar As Rectangle
    Shuriken As Rectangle
    Dagger As Rectangle
    Shield As Rectangle
    Armor As Rectangle
    Create As Rectangle
    SkinGrh As Grh
    SelectGrh As Grh
    
    Metal As Integer 'chosen metal to make item from
    Item As Integer  'chosen item to make
    
    Locked As Boolean
End Type

Private Type FurnaceWindow
    Screen As Rectangle
    
    IronBar As Rectangle
    
    SkinGrh As Grh
    Locked As Boolean
End Type

And add this to "Public Type GameWindow":

Code:

    AnvilMenu As AnvilWindow
    FurnaceMenu As FurnaceWindow

Now find Engine_Damage_Create and replace it with this:

Code:

Public Sub Engine_Damage_Create(ByVal X As Integer, ByVal Y As Integer, ByVal Value As Integer, ByVal Angle As Integer)
'*****************************************************************
'Create damage text
'More info: http://www.vbgore.com/GameClient.TileEngine.Engine_Damage_Create
'*****************************************************************
Dim DamageIndex As Integer

'Get the next open damage slot

    Do
        DamageIndex = DamageIndex + 1

        'Update LastDamage if we go over the size of the current array
        If DamageIndex > LastDamage Then
            LastDamage = DamageIndex
            ReDim Preserve DamageList(1 To LastDamage)
            Exit Do
        End If

    Loop While DamageList(DamageIndex).Counter > 0

    'Set the values
    If Value < 1 Then DamageList(DamageIndex).Value = "Miss" Else DamageList(DamageIndex).Value = Value
    DamageList(DamageIndex).Counter = DamageDisplayTime
    DamageList(DamageIndex).Width = Engine_GetTextWidth(Font_Default, DamageList(DamageIndex).Value)
    DamageList(DamageIndex).Pos.X = X
    DamageList(DamageIndex).Pos.Y = Y
    
    
    'Check to create blood
    If Value > 0 Then
        If Angle <> 0 Then
            Effect_BloodSpray_Begin Engine_TPtoSPX(X) + 16, Engine_TPtoSPY(Y) + 32, Game_BloodCount(), Angle
        Else
            Effect_BloodSplatter_Begin Engine_TPtoSPX(X) + 16, Engine_TPtoSPY(Y) + 32, Game_BloodCount()
        End If
    End If
End Sub

and now add these functions:

Code:

Sub Engine_Blood_Create(ByVal X As Single, ByVal Y As Single, ByVal Size As Byte)

'*****************************************************************
'Creates a puddle of blood on the ground
'*****************************************************************
Dim TileX As Integer
Dim TileY As Integer

Const TexWidth As Single = 64
Const TexHeight As Single = 64

Const NumLarge As Long = 2
Const NumMedium As Long = 12
Const NumSmall = 8

Const Large1X As Single = 0
Const Large1Y As Single = 0
Const Large1W As Single = 32
Const Large1H As Single = 16

Const Large2X As Single = 0
Const Large2Y As Single = 17
Const Large2W As Single = 32
Const Large2H As Single = 16

Const Med1X As Single = 0
Const Med1Y As Single = 34
Const Med1W As Single = 14
Const Med1H As Single = 6

Const Med2X As Single = 0
Const Med2Y As Single = 41
Const Med2W As Single = 12
Const Med2H As Single = 7

Const Med3X As Single = 0
Const Med3Y As Single = 49
Const Med3W As Single = 11
Const Med3H As Single = 8

Const Med4X As Single = 15
Const Med4Y As Single = 34
Const Med4W As Single = 12
Const Med4H As Single = 5

Const Med5X As Single = 15
Const Med5Y As Single = 40
Const Med5W As Single = 8
Const Med5H As Single = 9

Const Med6X As Single = 12
Const Med6Y As Single = 50
Const Med6W As Single = 9
Const Med6H As Single = 7

Const Med7X As Single = 22
Const Med7Y As Single = 50
Const Med7W As Single = 10
Const Med7H As Single = 7

Const Med8X As Single = 33
Const Med8Y As Single = 0
Const Med8W As Single = 16
Const Med8H As Single = 7

Const Med9X As Single = 33
Const Med9Y As Single = 8
Const Med9W As Single = 14
Const Med9H As Single = 7

Const Med10X As Single = 33
Const Med10Y As Single = 29
Const Med10W As Single = 17
Const Med10H As Single = 8

Const Med11X As Single = 33
Const Med11Y As Single = 38
Const Med11W As Single = 15
Const Med11H As Single = 9

Const Med12X As Single = 33
Const Med12Y As Single = 48
Const Med12W As Single = 11
Const Med12H As Single = 6

Const Small1X As Single = 28
Const Small1Y As Single = 34
Const Small1W As Single = 4
Const Small1H As Single = 6

Const Small2X As Single = 24
Const Small2Y As Single = 41
Const Small2W As Single = 6
Const Small2H As Single = 4

Const Small3X As Single = 33
Const Small3Y As Single = 16
Const Small3W As Single = 10
Const Small3H As Single = 3

Const Small4X As Single = 44
Const Small4Y As Single = 16
Const Small4W As Single = 4
Const Small4H As Single = 5

Const Small5X As Single = 33
Const Small5Y As Single = 20
Const Small5W As Single = 8
Const Small5H As Single = 4

Const Small6X As Single = 42
Const Small6Y As Single = 22
Const Small6W As Single = 4
Const Small6H As Single = 3

Const Small7X As Single = 33
Const Small7Y As Single = 25
Const Small7W As Single = 8
Const Small7H As Single = 3

Const Small8X As Single = 42
Const Small8Y As Single = 26
Const Small8W As Single = 5
Const Small8H As Single = 2

Dim BloodIndex As Integer
Dim i As Long
Dim L As Long

    'Find the tile
    TileX = ((X - 288) \ 32) + 1
    TileY = ((Y - 288) \ 32) + 1
    If TileX < 1 Then TileX = 1
    If TileX > MapInfo.Width Then TileX = MapInfo.Width
    If TileY < 1 Then TileY = 1
    If TileY > MapInfo.Height Then TileY = MapInfo.Height
    
    'Check if there is too much blood on this tile already
    If MapData(TileX, TileY).Blood > 40 Then Exit Sub

    'Get the next open blood slot
    Do
        BloodIndex = BloodIndex + 1
        
        'Update LastBlood if we go over the size of the current array
        If BloodIndex > LastBlood Then
            LastBlood = BloodIndex
            ReDim Preserve BloodList(1 To LastBlood)
            Exit Do
        End If
    
    Loop While BloodList(BloodIndex).Life > 0

    'Set the blood's lfie
    BloodList(BloodIndex).Life = timeGetTime + 30000
    
    'Get a random size if none is specified
    If Size < 1 Or Size > 3 Then
        Size = Int(Rnd * (NumLarge + NumSmall + NumMedium)) + 1
        If Size <= NumLarge Then
            Size = 3
        ElseIf Size <= NumLarge + NumMedium Then
            Size = 2
        Else
            Size = 1
        End If
    End If
    
    With BloodList(BloodIndex)
        
        'Set up the general blood information
        For L = 0 To 5
            .v(L).Color = -1
            .v(L).Rhw = 1
            .v(L).X = X
            .v(L).Y = Y
        Next L

        '    3____4
        ' 0|\\    |  0 = 3
        '  | \\   |  1 = 5
        '  |  \\  |
        '  |   \\ |
        ' 2|____\\|
        '       1 5
        
        'Large blood
        If Size = 3 Then
            i = Int(Rnd * NumLarge) + 1
            Select Case i
                Case 1
                    .v(4).X = X + Large1W
                    .v(2).Y = Y + Large1H
                    .v(0).tU = Large1X / TexWidth
                    .v(0).tV = Large1Y / TexHeight
                    .v(5).tU = (Large1X + Large1W) / TexWidth
                    .v(5).tV = (Large1Y + Large1H) / TexHeight
                Case 2
                    .v(4).X = X + Large2W
                    .v(2).Y = Y + Large2H
                    .v(0).tU = Large2X / TexWidth
                    .v(0).tV = Large2Y / TexHeight
                    .v(5).tU = (Large2X + Large2W) / TexWidth
                    .v(5).tV = (Large2Y + Large2H) / TexHeight
            End Select
        
        'Medium blood
        ElseIf Size = 2 Then
            i = Int(Rnd * NumMedium) + 1
            Select Case i
                Case 1
                    .v(4).X = X + Med1W
                    .v(2).Y = Y + Med1H
                    .v(0).tU = Med1X / TexWidth
                    .v(0).tV = Med1Y / TexHeight
                    .v(5).tU = (Med1X + Med1W) / TexWidth
                    .v(5).tV = (Med1Y + Med1H) / TexHeight
                Case 2
                    .v(4).X = X + Med2W
                    .v(2).Y = Y + Med2H
                    .v(0).tU = Med2X / TexWidth
                    .v(0).tV = Med2Y / TexHeight
                    .v(5).tU = (Med2X + Med2W) / TexWidth
                    .v(5).tV = (Med2Y + Med2H) / TexHeight
                Case 3
                    .v(4).X = X + Med3W
                    .v(2).Y = Y + Med3H
                    .v(0).tU = Med3X / TexWidth
                    .v(0).tV = Med3Y / TexHeight
                    .v(5).tU = (Med3X + Med3W) / TexWidth
                    .v(5).tV = (Med3Y + Med3H) / TexHeight
                Case 4
                    .v(4).X = X + Med4W
                    .v(2).Y = Y + Med4H
                    .v(0).tU = Med4X / TexWidth
                    .v(0).tV = Med4Y / TexHeight
                    .v(5).tU = (Med4X + Med4W) / TexWidth
                    .v(5).tV = (Med4Y + Med4H) / TexHeight
                Case 5
                    .v(4).X = X + Med5W
                    .v(2).Y = Y + Med5H
                    .v(0).tU = Med5X / TexWidth
                    .v(0).tV = Med5Y / TexHeight
                    .v(5).tU = (Med5X + Med5W) / TexWidth
                    .v(5).tV = (Med5Y + Med5H) / TexHeight
                Case 6
                    .v(4).X = X + Med6W
                    .v(2).Y = Y + Med6H
                    .v(0).tU = Med6X / TexWidth
                    .v(0).tV = Med6Y / TexHeight
                    .v(5).tU = (Med6X + Med6W) / TexWidth
                    .v(5).tV = (Med6Y + Med6H) / TexHeight
                Case 7
                    .v(4).X = X + Med7W
                    .v(2).Y = Y + Med7H
                    .v(0).tU = Med7X / TexWidth
                    .v(0).tV = Med7Y / TexHeight
                    .v(5).tU = (Med7X + Med7W) / TexWidth
                    .v(5).tV = (Med7Y + Med7H) / TexHeight
                Case 8
                    .v(4).X = X + Med8W
                    .v(2).Y = Y + Med8H
                    .v(0).tU = Med8X / TexWidth
                    .v(0).tV = Med8Y / TexHeight
                    .v(5).tU = (Med8X + Med8W) / TexWidth
                    .v(5).tV = (Med8Y + Med8H) / TexHeight
                Case 9
                    .v(4).X = X + Med9W
                    .v(2).Y = Y + Med9H
                    .v(0).tU = Med9X / TexWidth
                    .v(0).tV = Med9Y / TexHeight
                    .v(5).tU = (Med9X + Med9W) / TexWidth
                    .v(5).tV = (Med9Y + Med9H) / TexHeight
                Case 10
                    .v(4).X = X + Med10W
                    .v(2).Y = Y + Med10H
                    .v(0).tU = Med10X / TexWidth
                    .v(0).tV = Med10Y / TexHeight
                    .v(5).tU = (Med10X + Med10W) / TexWidth
                    .v(5).tV = (Med10Y + Med10H) / TexHeight
                Case 11
                    .v(4).X = X + Med11W
                    .v(2).Y = Y + Med11H
                    .v(0).tU = Med11X / TexWidth
                    .v(0).tV = Med11Y / TexHeight
                    .v(5).tU = (Med11X + Med11W) / TexWidth
                    .v(5).tV = (Med11Y + Med11H) / TexHeight
                Case 12
                    .v(4).X = X + Med12W
                    .v(2).Y = Y + Med12H
                    .v(0).tU = Med12X / TexWidth
                    .v(0).tV = Med12Y / TexHeight
                    .v(5).tU = (Med12X + Med12W) / TexWidth
                    .v(5).tV = (Med12Y + Med12H) / TexHeight
            End Select
        
        'Small blood
        Else
            i = Int(Rnd * NumSmall) + 1
            Select Case i
                Case 1
                    .v(4).X = X + Small1W
                    .v(2).Y = Y + Small1H
                    .v(0).tU = Small1X / TexWidth
                    .v(0).tV = Small1Y / TexHeight
                    .v(5).tU = (Small1X + Small1W) / TexWidth
                    .v(5).tV = (Small1Y + Small1H) / TexHeight
                Case 2
                    .v(4).X = X + Small2W
                    .v(2).Y = Y + Small2H
                    .v(0).tU = Small2X / TexWidth
                    .v(0).tV = Small2Y / TexHeight
                    .v(5).tU = (Small2X + Small2W) / TexWidth
                    .v(5).tV = (Small2Y + Small2H) / TexHeight
                Case 3
                    .v(4).X = X + Small3W
                    .v(2).Y = Y + Small3H
                    .v(0).tU = Small3X / TexWidth
                    .v(0).tV = Small3Y / TexHeight
                    .v(5).tU = (Small3X + Small3W) / TexWidth
                    .v(5).tV = (Small3Y + Small3H) / TexHeight
                Case 4
                    .v(4).X = X + Small4W
                    .v(2).Y = Y + Small4H
                    .v(0).tU = Small4X / TexWidth
                    .v(0).tV = Small4Y / TexHeight
                    .v(5).tU = (Small4X + Small4W) / TexWidth
                    .v(5).tV = (Small4Y + Small4H) / TexHeight
                Case 5
                    .v(4).X = X + Small5W
                    .v(2).Y = Y + Small5H
                    .v(0).tU = Small5X / TexWidth
                    .v(0).tV = Small5Y / TexHeight
                    .v(5).tU = (Small5X + Small5W) / TexWidth
                    .v(5).tV = (Small5Y + Small5H) / TexHeight
                Case 6
                    .v(4).X = X + Small6W
                    .v(2).Y = Y + Small6H
                    .v(0).tU = Small6X / TexWidth
                    .v(0).tV = Small6Y / TexHeight
                    .v(5).tU = (Small6X + Small6W) / TexWidth
                    .v(5).tV = (Small6Y + Small6H) / TexHeight
                Case 7
                    .v(4).X = X + Small7W
                    .v(2).Y = Y + Small7H
                    .v(0).tU = Small7X / TexWidth
                    .v(0).tV = Small7Y / TexHeight
                    .v(5).tU = (Small7X + Small7W) / TexWidth
                    .v(5).tV = (Small7Y + Small7H) / TexHeight
                Case 8
                    .v(4).X = X + Small8W
                    .v(2).Y = Y + Small8H
                    .v(0).tU = Small8X / TexWidth
                    .v(0).tV = Small8Y / TexHeight
                    .v(5).tU = (Small8X + Small8W) / TexWidth
                    .v(5).tV = (Small8Y + Small8H) / TexHeight
            End Select
        End If
        
        'These variables are the same no blood used
        .v(4).tU = .v(5).tU
        .v(4).tV = .v(0).tV
        .v(2).tU = .v(0).tU
        .v(2).tV = .v(5).tV
        .v(5).X = .v(4).X
        .v(5).Y = .v(2).Y
        .v(3) = .v(0)
        .v(1) = .v(5)
        
        'Find the blood tile location
        .TileX = TileX
        .TileY = TileY
        MapData(.TileX, .TileY).Blood = MapData(.TileX, .TileY).Blood + 1
    End With
    
End Sub


Sub Engine_Blood_Erase(ByVal BloodIndex As Long)

'*****************************************************************
'Erases a blood splatter by index
'*****************************************************************
Dim i As Long

    With BloodList(BloodIndex)
    
        'Set the life to 0 to not use it
        BloodList(BloodIndex).Life = 0
        
        'Erase the blood from the tile
        If .TileX > 0 Then
            If .TileY > 0 Then
                If .TileX <= MapInfo.Width Then
                    If .TileY <= MapInfo.Height Then
                        MapData(.TileX, .TileY).Blood = MapData(.TileX, .TileY).Blood - 1
                    End If
                End If
            End If
        End If
        
    End With
        
    'Resize the array if needed
    If BloodIndex = LastBlood Then
        Do Until BloodList(LastBlood).Life > 0
            LastBlood = LastBlood - 1
            If LastBlood = 0 Then Exit Do
        Loop
        If LastBlood <> BloodIndex Then
            If LastBlood <> 0 Then
                ReDim Preserve BloodList(1 To LastBlood)
            Else
                Erase BloodList
            End If
        End If
    End If

End Sub


Private Sub Engine_Render_Blood()

'*****************************************************************
'Batch render the blood on the ground
'*****************************************************************
Dim BloodVB As Direct3DVertexBuffer8    'Vertex buffer
Dim BloodVL() As TLVERTEX   'Vertex list
Dim BloodCount As Long
Dim Alpha As Long
Dim i As Long
Dim j As Long

    'Check for any blood
    If LastBlood = 0 Then Exit Sub

    'Set the blood texture
    Engine_ReadyTexture 3
    
    'Create the vertex list
    ReDim BloodVL(1 To LastBlood * 6)
    For i = 1 To LastBlood
        If BloodList(i).Life <> 0 Then
            If BloodList(i).Life > timeGetTime Then
                If BloodList(i).Life - timeGetTime > 2000 Then
                    Alpha = 255
                Else
                    Alpha = (BloodList(i).Life - timeGetTime) / 7
                    If Alpha > 255 Then Alpha = 255
                End If
                For j = 1 To 6
                    BloodVL((BloodCount * 6) + j) = BloodList(i).v(j - 1)
                    With BloodVL((BloodCount * 6) + j)
                        .X = .X - ParticleOffsetX
                        .Y = .Y - ParticleOffsetY
                        .Color = D3DColorARGB(Alpha, 255, 255, 255)
                        
                    End With
                Next j
                BloodCount = BloodCount + 1
            Else
                Engine_Blood_Erase i
            End If
        End If
    Next i
    
    'Check if any blood was found in use
    If BloodCount = 0 Then Exit Sub
    
    'Create the vertex buffer
    Set BloodVB = D3DDevice.CreateVertexBuffer(FVF_Size * BloodCount * 6, 0, FVF, D3DPOOL_MANAGED)
    D3DVertexBuffer8SetData BloodVB, 0, FVF_Size * BloodCount * 6, 0, BloodVL(1)
    
    'Draw the blood
    D3DDevice.SetStreamSource 0, BloodVB, FVF_Size
    D3DDevice.DrawPrimitive D3DPT_TRIANGLELIST, 0, BloodCount * 2

End Sub

Go to Engine_Render_Screen and then fine

Code:

    'Loop through the lower 3 layers
    For Layer = 1 To 3
        LightOffset = ((Layer - 1) * 4) + 1
        
        'Loop through all the tiles we know we will draw for this layer
        For j = 1 To TileLayer(Layer).NumTiles
            With TileLayer(Layer).Tile(j)
                
                'Check if we have to draw with a shadow or not (slighty changes because we have to animate on the shadow, not the main render)
                If MapData(.TileX, .TileY).Shadow(Layer) = 1 Then
                    Engine_Render_Grh MapData(.TileX, .TileY).Graphic(Layer), .PixelPosX + PixelOffsetX, .PixelPosY + PixelOffsetY, 0, 1, True, ShadowColor, ShadowColor, ShadowColor, ShadowColor, 1
                    Engine_Render_Grh MapData(.TileX, .TileY).Graphic(Layer), .PixelPosX + PixelOffsetX, .PixelPosY + PixelOffsetY, 0, 0, True, MapData(.TileX, .TileY).Light(LightOffset), MapData(.TileX, .TileY).Light(LightOffset + 1), MapData(.TileX, .TileY).Light(LightOffset + 2), MapData(.TileX, .TileY).Light(LightOffset + 3)
                Else
                    Engine_Render_Grh MapData(.TileX, .TileY).Graphic(Layer), .PixelPosX + PixelOffsetX, .PixelPosY + PixelOffsetY, 0, 1, True, MapData(.TileX, .TileY).Light(LightOffset), MapData(.TileX, .TileY).Light(LightOffset + 1), MapData(.TileX, .TileY).Light(LightOffset + 2), MapData(.TileX, .TileY).Light(LightOffset + 3)
                End If
                
            End With
        Next j
        
    Next Layer

and below it add this:

Code:

    '************** Ground blood **************
    Engine_Render_Blood

This is just the tip of the iceberg. I'm adding another post yet for the next part

GoreMania · **Joined:** Wed Oct 08, 2008 8:09 am **Posts:** 148

Still in the TileEngine.bas...

Go to Engien_Init_GUI

Find This:

Code:

t = DataPath & "Skins\" & CurrentSkin & ".dat"

Add this below that:

Code:

    'Load Furnace Menu
    With GameWindow.FurnaceMenu
        If LoadCustomPos Then
            .Screen.X = Val(Var_Get(t, "FURNACEMENU", "ScreenX"))
            .Screen.Y = Val(Var_Get(t, "FURNACEMENU", "ScreenY"))
            .Locked = CBool(Var_Get(t, "FURNACEMENU", "Locked"))
        Else
            .Screen.X = Val(Var_Get(s, "FURNACEMENU", "ScreenX"))
            .Screen.Y = Val(Var_Get(s, "FURNACEMENU", "ScreenY"))
            .Locked = CBool(Var_Get(s, "FURNACEMENU", "Locked"))
        End If
        .Screen.Width = Val(Var_Get(s, "FURNACEMENU", "ScreenWidth"))
        .Screen.Height = Val(Var_Get(s, "FURNACEMENU", "ScreenHeight"))
        Engine_Init_Grh .SkinGrh, Val(Var_Get(s, "FURNACEMENU", "Grh"))
    End With
    
    With GameWindow.FurnaceMenu.IronBar
        .X = Val(Var_Get(s, "FURNACEMENU", "IronBarX"))
        .Y = Val(Var_Get(s, "FURNACEMENU", "IronBarY"))
        .Width = Val(Var_Get(s, "FURNACEMENU", "IronBarWidth"))
        .Height = Val(Var_Get(s, "FURNACEMENU", "IronBarHeight"))
    End With
    
    'Load Anvil Menu
    With GameWindow.AnvilMenu
        If LoadCustomPos Then
            .Screen.X = Val(Var_Get(t, "ANVILMENU", "ScreenX"))
            .Screen.Y = Val(Var_Get(t, "ANVILMENU", "ScreenY"))
            .Locked = CBool(Var_Get(t, "ANVILMENU", "Locked"))
        Else
            .Screen.X = Val(Var_Get(s, "ANVILMENU", "ScreenX"))
            .Screen.Y = Val(Var_Get(s, "ANVILMENU", "ScreenY"))
            .Locked = CBool(Var_Get(s, "ANVILMENU", "Locked"))
        End If
        .Screen.Width = Val(Var_Get(s, "ANVILMENU", "ScreenWidth"))
        .Screen.Height = Val(Var_Get(s, "ANVILMENU", "ScreenHeight"))
        Engine_Init_Grh .SkinGrh, Val(Var_Get(s, "ANVILMENU", "Grh"))
        Engine_Init_Grh .SelectGrh, Val(Var_Get(s, "ANVILMENU", "SelectGrh"))
    End With
    
    With GameWindow.AnvilMenu.IronBar
        .X = Val(Var_Get(s, "ANVILMENU", "IronBarX"))
        .Y = Val(Var_Get(s, "ANVILMENU", "IronBarY"))
        .Width = Val(Var_Get(s, "ANVILMENU", "IronBarWidth"))
        .Height = Val(Var_Get(s, "ANVILMENU", "IronBarHeight"))
    End With
    
    With GameWindow.AnvilMenu.Shuriken
        .X = Val(Var_Get(s, "ANVILMENU", "ShurikenX"))
        .Y = Val(Var_Get(s, "ANVILMENU", "ShurikenY"))
        .Width = Val(Var_Get(s, "ANVILMENU", "ShurikenWidth"))
        .Height = Val(Var_Get(s, "ANVILMENU", "ShurikenHeight"))
    End With
    
    With GameWindow.AnvilMenu.Dagger
        .X = Val(Var_Get(s, "ANVILMENU", "DaggerX"))
        .Y = Val(Var_Get(s, "ANVILMENU", "DaggerY"))
        .Width = Val(Var_Get(s, "ANVILMENU", "DaggerWidth"))
        .Height = Val(Var_Get(s, "ANVILMENU", "DaggerHeight"))
    End With
    
    With GameWindow.AnvilMenu.Shield
        .X = Val(Var_Get(s, "ANVILMENU", "ShieldX"))
        .Y = Val(Var_Get(s, "ANVILMENU", "ShieldY"))
        .Width = Val(Var_Get(s, "ANVILMENU", "ShieldWidth"))
        .Height = Val(Var_Get(s, "ANVILMENU", "ShieldHeight"))
    End With
    
    With GameWindow.AnvilMenu.Armor
        .X = Val(Var_Get(s, "ANVILMENU", "ArmorX"))
        .Y = Val(Var_Get(s, "ANVILMENU", "ArmorY"))
        .Width = Val(Var_Get(s, "ANVILMENU", "ArmorWidth"))
        .Height = Val(Var_Get(s, "ANVILMENU", "ArmorHeight"))
    End With
    
    With GameWindow.AnvilMenu.Create
        .X = Val(Var_Get(s, "ANVILMENU", "CreateX"))
        .Y = Val(Var_Get(s, "ANVILMENU", "CreateY"))
        .Width = Val(Var_Get(s, "ANVILMENU", "CreateWidth"))
        .Height = Val(Var_Get(s, "ANVILMENU", "CreateHeight"))
    End With
    

Now go to Engine_Render_GUI_Window

After "Select Case WindowIndex" add this:

Code:

   
        Case FurnaceWindow
            With GameWindow.FurnaceMenu
                Engine_Render_Grh .SkinGrh, .Screen.X, .Screen.Y, 0, 1, True, GUIColorValue, GUIColorValue, GUIColorValue, GUIColorValue
                
                
                '---------- Added by Adam Britt; Detect if user clicks on "X" --------------
                If Engine_Collision_Rect(MousePos.X, MousePos.Y, 1, 1, .Screen.X + 136, .Screen.Y + 1, 12, 11) Then
                    If MouseLeftDown > 0 And Not LastClickedWindow = 0 Then
                        ShowGameWindow(LastClickedWindow) = 0
                        LastClickedWindow = 0
                        Exit Sub
                    End If
                End If
                
                '---------- Added by Adam Britt; Detect if user clicks on "Lock" --------------
                If Engine_Collision_Rect(MousePos.X, MousePos.Y, 1, 1, .Screen.X + 126, .Screen.Y + 1, 10, 12) Then
                    If MouseLeftDown > 0 And Not LastClickedWindow = 0 Then
                        GameWindow.FurnaceMenu.Locked = Not GameWindow.FurnaceMenu.Locked
                        Exit Sub
                    End If
                End If
            End With
            
        Case AnvilWindow
            With GameWindow.AnvilMenu
                Engine_Render_Grh .SkinGrh, .Screen.X, .Screen.Y, 0, 1, True, GUIColorValue, GUIColorValue, GUIColorValue, GUIColorValue
                
                Dim MetalSelect As Rectangle
                Dim ItemSelect As Rectangle
                Dim ItemRow As Integer
                Dim ItemCol As Integer
                
                MetalSelect.X = .Screen.X + 2
                MetalSelect.Y = .Screen.Y + 24 + ((.Metal - 1) * 40)
                
                ItemRow = Round((.Item / 6) + 0.5)
                ItemCol = .Item - ((ItemRow - 1) * 6)
                ItemSelect.X = .Screen.X + 44 + ((ItemCol - 1) * 42)
                ItemSelect.Y = .Screen.Y + 24 + ((ItemRow - 1) * 40)
                
                Engine_Render_Grh .SelectGrh, ItemSelect.X, ItemSelect.Y, 0, 1, True, GUIColorValue, GUIColorValue, GUIColorValue, GUIColorValue
                Engine_Render_Grh .SelectGrh, MetalSelect.X, MetalSelect.Y, 0, 1, True, GUIColorValue, GUIColorValue, GUIColorValue, GUIColorValue
                
                '---------- Added by Adam Britt; Detect if user clicks on "X" --------------
                If Engine_Collision_Rect(MousePos.X, MousePos.Y, 1, 1, .Screen.X + 284, .Screen.Y + 2, 12, 11) Then
                    If MouseLeftDown > 0 And Not LastClickedWindow = 0 Then
                        ShowGameWindow(LastClickedWindow) = 0
                        LastClickedWindow = 0
                        Exit Sub
                    End If
                End If
                
                '---------- Added by Adam Britt; Detect if user clicks on "Lock" --------------
                If Engine_Collision_Rect(MousePos.X, MousePos.Y, 1, 1, .Screen.X + 272, .Screen.Y + 2, 10, 12) Then
                    If MouseLeftDown > 0 And Not LastClickedWindow = 0 Then
                        GameWindow.AnvilMenu.Locked = Not GameWindow.AnvilMenu.Locked
                        Exit Sub
                    End If
                End If
            End With
        

Then go to "Engine_Render_Char" and in there find "If CharList(CharIndex).Moving Then". Now go to the "End If" of the If Statement. Above it add this:

Code:

    ElseIf CharList(CharIndex).ActionIndex > 1 Then
        CharList(CharIndex).Body.Attack(CharList(CharIndex).Heading).Started = 1

Almost forgot, go back to the Engine_Render_Screen and find this:

Code:

'Calculate the particle offset values
    'Do NOT move this any farther down in the module or you will get "jumps" as the left/top borders on particles
    ParticleOffsetX = (Engine_PixelPosX(ScreenMinX) - PixelOffsetX)
    ParticleOffsetY = (Engine_PixelPosY(ScreenMinY) - PixelOffsetY)

and above it add this:

Code:

AcceptEffects = True

Open TCP.bas

Find "Data_Server_EraseChar" and replace it with this:

Code:

Sub Data_Server_EraseChar(ByRef rBuf As DataBuffer)
'************************************************************
'Erase a character by the character index
'<CharIndex(I)>
'More info: http://www.vbgore.com/GameClient.TCP.Data_Server_EraseChar
'************************************************************
Dim MakeBlood As Byte
Dim CharIndex As Integer

    CharIndex = rBuf.Get_Integer
    MakeBlood = rBuf.Get_Byte
    
    'Check to make blood
    If MakeBlood <> 0 Then Effect_BloodSplatter_Begin Engine_TPtoSPX(CharList(CharIndex).Pos.X), Engine_TPtoSPY(CharList(CharIndex).Pos.Y), 20 + Rnd * 40
    
    'Erase the character
    Engine_Char_Erase CharIndex

End Sub

now add this new sub:

Code:

Sub Data_User_OpenJobMenu(ByRef rBuf As DataBuffer)
'************************************************************
'Open Job Menu
'************************************************************
Dim Job As Byte
    
    'Get Job Menu
    Job = rBuf.Get_Byte
    
    'Render Menu
    Select Case Job
        Case 1 'Furnace
            'show options for metal bars to smelt
            HideShowWindow (FurnaceWindow)
        Case 2 'Anvil
            'shwo options for items to smith
            GameWindow.AnvilMenu.Item = 1   'Set Default Selection
            GameWindow.AnvilMenu.Metal = 1  'Set Default Metal
            HideShowWindow (AnvilWindow)
    End Select
End Sub

Ok, more is still coming!

GoreMania · **Joined:** Wed Oct 08, 2008 8:09 am **Posts:** 148

Open Particles.bas

Find

Code:

'Constants With The Order Number For Each Effect

In that section of code are various constants that ID the various effects. In there add this:

Code:

Public Const EffectNum_BloodSpray As Byte = 13
Public Const EffectNum_BloodSplatter As Byte = 14

Find Effect_Render and replace it with this:

Code:

Public Sub Effect_Render(ByVal EffectIndex As Integer, Optional ByVal SetRenderStates As Boolean = True)
'*****************************************************************
'More info: http://www.vbgore.com/CommonCode.Particles.Effect_Render
'*****************************************************************
Dim Count As Long
Dim i As Long

    'Check if we have the device
    If D3DDevice.TestCooperativeLevel <> D3D_OK Then Exit Sub
    
    'Set the render state for the size of the particle
    D3DDevice.SetRenderState D3DRS_POINTSIZE, Effect(EffectIndex).FloatSize
    
    'Set the last texture to a random number to force the engine to reload the texture
    LastTexture = -65489

    'Check what type of rendering to do (blood or everything else)
    If Effect(EffectIndex).EffectNum = EffectNum_BloodSpray Or Effect(EffectIndex).EffectNum = EffectNum_BloodSplatter Then

        Count = Effect(EffectIndex).ParticleCount \ 4

        D3DDevice.SetTexture 0, ParticleTexture(13)
        D3DDevice.DrawPrimitiveUP D3DPT_POINTLIST, Count, Effect(EffectIndex).PartVertex(0), Len(Effect(EffectIndex).PartVertex(0))
        For i = 0 To Count - 1
            With Effect(EffectIndex).Particles(i)
                If .sngZ < 1 Then Effect(EffectIndex).PartVertex(i).Y = Effect(EffectIndex).PartVertex(i).Y + .sngZ
                Effect(EffectIndex).PartVertex(i).Color = D3DColorMake(.sngR, .sngG, .sngB, .sngA)
            End With
        Next i
        D3DDevice.DrawPrimitiveUP D3DPT_POINTLIST, Count, Effect(EffectIndex).PartVertex(0), Len(Effect(EffectIndex).PartVertex(0))

        D3DDevice.SetTexture 0, ParticleTexture(14)
        D3DDevice.DrawPrimitiveUP D3DPT_POINTLIST, Count, Effect(EffectIndex).PartVertex(Count - 1), Len(Effect(EffectIndex).PartVertex(0))
        For i = Count To Count - 1 + Count
            With Effect(EffectIndex).Particles(i)
                If .sngZ < 1 Then Effect(EffectIndex).PartVertex(i).Y = Effect(EffectIndex).PartVertex(i).Y + .sngZ
                Effect(EffectIndex).PartVertex(i).Color = D3DColorMake(.sngR, .sngG, .sngB, .sngA)
            End With
        Next i
        D3DDevice.DrawPrimitiveUP D3DPT_POINTLIST, Count, Effect(EffectIndex).PartVertex(Count - 1), Len(Effect(EffectIndex).PartVertex(0))

        D3DDevice.SetTexture 0, ParticleTexture(15)
        D3DDevice.DrawPrimitiveUP D3DPT_POINTLIST, Count, Effect(EffectIndex).PartVertex((Count * 2) - 1), Len(Effect(EffectIndex).PartVertex(0))
        For i = (Count * 2) To (Count * 2) - 1 + Count
            With Effect(EffectIndex).Particles(i)
                If .sngZ < 1 Then Effect(EffectIndex).PartVertex(i).Y = Effect(EffectIndex).PartVertex(i).Y + .sngZ
                Effect(EffectIndex).PartVertex(i).Color = D3DColorMake(.sngR, .sngG, .sngB, .sngA)
            End With
        Next i
        D3DDevice.DrawPrimitiveUP D3DPT_POINTLIST, Count, Effect(EffectIndex).PartVertex((Count * 2) - 1), Len(Effect(EffectIndex).PartVertex(0))

        D3DDevice.SetTexture 0, ParticleTexture(16)
        D3DDevice.DrawPrimitiveUP D3DPT_POINTLIST, Count, Effect(EffectIndex).PartVertex((Count * 3) - 1), Len(Effect(EffectIndex).PartVertex(0))
        For i = (Count * 3) To Effect(EffectIndex).ParticleCount
            With Effect(EffectIndex).Particles(i)
                If .sngZ < 1 Then Effect(EffectIndex).PartVertex(i).Y = Effect(EffectIndex).PartVertex(i).Y + .sngZ
                Effect(EffectIndex).PartVertex(i).Color = D3DColorMake(.sngR, .sngG, .sngB, .sngA)
            End With
        Next i
        D3DDevice.DrawPrimitiveUP D3DPT_POINTLIST, Count, Effect(EffectIndex).PartVertex((Count * 3) - 1), Len(Effect(EffectIndex).PartVertex(0))

    Else
    
        'Set the render state to point blitting
        If SetRenderStates Then D3DDevice.SetRenderState D3DRS_DESTBLEND, D3DBLEND_ONE

        'Set the texture
        D3DDevice.SetTexture 0, ParticleTexture(Effect(EffectIndex).Gfx)
    
        'Draw all the particles at once
        D3DDevice.DrawPrimitiveUP D3DPT_POINTLIST, Effect(EffectIndex).ParticleCount, Effect(EffectIndex).PartVertex(0), Len(Effect(EffectIndex).PartVertex(0))

        'Reset the render state back to normal
        If SetRenderStates Then D3DDevice.SetRenderState D3DRS_DESTBLEND, D3DBLEND_INVSRCALPHA

    End If
End Sub

Go to Effect_UpdateAll
Find

Code:

'Find out which effect is selected, then update it

That section of code decides with effect is to be rendered. In there add this:

Code:

            If Effect(LoopC).EffectNum = EffectNum_BloodSpray Then Effect_BloodSpray_Update LoopC
            If Effect(LoopC).EffectNum = EffectNum_BloodSplatter Then Effect_BloodSplatter_Update LoopC

Now add these new functions:

Code:

Function Effect_BloodSpray_Begin(ByVal X As Single, ByVal Y As Single, ByVal Particles As Integer, ByVal Direction As Single, Optional ByVal Intensity As Single = 1) As Integer
Dim EffectIndex As Integer
Dim LoopC As Long

    If Not AcceptEffects Then Exit Function

    'Get the next open effect slot
    EffectIndex = Effect_NextOpenSlot
    If EffectIndex = -1 Then Exit Function

    'Return the index of the used slot
    Effect_BloodSpray_Begin = EffectIndex

    'Set the effect's variables
    Effect(EffectIndex).EffectNum = EffectNum_BloodSpray  '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).Direction = Direction           'Direction
    Effect(EffectIndex).Modifier = Intensity

    '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(7)    '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_BloodSpray_Reset EffectIndex, LoopC
    Next LoopC

    'Set the initial time
    Effect(EffectIndex).PreviousFrame = timeGetTime

End Function

Private Sub Effect_BloodSpray_Reset(ByVal EffectIndex As Integer, ByVal Index As Long)

    'Reset the particle
    With Effect(EffectIndex)
        .Particles(Index).ResetIt .X + (Rnd * 16) - 8, .Y + (Rnd * 32) - 16, _
             Sin((.Direction - 10 + (Rnd * 20)) * DegreeToRadian) * (30 * .Modifier * Rnd), _
            -Cos((.Direction - 10 + (Rnd * 20)) * DegreeToRadian) * (30 * .Modifier * Rnd), 0, 0, -10, -2 - (Rnd * 30), 8 + Rnd * 4
        .Particles(Index).ResetColor 1, 1, 1, 0.8, 0
    End With
    
End Sub

Private Sub Effect_BloodSplatter_Reset(ByVal EffectIndex As Integer, ByVal Index As Long)
Dim Direction As Single

    'Find the direction
    Direction = Rnd * 360

    'Reset the particle
    Effect(EffectIndex).Particles(Index).ResetIt Effect(EffectIndex).X + (Rnd * 16) - 8, Effect(EffectIndex).Y + (Rnd * 32) - 16, _
         Sin(Direction * DegreeToRadian) * (24 * Rnd), _
        -Cos(Direction * DegreeToRadian) * (24 * Rnd), 0, 0, -25, -3 - (Rnd * 40), 10 + Rnd * 4
    Effect(EffectIndex).Particles(Index).ResetColor 1, 1, 1, 0.8, 0
    
End Sub

Private Sub Effect_BloodSpray_Update(ByVal EffectIndex As Integer)
Dim ElapsedTime As Single
Dim LoopC As Long
Dim TileX As Long
Dim TileY As Long

    'Calculate the time difference
    ElapsedTime = (timeGetTime - Effect(EffectIndex).PreviousFrame) * 0.01
    Effect(EffectIndex).PreviousFrame = timeGetTime

    'Go through the particle loop
    For LoopC = 0 To Effect(EffectIndex).ParticleCount
    
        With Effect(EffectIndex).Particles(LoopC)
    
            'Check if particle is in Use
            If .Used Then
    
                'Update the particle
                .UpdateParticle ElapsedTime
                
                'Don't pass any walls/etc
                TileX = Engine_SPtoTPX(.sngX)
                TileY = Engine_SPtoTPY(.sngY)
                If TileX < 1 Then
                    .sngZ = 1.1
                ElseIf TileY < 1 Then
                    .sngZ = 1.1
                ElseIf TileX > MapInfo.Width Then
                    .sngZ = 1.1
                ElseIf TileY > MapInfo.Height Then
                    .sngZ = 1.1
                End If
                If .sngZ <> 1.1 Then
                    If MapData(TileX, TileY).BlockedAttack Then
                        .sngZ = 1.1
                    End If
                End If
                
                'Blood trails
                If LoopC = 0 Or LoopC Mod 15 = 0 Then
                    If Int(Rnd * 3) = 0 Then
                        If Int(Rnd * 2) = 0 Then
                            Engine_Blood_Create .sngX + ParticleOffsetX, .sngY + ParticleOffsetY, 2
                        Else
                            Engine_Blood_Create .sngX + ParticleOffsetX, .sngY + ParticleOffsetY, 1
                        End If
                    End If
                End If
    
                'Check if to kill off the particle
                If .sngZ > 1 Then

                    'Disable the particle
                    .Used = False
    
                    'Subtract from the total particle count
                    Effect(EffectIndex).ParticlesLeft = Effect(EffectIndex).ParticlesLeft - 1
    
                    'Clear the color (dont leave behind any artifacts)
                    Effect(EffectIndex).Particles(LoopC).sngA = 0
                    
                    'Check if we lost all the particles
                    If Effect(EffectIndex).ParticlesLeft <= 0 Then Effect(EffectIndex).Used = False
                    
                    'Create the blood splatter
                    Engine_Blood_Create .sngX + ParticleOffsetX, .sngY + ParticleOffsetY, 0
    
                Else

                    'Set the particle information on the particle vertex
                    Effect(EffectIndex).PartVertex(LoopC).Color = 1258291200
                    Effect(EffectIndex).PartVertex(LoopC).X = .sngX
                    Effect(EffectIndex).PartVertex(LoopC).Y = .sngY
    
                End If
    
            End If
            
        End With

    Next LoopC

End Sub

Function Effect_BloodSplatter_Begin(ByVal X As Single, ByVal Y As Single, ByVal Particles As Integer) As Integer
Dim EffectIndex As Integer
Dim LoopC As Long

    If Not AcceptEffects Then Exit Function

    'Get the next open effect slot
    EffectIndex = Effect_NextOpenSlot
    If EffectIndex = -1 Then Exit Function

    'Return the index of the used slot
    Effect_BloodSplatter_Begin = EffectIndex

    'Set the effect's variables
    Effect(EffectIndex).EffectNum = EffectNum_BloodSplatter  '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

    '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(7)    '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_BloodSplatter_Reset EffectIndex, LoopC
    Next LoopC

    'Set the initial time
    Effect(EffectIndex).PreviousFrame = timeGetTime

End Function

Private Sub Effect_BloodSplatter_Update(ByVal EffectIndex As Integer)
Dim ElapsedTime As Single
Dim LoopC As Long
Dim TileX As Long
Dim TileY As Long

    'Calculate the time difference
    ElapsedTime = (timeGetTime - Effect(EffectIndex).PreviousFrame) * 0.01
    Effect(EffectIndex).PreviousFrame = timeGetTime

    'Go through the particle loop
    For LoopC = 0 To Effect(EffectIndex).ParticleCount
    
        With Effect(EffectIndex).Particles(LoopC)
    
            'Check if particle is in Use
            If .Used Then
    
                'Update the particle
                .UpdateParticle ElapsedTime
                
                'Don't pass any walls/etc
                TileX = Engine_SPtoTPX(.sngX)
                TileY = Engine_SPtoTPY(.sngY)
                If TileX < 1 Then
                    .sngZ = 1.1
                ElseIf TileY < 1 Then
                    .sngZ = 1.1
                ElseIf TileY > MapInfo.Width Then
                    .sngZ = 1.1
                ElseIf TileY > MapInfo.Height Then
                    .sngZ = 1.1
                End If
                If .sngZ <> 1.1 Then
                    If MapData(TileX, TileY).BlockedAttack Then
                        .sngZ = 1.1
                    End If
                End If
                
                'Blood trails
                If LoopC = 0 Or LoopC Mod 10 = 0 Then
                    If Int(Rnd * 3) = 0 Then
                        If Int(Rnd * 2) = 0 Then
                            Engine_Blood_Create .sngX + ParticleOffsetX, .sngY + ParticleOffsetY, 2
                        Else
                            Engine_Blood_Create .sngX + ParticleOffsetX, .sngY + ParticleOffsetY, 1
                        End If
                    End If
                End If
    
                'Check if to kill off the particle
                If .sngZ > 1 Then
                
                    'Disable the particle
                    .Used = False
    
                    'Subtract from the total particle count
                    Effect(EffectIndex).ParticlesLeft = Effect(EffectIndex).ParticlesLeft - 1
    
                    'Clear the color (dont leave behind any artifacts)
                    Effect(EffectIndex).Particles(LoopC).sngA = 0
                    
                    'Check if we lost all the particles
                    If Effect(EffectIndex).ParticlesLeft <= 0 Then Effect(EffectIndex).Used = False
                    
                    'Create the blood splatter
                    Engine_Blood_Create .sngX + ParticleOffsetX, .sngY + ParticleOffsetY, 0
    
                Else

                    'Set the particle information on the particle vertex
                    Effect(EffectIndex).PartVertex(LoopC).Color = 1258291200
                    Effect(EffectIndex).PartVertex(LoopC).X = .sngX
                    Effect(EffectIndex).PartVertex(LoopC).Y = .sngY
    
                End If
    
            End If
            
        End With

    Next LoopC

End Sub

More still coming! ...told you, lots and lots and lots of code... (at least u didn't have to figure it out yourself

)

GoreMania · **Joined:** Wed Oct 08, 2008 8:09 am **Posts:** 148

Go to Input.bas

Go to Input_Mouse_LeftClick_Window
Find "Select Case WindowIndex" and below it add this:

Code:

Case FurnaceWindow
            If ShowGameWindow(FurnaceWindow) Then
                With GameWindow.FurnaceMenu
                    If Engine_Collision_Rect(MousePos.X, MousePos.Y, 1, 1, .Screen.X, .Screen.Y, .Screen.Width, .Screen.Height) Then
                        Input_Mouse_LeftClick_Window = 1
                        LastClickedWindow = FurnaceWindow
                        SelGameWindow = FurnaceWindow
                    End If
                    
                    'Iron Bar
                    If Engine_Collision_Rect(MousePos.X, MousePos.Y, 1, 1, .Screen.X + .IronBar.X, .Screen.Y + .IronBar.Y, .IronBar.Width, .IronBar.Height) Then
                        sndBuf.Put_Byte DataCode.User_SmeltBar
                        sndBuf.Put_Byte 1 'Iron Bar
                        
                        HideShowWindow (FurnaceWindow)
                        Exit Function
                    End If
                End With
            End If
        Case AnvilWindow
            If ShowGameWindow(AnvilWindow) Then
                With GameWindow.AnvilMenu
                    If Engine_Collision_Rect(MousePos.X, MousePos.Y, 1, 1, .Screen.X, .Screen.Y, .Screen.Width, .Screen.Height) Then
                        Input_Mouse_LeftClick_Window = 1
                        LastClickedWindow = AnvilWindow
                        SelGameWindow = AnvilWindow
                    End If
                    
                    'Iron Bar
                    If Engine_Collision_Rect(MousePos.X, MousePos.Y, 1, 1, .Screen.X + .IronBar.X, .Screen.Y + .IronBar.Y, .IronBar.Width, .IronBar.Height) Then
                        .Metal = 1 'Iron
                        Exit Function
                    End If
                    
                    'Shuriken
                    If Engine_Collision_Rect(MousePos.X, MousePos.Y, 1, 1, .Screen.X + .Shuriken.X, .Screen.Y + .Shuriken.Y, .Shuriken.Width, .Shuriken.Height) Then
                        .Item = 1 'Shuriken
                        Exit Function
                    End If
                    
                    'Dagger
                    If Engine_Collision_Rect(MousePos.X, MousePos.Y, 1, 1, .Screen.X + .Dagger.X, .Screen.Y + .Dagger.Y, .Dagger.Width, .Dagger.Height) Then
                        .Item = 2 'Dagger
                        Exit Function
                    End If
                    
                    'Shield
                    If Engine_Collision_Rect(MousePos.X, MousePos.Y, 1, 1, .Screen.X + .Shield.X, .Screen.Y + .Shield.Y, .Shield.Width, .Shield.Height) Then
                        .Item = 3 'Shield
                        Exit Function
                    End If
                    
                    'Armor
                    If Engine_Collision_Rect(MousePos.X, MousePos.Y, 1, 1, .Screen.X + .Armor.X, .Screen.Y + .Armor.Y, .Armor.Width, .Armor.Height) Then
                        .Item = 4 'Armor
                        Exit Function
                    End If
                    
                    'Create
                    If Engine_Collision_Rect(MousePos.X, MousePos.Y, 1, 1, .Screen.X + .Create.X, .Screen.Y + .Create.Y, .Create.Width, .Create.Height) Then
                        sndBuf.Put_Byte DataCode.User_SmithItem
                        
                        If .Item > 0 And .Metal > 0 Then
                            sndBuf.Put_Byte .Item
                            sndBuf.Put_Byte .Metal
                        End If
                        
                        HideShowWindow (AnvilWindow)
                        Exit Function
                    End If
                End With
            End If

Go to Input_Mouse_Move
Go to Select Case SelGameWindow
below it add this:

Code:

                ' Move Anvil Window
            Case AnvilWindow
                If Not GameWindow.AnvilMenu.Locked Then
                    With GameWindow.AnvilMenu.Screen
                        .X = .X + MousePosAdd.X
                        .Y = .Y + MousePosAdd.Y
                        If WindowsInScreen Then
                            If .X < 0 Then .X = 0
                            If .Y < 0 Then .Y = 0
                            If .X > ScreenWidth - .Width Then .X = ScreenWidth - .Width
                            If .Y > ScreenHeight - .Height Then .Y = ScreenHeight - .Height
                        End If
                    End With
                End If
                
                ' Move Furnace Window
            Case FurnaceWindow
                If Not GameWindow.FurnaceMenu.Locked Then
                    With GameWindow.FurnaceMenu.Screen
                        .X = .X + MousePosAdd.X
                        .Y = .Y + MousePosAdd.Y
                        If WindowsInScreen Then
                            If .X < 0 Then .X = 0
                            If .Y < 0 Then .Y = 0
                            If .X > ScreenWidth - .Width Then .X = ScreenWidth - .Width
                            If .Y > ScreenHeight - .Height Then .Y = ScreenHeight - .Height
                        End If
                    End With
                End If

Go to General.bas

Go to Game_Map_Switch
Find

Code:

'Erase particle effects
        LastEffect = 0
        ReDim Effect(1 To NumEffects)

and below it add this:

Code:

        'Erase blood
        LastBlood = 0
        Erase BloodList

Add this new function:

Code:

Public Function Game_BloodCount() As Integer

'*****************************************************************
'Return how much blood to use
'*****************************************************************

    Game_BloodCount = 5 + Rnd * 30

End Function

Open Declares.bas

Add this to it:

Code:

'Prevents us getting effects (namely blood splatters) before the map even loads, which will set them in the wrong place
Public AcceptEffects As Boolean

Open DataIDs.bas

Go to "Public Type DataCode"

Add this to it:

Code:

    
    User_OpenJobMenu As Byte
    User_SmeltBar As Byte
    User_SmithItem As Byte

Then go to InitDataCommands
In there add this:

Code:

        .User_OpenJobMenu = 142     ' Open Job Menu
        .User_SmeltBar = 143        ' Smelt Metal Bar
        .User_SmithItem = 144       ' Smith Item Out of Metal Bar

Go to frmMain.frm code
Go to OnDataArrival
Add this to it:

Code:

Case .User_OpenJobMenu: Data_User_OpenJobMenu rBuf

Oh! Almost forgot (See what I mean?) go to TCP.bas again
Go to Data_Server_Message and add this to it:

Code:

Case 156
            Int1 = rBuf.Get_Integer
            Str1 = rBuf.Get_String
            TempStr = Replace$(Message(156), "<Amount>", Int1)
            Engine_AddToChatTextBuffer Replace$(TempStr, "<Item>", Str1), FontColor_Info
        Case 157
            Str1 = rBuf.Get_String
            Engine_AddToChatTextBuffer Replace$(Message(157), "<Item>", Str1), FontColor_Info
        Case 158
            Int1 = rBuf.Get_Integer
            Str1 = rBuf.Get_String
            Str2 = rBuf.Get_String
            TempStr = Replace$(Message(158), "<Level>", Int1)
            TempStr = Replace$(TempStr, "<Skill>", Str1)
            Engine_AddToChatTextBuffer Replace$(TempStr, "<Item>", Str2), FontColor_Info

Now download the messages I attached to this post

GoreMania · **Joined:** Wed Oct 08, 2008 8:09 am **Posts:** 148

-------- SERVER -------

Go to frmMain.frm code

Go to OnDataArrival

Add this to it:

Code:

            
            Case .User_SmeltBar: Data_User_SmeltBar rBuf, Index
            Case .User_SmithItem: Data_User_SmithItem rBuf, Index

Go to Decalres.bas and add this:

Code:

'*************************************************************************
'                       Metal Bars For Blacksmithing
'*************************************************************************
'Add Up to 7 total Metal bars (and update array range when u do)
Public Const TOTAL_METALS As Byte = 1
Public MetalBars(1 To TOTAL_METALS) As Metals
    
Type Metals
    Name As String  'Name of metal
    Lvl As Integer  'Lvl of blacksmith needed to make this
    Ore As Integer  'ID of item object in database required to make this
    Bar As Integer  'ID of This Bar Item In Database
    XP As Integer   'Xp received for making this bar (added to Blacksmith Skill)
End Type
'*************************************************************************


'*************************************************************************
'                   Smithable Items for Blacksmithing
'*************************************************************************
'Add Up to 42 Smithable Items and update array range as u do
Public SmithableItems(1 To 4) As SmithItems

    
Type SmithItems
    Name As String      'Name of item
    Lvl As Integer      'Lvl of blacksmith to make item (This is multiplied onto Metal Bar's Lvl Req)
    ItemID(1 To TOTAL_METALS) As Integer   'ID (from database) of item to make (index by metal bar array element)
    BarsReq As Integer  'Amount of bars required to make item
    XP As Integer       'XP received for making item
End Type
'*************************************************************************

Create a new module called "JobSkills" and save it to the server directory (that holds the other server .bas files)

Add this code to that bas file

Code:

Option Explicit

Public Sub Init_MetalBars()
    MetalBars(1).Name = "Iron"
    MetalBars(1).Lvl = 1
    MetalBars(1).Ore = 13
    MetalBars(1).Bar = 14
    MetalBars(1).XP = 1
End Sub

Public Sub Init_SmithableItems()
    SmithableItems(1).Name = "Shuriken"
    SmithableItems(1).Lvl = 1
    SmithableItems(1).ItemID(1) = 8
    SmithableItems(1).BarsReq = 1
    SmithableItems(1).XP = 1
    
    SmithableItems(2).Name = "Dagger"
    SmithableItems(2).Lvl = 1
    SmithableItems(2).ItemID(1) = 6
    SmithableItems(2).BarsReq = 1
    SmithableItems(2).XP = 2
    
    SmithableItems(3).Name = "Shield"
    SmithableItems(3).Lvl = 3
    SmithableItems(3).ItemID(1) = 11
    SmithableItems(3).BarsReq = 3
    SmithableItems(3).XP = 3
    
    SmithableItems(4).Name = "Armor"
    SmithableItems(4).Lvl = 5
    SmithableItems(4).ItemID(1) = 5
    SmithableItems(4).BarsReq = 5
    SmithableItems(4).XP = 5
End Sub

Go to NPCs.bas

Find NPC_EraseChar and replace it with this:

Code:

Sub NPC_EraseChar(ByVal NPCIndex As Integer, ByVal MakeBlood As Byte)
'*****************************************************************
'Erase a NPC character off the map (keeps them in memory still)
'More info: http://www.vbgore.com/GameServer.NPCs.NPC_EraseChar
'*****************************************************************

    Log "Call NPC_EraseChar(" & NPCIndex & ")", CodeTracker '//\\LOGLINE//\\

    'Remove from list
    CharList(NPCList(NPCIndex).Char.CharIndex).Index = 0
    CharList(NPCList(NPCIndex).Char.CharIndex).CharType = 0
    
    'Remove from map
    MapInfo(NPCList(NPCIndex).Pos.Map).Data(NPCList(NPCIndex).Pos.X, NPCList(NPCIndex).Pos.Y).NPCIndex = 0

    'Send erase command to clients
    ConBuf.PreAllocate 3
    ConBuf.Put_Byte DataCode.Server_EraseChar
    ConBuf.Put_Integer NPCList(NPCIndex).Char.CharIndex
    ConBuf.Put_Byte MakeBlood
    Data_Send ToMap, 0, ConBuf.Get_Buffer, NPCList(NPCIndex).Pos.Map

    'Clear the variables
    NPCList(NPCIndex).Char.CharIndex = 0
    NPCList(NPCIndex).Flags.NPCAlive = 0

    'Set at the respawn spot
    NPCList(NPCIndex).Pos.Map = NPCList(NPCIndex).StartPos.Map
    NPCList(NPCIndex).Pos.X = NPCList(NPCIndex).StartPos.X
    NPCList(NPCIndex).Pos.Y = NPCList(NPCIndex).StartPos.Y

End Sub

go to SpawnNewNPC (which is from one of my other tutorials) and find

Code:

    If (AI = 9) Then 'Furniture Char Type
        CharList(CharIndex).CharType = ClientCharType_Furniture
    Else 'NPC char Type
        CharList(CharIndex).CharType = CharType_NPC
    End If

and change it to this:

Code:

    If (AI = 9) Then 'Furniture Char Type
        CharList(CharIndex).CharType = ClientCharType_Furniture
    ElseIf (AI = 10) Then 'Job NPC
        CharList(CharIndex).CharType = ClientCharType_Job
    Else 'NPC char Type
        CharList(CharIndex).CharType = CharType_NPC
    End If

Add this new sub:

Code:

Sub NPC_JobClick(ByVal UserIndex As Integer, ByVal NPCIndex As Integer)
'*****************************************************************
'Open Job Menu
'*****************************************************************
    
    'Send Property Info To User
    ConBuf.Put_Byte DataCode.User_OpenJobMenu
    ConBuf.Put_Byte NPCList(NPCIndex).Job
    Data_Send ToIndex, UserIndex, ConBuf.Get_Buffer
End Sub

Go to NPC_MakeChar

Find

Code:

If NPCList(NPCIndex).AI = 9 Then
                    Flags = Flags Or 8192
                    .CharType = ClientCharType_Furniture
                    PacketSize = PacketSize + 1
                ElseIf ClientCharType_NPC <> .CharType Then
                    Flags = Flags Or 8192
                    .CharType = ClientCharType_NPC
                    PacketSize = PacketSize + 1
                End If

again, this will be different if you dont have my other tutorials!

and replace with

Code:

If NPCList(NPCIndex).AI = 9 Then
                    Flags = Flags Or 8192
                    .CharType = ClientCharType_Furniture
                    PacketSize = PacketSize + 1
                ElseIf NPCList(NPCIndex).AI = 10 Then
                    Flags = Flags Or 8192
                    .CharType = ClientCharType_Job
                    PacketSize = PacketSize + 1
                ElseIf ClientCharType_NPC <> .CharType Then
                    Flags = Flags Or 8192
                    .CharType = ClientCharType_NPC
                    PacketSize = PacketSize + 1
                End If

then find

Code:

If Flags And 8192 Then
                If NPCList(NPCIndex).AI = 9 Then
                    ConBuf.Put_Byte ClientCharType_Furniture
                Else
                    ConBuf.Put_Byte ClientCharType_NPC
                End If
            End If

and replace with

Code:

If Flags And 8192 Then
                If NPCList(NPCIndex).AI = 9 Then
                    ConBuf.Put_Byte ClientCharType_Furniture
                ElseIf NPCList(NPCIndex).AI = 10 Then
                    ConBuf.Put_Byte ClientCharType_Job
                Else
                    ConBuf.Put_Byte ClientCharType_NPC
                End If
            End If

Then find this:

Code:

If NPCList(NPCIndex).AI = 9 Then
                ConBuf.Put_Byte ClientCharType_Furniture
            Else
                ConBuf.Put_Byte ClientCharType_NPC
            End If

and replace with this:

Code:

If NPCList(NPCIndex).AI = 9 Then
                ConBuf.Put_Byte ClientCharType_Furniture
            ElseIf NPCList(NPCIndex).AI = 10 Then
                ConBuf.Put_Byte ClientCharType_Job
            Else
                ConBuf.Put_Byte ClientCharType_NPC
            End If

Again, almost forgot something!
Go back to Declares.bas

Find "Type NPC" and add this:

Code:

Job As Byte 'Job Menu to use (if AI = 10; Job NPC)

then find "'Client character types" and add this under there

Code:

Public Const ClientCharType_Job As Byte = 6

Now go back to you client script, because I forgot to mention this...
go to declares.bas

Go to

Code:

'Client character types

and add this under it

Code:

Public Const ClientCharType_Job As Byte = 6

then go back to TileEngine.bas

Go to Engine_Render_Char

Find

Code:

If Not CharList(CharIndex).CharType = ClientCharType_FurnitureThen

(from my housing tutorial)

and change to this:

Code:

If Not CharList(CharIndex).CharType = ClientCharType_Furniture And Not CharList(CharIndex).CharType = ClientCharType_Job Then

Ok, back to the server...

Go to FileIO.bas

Go to Save_NPCs_Temp

Find "With NPCList(1)" and add this to that section:

Code:

.Job = Val(DB_RS!Job)

Still more to come! Working on next post!

GoreMania · **Joined:** Wed Oct 08, 2008 8:09 am **Posts:** 148

Go to DataIDs.bas

Go to "Public Type StatOrder"
add to that section this:

Code:

    MinBlacksmith As Byte
    MaxBlacksmith As Byte

go to InitDataCommands
Find "With SID"
add to that section this:

Code:

        .MinBlacksmith = 19
        .MaxBlacksmith = 20

Open TCP.bas

add this to it:

Code:

Sub Data_User_SmeltBar(ByVal rBuf As DataBuffer, ByVal UserIndex As Integer)
'*****************************************************************
'Smelt Ore Into Bar
'*****************************************************************
Dim LoopC As Long
Dim Found As Boolean
Dim Amount As Integer
Dim Metal As Byte
Dim Ore As Integer
Dim Bar As Integer
    
    'Get metal to smelt
    Metal = rBuf.Get_Byte
    
    
    'Check if user has required blacksmith level
    If UserList(UserIndex).Stats.BaseStat(SID.MaxBlacksmith) >= MetalBars(Metal).Lvl Then
        'Get Ore used in smelting process
        Ore = MetalBars(Metal).Ore
        
        'Get Resultant Bar Item
        Bar = MetalBars(Metal).Bar
        
        'Replace All Ore with Bar
        For LoopC = 1 To MAX_INVENTORY_SLOTS
            If UserList(UserIndex).Object(LoopC).ObjIndex = Ore Then
                'Set Flag for Ore being found
                Found = True
                
                'Add to Amount of Bars made to counter
                Amount = Amount + UserList(UserIndex).Object(LoopC).Amount
                
                'Change Ore Into Bars
                UserList(UserIndex).Object(LoopC).ObjIndex = Bar
                
                'Update this slot
                User_UpdateInv False, UserIndex, LoopC
                
                'Give User XP to Blacksmith Skill
                UserList(UserIndex).Stats.BaseStat(SID.MinBlacksmith) = UserList(UserIndex).Stats.BaseStat(SID.MinBlacksmith) + MetalBars(Metal).XP
                UserList(UserIndex).Stats.BaseStat(SID.MaxBlacksmith) = UserList(UserIndex).Stats.BaseStat(SID.MaxBlacksmith) + MetalBars(Metal).XP
            End If
        Next LoopC
        
        If Found Then
            'MESSAGE USER THAT THEY MADE X BARS
            ConBuf.PreAllocate 3
            ConBuf.Put_Byte DataCode.Server_Message
            ConBuf.Put_Byte 156
            ConBuf.Put_Integer Amount
            ConBuf.Put_String MetalBars(Metal).Name & " bars"
            Data_Send ToIndex, UserIndex, ConBuf.Get_Buffer
            Data_Send_Buffer UserIndex
        Else
            'MESSAGE USER THAT THEY DO NOT HAVE REQUIRED ORE
            ConBuf.PreAllocate 3
            ConBuf.Put_Byte DataCode.Server_Message
            ConBuf.Put_Byte 157
            ConBuf.Put_String MetalBars(Metal).Name & " ore"
            Data_Send ToIndex, UserIndex, ConBuf.Get_Buffer
            Data_Send_Buffer UserIndex
        End If
    Else
        'MESSAGE USER THEIR SMITHING LVL IS NOT HIGH ENOUGH
         ConBuf.PreAllocate 3
        ConBuf.Put_Byte DataCode.Server_Message
        ConBuf.Put_Byte 158
        ConBuf.Put_Integer MetalBars(Metal).Lvl
        ConBuf.Put_Integer "Blacksmith"
        ConBuf.Put_String MetalBars(Metal).Name & " bar"
        Data_Send ToIndex, UserIndex, ConBuf.Get_Buffer
        Data_Send_Buffer UserIndex
    End If
End Sub


Sub Data_User_SmithItem(ByRef rBuf As DataBuffer, ByVal UserIndex As Integer)
'*****************************************************************
'Smith Bar into Item
'*****************************************************************
Dim Metal As Integer
Dim Item As Integer
Dim Bar As Integer
Dim FreeSlots As Byte
Dim LoopC As Long
Dim Amount As Integer
    
    'Get Item to Make
    Item = rBuf.Get_Byte
    
    'Get metal bar to use
    Metal = rBuf.Get_Byte
    Bar = MetalBars(Metal).Bar
    
    'Check if user has required blacksmith level
    If UserList(UserIndex).Stats.BaseStat(SID.MaxBlacksmith) >= SmithableItems(Item).Lvl * MetalBars(Metal).Lvl Then
        'Remove Bars and add Item
        For LoopC = 1 To MAX_INVENTORY_SLOTS
            If UserList(UserIndex).Object(LoopC).ObjIndex = Bar Then
                'Check if there are enough bars
                If UserList(UserIndex).Object(LoopC).Amount >= SmithableItems(Item).BarsReq Then
                    'Check that user has free inv space
                    FreeSlots = User_NumFreeInvSlots(UserIndex)
                    
                    If (FreeSlots > 0) Then
                        'Remove Bars from Inventory
                        User_RemoveObj UserIndex, LoopC, SmithableItems(Item).BarsReq
                        
                        'Add Item to Inventory
                        User_GiveObj UserIndex, SmithableItems(Item).ItemID(Metal), 1
                        
                        'Give User XP to Blacksmith Skill
                        UserList(UserIndex).Stats.BaseStat(SID.MinBlacksmith) = UserList(UserIndex).Stats.BaseStat(SID.MinBlacksmith) + SmithableItems(Item).XP
                        UserList(UserIndex).Stats.BaseStat(SID.MaxBlacksmith) = UserList(UserIndex).Stats.BaseStat(SID.MaxBlacksmith) + SmithableItems(Item).XP
                        
                        'MESSAGE USER THAT THEY MADE X Item
                        ConBuf.PreAllocate 3
                        ConBuf.Put_Byte DataCode.Server_Message
                        ConBuf.Put_Byte 156
                        ConBuf.Put_Integer 1 'Amount
                        ConBuf.Put_String MetalBars(Metal).Name & " " & SmithableItems(Item).Name
                        Data_Send ToIndex, UserIndex, ConBuf.Get_Buffer
                        Data_Send_Buffer UserIndex
                    Else
                        'MESSAGE USER THAT THEY DON'T HAVE ENOUGH FREE INV SPACE
                        Data_Send ToIndex, UserIndex, cMessage(26).Data
                    End If
                Else
                    'MESSAGE USER THAT THEY DO NOT HAVE REQUIRED Bars
                    ConBuf.PreAllocate 3
                    ConBuf.Put_Byte DataCode.Server_Message
                    ConBuf.Put_Byte 157
                    ConBuf.Put_String MetalBars(Metal).Name & " bars"
                    Data_Send ToIndex, UserIndex, ConBuf.Get_Buffer
                    Data_Send_Buffer UserIndex
                End If
                
                Exit For
            End If
        Next LoopC
    Else
        'MESSAGE USER THAT THEIR SMITHING LVL IS NOT HIGH ENOUGH
        ConBuf.PreAllocate 3
        ConBuf.Put_Byte DataCode.Server_Message
        ConBuf.Put_Byte 158
        ConBuf.Put_Integer MetalBars(Metal).Lvl * SmithableItems(Item).Lvl
        ConBuf.Put_Integer "Blacksmith"
        ConBuf.Put_String MetalBars(Metal).Name & " " & SmithableItems(Item).Name
        Data_Send ToIndex, UserIndex, ConBuf.Get_Buffer
        Data_Send_Buffer UserIndex
    End If
End Sub

Go to Users.bas

Find "User_EraseChar" and replace with this:

Code:

Public Sub User_EraseChar(ByVal UserIndex As Integer, ByVal MakeBlood As Byte)
'*****************************************************************
'Erase a character
'More info: http://www.vbgore.com/GameServer.Users.User_EraseChar
'*****************************************************************

    Log "Call User_EraseChar(" & UserIndex & ")", CodeTracker '//\\LOGLINE//\\

    On Error GoTo ErrOut
    If UserList(UserIndex).Pos.Map <= 0 Then
        Log "User_EraseChar: Map <= 0 - aborting", CodeTracker '//\\LOGLINE//\\
        Exit Sub
    End If
    If UserList(UserIndex).Pos.Map > NumMaps Then
        Log "User_EraseChar: Map > NumMaps - aborting", CodeTracker '//\\LOGLINE//\\
        Exit Sub
    End If
    On Error GoTo 0
    
    'Confirm that the map is even loaded (if not, theres obviously no users on it)
    If MapInfo(UserList(UserIndex).Pos.Map).DataLoaded = 0 Then Exit Sub
    
    'Send erase command to clients
    ConBuf.PreAllocate 3
    ConBuf.Put_Byte DataCode.Server_EraseChar
    ConBuf.Put_Integer UserList(UserIndex).Char.CharIndex
    ConBuf.Put_Byte MakeBlood
    Data_Send ToMap, UserIndex, ConBuf.Get_Buffer, UserList(UserIndex).Pos.Map
    
    'Remove from list
    CharList(UserList(UserIndex).Char.CharIndex).Index = 0
    CharList(UserList(UserIndex).Char.CharIndex).CharType = 0
    
    'Update userlist
    UserList(UserIndex).Char.CharIndex = 0
    
    If UserList(UserIndex).Pos.X < 1 Then
        Log "User_EraseChar: User X < 1 - aborting", CodeTracker '//\\LOGLINE//\\
        Exit Sub
    End If
    If UserList(UserIndex).Pos.X > MapInfo(UserList(UserIndex).Pos.Map).Width Then
        Log "User_EraseChar: User X > XMaxMapSize - aborting", CodeTracker '//\\LOGLINE//\\
        Exit Sub
    End If
    If UserList(UserIndex).Pos.Y < 1 Then
        Log "User_EraseChar: User Y < 1 - aborting", CodeTracker '//\\LOGLINE//\\
        Exit Sub
    End If
    If UserList(UserIndex).Pos.Y > MapInfo(UserList(UserIndex).Pos.Map).Height Then
        Log "User_EraseChar: User Y > YMaxMapSize - aborting", CodeTracker '//\\LOGLINE//\\
        Exit Sub
    End If

    'Remove from map
    MapInfo(UserList(UserIndex).Pos.Map).Data(UserList(UserIndex).Pos.X, UserList(UserIndex).Pos.Y).UserIndex = 0
    
    Exit Sub '//\\LOGLINE//\\
    
ErrOut:

    Log "User_EraseChar: Unexpected error in User_EraseChar - GoTo ErrOut called!", CriticalError '//\\LOGLINE//\\

End Sub

That's it! I hope... Soon to come will be the features to right click on the job menu and get more info about what u are making, and the addition of your job skills to the stat menu.

HeavenTorn · **Posted:** Thu Nov 20, 2008 6:27 pm

I love this 2 for 1 deal you always do, jobs and blood!

Great tutorial btw! With all these tutorials you've put out and the ones by Tharsten and DarkSummon, should hope to see some more games being made.

Once again, thanks!

GoreMania · **Joined:** Wed Oct 08, 2008 8:09 am **Posts:** 148

Always enjoy to see my tuts appreciated. Btw, I need just 2 plant monsters for the other 2 job examples I have planned. Any sprite donations help!

GoreMania · **Joined:** Wed Oct 08, 2008 8:09 am **Posts:** 148

Ok, managed to throw together the feature that lets you right click an item in the job menu to get more info.

First, go to client

Go to TileEngine.bas

Go to Engine_SetItemDesc and replace it with this:

Code:

Public Sub Engine_SetItemDesc(ByVal Name As String, Optional ByVal Amount As Integer = 0, Optional ByVal Value As Long = 0, Optional ByVal ExtraInfo As String = "")
'*****************************************************************
'Set item description values
'More info: http://www.vbgore.com/GameClient.TileEngine.Engine_SetItemDesc
'*****************************************************************
Dim i As Byte
Dim X As Long

    'Set the item values
    ItemDescLine(1) = Name
    ItemDescLines = 1
    If Amount <> 0 Then
        ItemDescLines = ItemDescLines + 1
        ItemDescLine(ItemDescLines) = "Amount: " & Amount
    End If
    If Value <> 0 Then
        ItemDescLines = ItemDescLines + 1
        ItemDescLine(ItemDescLines) = "Value: " & Value
    End If
    If ExtraInfo <> "" Then
        Dim Info() As String
        
        Info = Split(ExtraInfo, Chr(13))
        
        For i = 0 To UBound(Info)
            ItemDescLines = ItemDescLines + 1
            ItemDescLine(ItemDescLines) = Info(i)
        Next i
    End If

    'Get the largest size
    ItemDescWidth = Engine_GetTextWidth(Font_Default, ItemDescLine(1))
    If ItemDescLines > 1 Then
        For i = 2 To ItemDescLines
            X = Engine_GetTextWidth(Font_Default, ItemDescLine(i))
            If X > ItemDescWidth Then ItemDescWidth = X
        Next i
    End If

End Sub

then go to Input.bas

Go to Input_Mouse_RightClick_Window

Find "Select Case WindowIndex"

add this into that section:

Code:

Case AnvilWindow
            If ShowGameWindow(AnvilWindow) Then
                With GameWindow.AnvilMenu
                    If Engine_Collision_Rect(MousePos.X, MousePos.Y, 1, 1, .Screen.X, .Screen.Y, .Screen.Width, .Screen.Height) Then
                        Input_Mouse_RightClick_Window = 1
                        LastClickedWindow = QuickBarWindow
                    End If
                    
                    'SYNCHRONIZE THE JobSkills.bas FILE OF THE SERVER WITH THESE DESCRIPTIONS
                    Dim BlackSmithLvl As Integer
                    
                    Select Case .Metal
                        Case 1 'IRON
                            BlackSmithLvl = 1
                    End Select
                                        
                    'Shuriken
                    If Engine_Collision_Rect(MousePos.X, MousePos.Y, 1, 1, .Screen.X + .Shuriken.X, .Screen.Y + .Shuriken.Y, .Shuriken.Width, .Shuriken.Height) Then
                        Engine_SetItemDesc "Requires:", , , "* level " & BlackSmithLvl & " blackmithing" & Chr(13) & "* 1 Metal Bar"
                        
                    'Dagger
                    ElseIf Engine_Collision_Rect(MousePos.X, MousePos.Y, 1, 1, .Screen.X + .Dagger.X, .Screen.Y + .Dagger.Y, .Dagger.Width, .Dagger.Height) Then
                        Engine_SetItemDesc "Requires:", , , "* level " & BlackSmithLvl & " blackmithing" & Chr(13) & "* 1 Metal Bar"
                    
                    'Shield
                    ElseIf Engine_Collision_Rect(MousePos.X, MousePos.Y, 1, 1, .Screen.X + .Shield.X, .Screen.Y + .Shield.Y, .Shield.Width, .Shield.Height) Then
                        BlackSmithLvl = BlackSmithLvl * 3
                        Engine_SetItemDesc "Requires:", , , "* level " & BlackSmithLvl & " blackmithing" & Chr(13) & "* 3 Metal Bars"
                    
                    'Armor
                    ElseIf Engine_Collision_Rect(MousePos.X, MousePos.Y, 1, 1, .Screen.X + .Armor.X, .Screen.Y + .Armor.Y, .Armor.Width, .Armor.Height) Then
                        BlackSmithLvl = BlackSmithLvl * 5
                        Engine_SetItemDesc "Requires:", , , "* level " & BlackSmithLvl & " blackmithing" & Chr(13) & "* 5 Metal Bars"
                    End If
                End With
            End If

Now when u right click items on the blacksmith menu, you can see what level and how many metal bars are required

I'll try to have the stat menu mod tomorrow. When I do, I'll post the next version of vbGOREmania! whoot!

GoreMania · **Joined:** Wed Oct 08, 2008 8:09 am **Posts:** 148

Whoa! almost forgot! The database mods! :lol:

Ok open your DB.

Go to npcs table and open to add records
1)
* id: 10
* name: Golem (25)
* Descr: A menacing creature of rock
* ai: 3
* respawnwait: 10000
* attackable: 1
* attackgrh: 26
* attacksfx: 1
* hostile: 1
* drops: 13 1 100
* give_exp: 50
* give_gold: 50
* char_hair: 0
* char_head: 0
* char_body: 4
* stat_hit_min: 20
* stat_hit_max: 65
* stat_hp: 70
* stat_mp: 2
* stat_sp: 2
2) Blast Furnace
* id: 11
* name: Blast Furnace
* descr: A blacksmith's furnace used to melt metal
* ai: 10
* job: 1
* char_hair: 4
* char_head:0
* char_body:0
3) Anvil
* id: 12
* name: Anvil
* descr: A tool on which blacksmiths shape metal
* ai: 10
* job: 2
* char_hair: 5
* char_head:0
* char_body:0

save and close DB

go to the data directory
go to Body.dat
add this:

Code:

'Golem (creature sprite)
[4]
1=338
2=337
3=336
4=339
5=338
6=337
7=336
8=339
a1=342
a2=341
a3=340
a4=343
a5=342
a6=341
a7=340
a8=343
r1=1
r2=1
r3=1
r4=1
r5=1
r6=1
r7=1
r8=1
HeadOffsetY=0
HeadOffsetX=0
DamageSprite=3

the r# are for my mount system, in case you don't have that

might want to make a note in here:
'For Bodies that represent creatures, and thus can't have a mount or head/weapon sprites, use r#=1 and HeadOffset=0

Open Hair.dat and add this:

Code:

'Blast Furnace
[4] 
1=301
2=303
3=300
4=302
5=301 
6=303
7=300
8=302

'Anvil
[5] 
1=307
2=306
3=305
4=304
5=307
6=306
7=305
8=304

HeavenTorn · **Posted:** Thu Nov 20, 2008 7:43 pm

GoreMania wrote:

Always enjoy to see my tuts appreciated. Btw, I need just 2 plant monsters for the other 2 job examples I have planned. Any sprite donations help!

Did you want anything specific, or will any plant monster due? 'Cause I have some of the breeze sprites and it has a plant monster.

DarkSummon · **Posted:** Fri Nov 21, 2008 1:15 am

Just by a quick glance over the code, i have just one thing to say...awesome work gore! woah you are very dedicated and im loving it ^^

GoreMania · **Joined:** Wed Oct 08, 2008 8:09 am **Posts:** 148

Thanks all! Yeah, any plant monster sprite will do. I'll mod if need be. It'll just help me to get these other two job tuts out faster

Credit will go to those who help

Tharsten · **Joined:** Thu Jul 24, 2008 12:44 pm **Posts:** 132

great tut again GoreMania!

vbGore Free Online RPG Engine

Getting the Bloody Job Done