[EVB, EO2.x] Crafting System (RecipeBook)

[Justn]

Hello guys! This tutorial is one I added on IndieRising so I thought I would share it here as well. It is Dx7 but im sure you guys could use in dx8 by switching a few things. In this tutorial we are adding a brand new crafting system that is sure to be alot better than the previous one. The last edition used recipes to make items which in return caused you to have banks and inventory full of recipes everytime you wanted to make an item. With this system the recipes you have learned are saved and can later be used in a graphical recipe book whenever you like.

It was originally made for EVB but should work on a dx7 EO if you change the timegettime's

**New Features?**

**New Recipe Editor**
With this new editor you can edit every aspect of your recipes as you can see there are some new additions.

**Crafting Timer Bar**
Now you can select how long or how little time it will take to make an item.

**More Complex Recipes**
Also you can choose how many of one item is needed in a recipe and also how much of the item you are able to make. This can be used to make more in-depth recipes.

**Easy to add Professions**
In the old system adding new professions was a pain but with this new system changing a constant and adding a few names to list will get you all new job levels that run off of one sub unlike before where you needed to copy the code for each one.

**Better Crafting tiles**
Crafting tiles are now solid objects and are easy to link to your current professions.

**Custom Skill Leveling**
Now you can balance things out better by being able to select how much xp a recipe gives in a profession

And also all of the features of the last edition!

**The Tutorial**
First download the rar file below. Then put the server modCrafting file in your server src folder. Then add it to your project within vb6.

Next do the same with the client modCrafting and then add the Recipe Editor to your project as well.
**[DOWNLOAD CRAFTING FILES](https://www.dropbox.com/s/lb5c5see45oxej7/CraftingMod.rar)**

**Server**

**modConstants**

Add these two lines to there respective spots:
```
Public Const ITEM_TYPE_RECIPE As Byte = 14
``````
Public Const EDITOR_RECIPE As Byte = 9
``````
Public Const TILE_TYPE_CRAFT As Byte = 15
```Be sure to change the numbers to the next one to match your engine.

**modGeneral**

Find this:
```
' Check if the directory is there, if its not make it
```under the rest of the ChkDir's add this:
```
ChkDir App.Path & "\Data\", "recipes"
```Find **Public Sub ClearGameData**
At the bottom under the other ones add this:
```
Call SetStatus("Clearing recipes...")
Call Clearrecipes
```Find **Private Sub LoadGameData**

Under the rest add this line:
```
Call SetStatus("Loading recipes...")
Call Loadrecipes
```**modHandleData**

In **sub InitMessages** add these to the bottom:

```
HandleDataSub(CRequestEditRecipes) = GetAddress(AddressOf HandleRequestEditRecipes)
HandleDataSub(CSaverecipe) = GetAddress(AddressOf HandleSaverecipe)
HandleDataSub(CRequestrecipes) = GetAddress(AddressOf HandleRequestrecipes)
HandleDataSub(CForgetRecipe) = GetAddress(AddressOf HandleForgetRecipe)
HandleDataSub(CCraft) = GetAddress(AddressOf HandleCraft)
HandleDataSub(CSwapRecipeSlots) = GetAddress(AddressOf HandleSwapRecipeSlots)
HandleDataSub(CRecipes) = GetAddress(AddressOf HandleRecipes)
```Next find these lines in **Sub HandlePlayerMove**:
```
' Prevent player from moving if they have casted a spell
If TempPlayer(index).spellBuffer.Spell > 0 Then
If Spell(TempPlayer(index).spellBuffer.Spell).CastTime > 0 Then
Call SendPlayerXY(index)
Exit Sub
End If
End If
```Under it add this:
```
' Prevent player from moving if they are crafting an item
If TempPlayer(index).recipeBuffer.Recipe > 0 Then
If Recipe(TempPlayer(index).recipeBuffer.Recipe).CraftTime > 0 Then
Call SendPlayerXY(index)
Exit Sub
End If
End If
```Next in **Private Sub HandleAttack** under the 'dims' add this:
```
' can't attack whilst crafting
If TempPlayer(index).recipeBuffer.Recipe > 0 Then Exit Sub
```Now in **sub HandleHotbarChange** find this:
```
Case 2 ' spell
If Slot > 0 And Slot <= MAX_PLAYER_SPELLS Then
If player(index).Spell(Slot) > 0 Then
If Len(Trim$(Spell(player(index).Spell(Slot)).Name)) > 0 Then
player(index).Hotbar(hotbarNum).Slot = player(index).Spell(Slot)
player(index).Hotbar(hotbarNum).sType = sType
End If
End If
End If
```Under it add this:
```
Case 3 ' recipe
If Slot > 0 And Slot <= MAX_PLAYER_RECIPES Then
If player(index).Recipe(Slot) > 0 Then
If Len(Trim$(Recipe(player(index).Recipe(Slot)).Name)) > 0 Then
player(index).Hotbar(hotbarNum).Slot = player(index).Recipe(Slot)
player(index).Hotbar(hotbarNum).sType = sType
End If
End If
End If
```In the next sub **HandleHotbarUse** find this:
```
Case 2 ' spell
For i = 1 To MAX_PLAYER_SPELLS
If player(index).Spell(i) > 0 Then
If player(index).Spell(i) = player(index).Hotbar(Slot).Slot Then
BufferSpell index, i
Exit Sub
End If
End If
Next
```Under it add this:
```
Case 3 ' recipe
For i = 1 To MAX_PLAYER_RECIPES
If player(index).Recipe(i) > 0 Then
If player(index).Recipe(i) = player(index).Hotbar(Slot).Slot Then
BufferRecipe index, i
Exit Sub
End If
End If
Next
```**modTypes**

In **PlayerRec** at the bottom before end type add this:

```
Recipe(1 To MAX_PLAYER_RECIPES) As Long
CraftLv(1 To MAX_SKILL_TYPES) As Byte
CraftExp(1 To MAX_SKILL_TYPES) As Long
CraftNextLv(1 To MAX_SKILL_TYPES) As Long
CraftBonusExp(1 To MAX_SKILL_TYPES) As Long
```In**Public Type TempPlayerRec** at the bottom before end type add this:
```
recipeBuffer As RecipeBufferRec
```**modServerLoops**
Find this line in the ServerLoop:

```
' check if need to turn off stunned
```**ABOVE** it add this:

```
' check if they've completed casting, and if so set the actual spell going
If TempPlayer(i).recipeBuffer.Recipe > 0 Then
If timeGetTime > TempPlayer(i).recipeBuffer.Timer + (Recipe(player(i).Recipe(TempPlayer(i).recipeBuffer.Recipe)).CraftTime * 1000) Then

' Perform Recipe checks
If Recipe(player(i).Recipe(TempPlayer(i).recipeBuffer.Recipe)).Result <= 0 Then Exit Sub
CraftItem i, TempPlayer(i).recipeBuffer.Recipe, Recipe(player(i).Recipe(TempPlayer(i).recipeBuffer.Recipe)).Result, Recipe(player(i).Recipe(TempPlayer(i).recipeBuffer.Recipe)).Type
TempPlayer(i).recipeBuffer.Recipe = 0
TempPlayer(i).recipeBuffer.Timer = 0

End If
End If
```**modEnumerations**
Add these to the Server packets:

```
SrecipeEditor
SUpdaterecipe
SRecipes
SClearRecipeBuffer
SPlayerCraftEXP
```Next add these to the client packets:
```
CRequestEditRecipes
CSaverecipe
CRequestrecipes
CForgetRecipe
CCraft
CSwapRecipeSlots
CRecipes
```**modPlayer**

In **Sub JoinGame** find this:

```
' Send some more little goodies, no need to explain these
```Under that first list of calls add this:
```
Call Sendrecipes(index)

'Send all Craft Types
For i = 1 To MAX_SKILL_TYPES
Call SendCraftEXP(index, i)
Next
```In **sub OnDeath** find this line:
```
' Clear spell casting
```Above it add this:
```
' Clear crafting
TempPlayer(index).recipeBuffer.Recipe = 0
TempPlayer(index).recipeBuffer.Timer = 0
Call SendClearRecipeBuffer(index)
```In **Sub UseItem** find this line at the bottom:
```
End Select
End If
End Sub
```ABOVE it add this:
```
Case ITEM_TYPE_RECIPE
' stat requirements
For i = 1 To Stats.Stat_Count - 1
If GetPlayerRawStat(index, i) < Item(itemnum).Stat_Req(i) Then
PlayerMsg index, "You do not meet the stat requirements to use this item.", BrightRed
Exit Sub
End If
Next

' level requirement
If GetPlayerLevel(index) < Item(itemnum).LevelReq Then
PlayerMsg index, "You do not meet the level requirement to use this item.", BrightRed
Exit Sub
End If

' class requirement
If Item(itemnum).ClassReq > 0 Then
If Not GetPlayerClass(index) = Item(itemnum).ClassReq Then
PlayerMsg index, "You do not meet the class requirement to use this item.", BrightRed
Exit Sub
End If
End If

' access requirement
If Not GetPlayerAccess(index) >= Item(itemnum).AccessReq Then
PlayerMsg index, "You do not meet the access requirement to use this item.", BrightRed
Exit Sub
End If

' Get the recipe num
n = Item(itemnum).Data1

If n > 0 Then

' Make sure they are the right class
If Recipe(n).ClassReq = GetPlayerClass(index) Or Recipe(n).ClassReq = 0 Then
' ' Make sure they are the right level
' i = Recipe(n).LevelReg

' If i <= GetPlayerLevel(index) Then
i = FindOpenRecipeSlot(index)

' Make sure they have an open recipe slot
If i > 0 Then

' Make sure they dont already have the recipe
If Not HasRecipe(index, n) Then
Call SetPlayerRecipe(index, i, n)
' Call SendAnimation(GetPlayerMap(Index), Item(ItemNum).Animation, 0, 0, TARGET_TYPE_PLAYER, Index)
Call TakeInvItem(index, itemnum, 0)
Call PlayerMsg(index, "You now know how to craft " & Trim$(Recipe(n).Name) & ".", BrightGreen)

' update 'em
Call SendPlayerRecipes(index)
Else
Call PlayerMsg(index, "You already have knowledge of this skill.", BrightRed)
End If

Else
Call PlayerMsg(index, "You cannot learn any more skills.", BrightRed)
End If

' Else
' Call PlayerMsg(index, "You must be level " & i & " to learn this skill.", BrightRed)
' End If

Else
Call PlayerMsg(index, "This recipe can only be learned by " & CheckGrammar(GetClassName(Recipe(n).ClassReq)) & ".", BrightRed)
End If
End If

' send the sound
SendPlayerSound index, GetPlayerX(index), GetPlayerY(index), SoundEntity.seItem, itemnum
```In **Sub PlayerMove** in **Case Dir_UP** find:
```
If Map(GetPlayerMap(index)).Tile(GetPlayerX(index), GetPlayerY(index) - 1).Type <> TILE_TYPE_RESOURCE Then
```under it add:
```
If Map(GetPlayerMap(index)).Tile(GetPlayerX(index), GetPlayerY(index) - 1).Type <> TILE_TYPE_CRAFT Then
```now a couple lines below that you will see: **Moved = 1**
Under that add : **End If**

In **Sub PlayerMove** in **Case Dir_DOWN** find:
```
If Map(GetPlayerMap(index)).Tile(GetPlayerX(index), GetPlayerY(index) + 1).Type <> TILE_TYPE_RESOURCE Then
```under it add:
```
If Map(GetPlayerMap(index)).Tile(GetPlayerX(index), GetPlayerY(index) + 1).Type <> TILE_TYPE_CRAFT Then
```now a couple lines below that you will see: **Moved = 1**
Under that add : **End If**

In **Sub PlayerMove** in **Case Dir_LEFT** find:
```
If Map(GetPlayerMap(index)).Tile(GetPlayerX(index) - 1, GetPlayerY(index)).Type <> TILE_TYPE_RESOURCE Then
```under it add:
```
If Map(GetPlayerMap(index)).Tile(GetPlayerX(index) - 1, GetPlayerY(index)).Type <> TILE_TYPE_CRAFT Then
```now a couple lines below that you will see: **Moved = 1**
Under that add : **End If**

In **Sub PlayerMove** in **Case Dir_RIGHT** find:
```
If Map(GetPlayerMap(index)).Tile(GetPlayerX(index) + 1, GetPlayerY(index)).Type <> TILE_TYPE_RESOURCE Then
```Under it add this:
```
If Map(GetPlayerMap(index)).Tile(GetPlayerX(index) + 1, GetPlayerY(index)).Type <> TILE_TYPE_CRAFT Then
```now a couple lines below that you will see: **Moved = 1**
Under that add : **End If**

**modDataBase**

In **Sub AddChar** find this:
```
player(index).Dir = DIR_DOWN
```ABOVE it add this:
```
'crafting levels
For n = 1 To MAX_SKILL_TYPES
player(index).CraftExp(n) = 0
player(index).CraftLv(n) = 1
Next n
```**Server Form Work**
Where the other Reload buttoms are add a new one named: cmdReloadrecipes

Double click the new buttom and add:

```
Private Sub cmdReloadrecipes_Click()
Dim i As Long
Call Loadrecipes
Call TextAdd("All recipes reloaded.")
For i = 1 To Player_HighIndex
If IsPlaying(i) Then
Sendrecipes i
End If
Next
End Sub
```**End of server**

**Client**

**modConstants**

Add these two lines to there respective spots:

```
Public Const ITEM_TYPE_RECIPE As Byte = 14
``````
Public Const EDITOR_RECIPE As Byte = 9
``````
Public Const TILE_TYPE_CRAFT As Byte = 15
``````
Public Const DIALOGUE_TYPE_FORGET_RECIPE As Byte = 9
```Be sure to change the numbers to the next one to match your engine.

**modTypes**

In **PlayerRec** at the bottom before end type add this:
```
Recipe(1 To MAX_PLAYER_RECIPES) As Long
CraftLv(1 To MAX_SKILL_TYPES) As Byte
CraftExp(1 To MAX_SKILL_TYPES) As Long
CraftNextLv(1 To MAX_SKILL_TYPES) As Long
CraftBonusExp(1 To MAX_SKILL_TYPES) As Long
```**modGeneral**

In Sub LoadGUI find:

```
frmMain.picSpells.Picture = LoadPicture(App.Path & "\data files\graphics\gui\main\skills.jpg")
```under it add :
```
frmMain.picRecipes.Picture = LoadPicture(App.Path & "\data files\graphics\gui\main\skills.jpg")
```Ok i didnt include a graphic for the ui so just change 'skills.jpg' to whatever grpahic u make for the background.

**modGameEditors**

In MapEditorMouseDown find:
```
' slide
If frmEditor_Map.optSlide.value Then
.Type = TILE_TYPE_SLIDE
.Data1 = MapEditorSlideDir
.Data2 = 0
.Data3 = 0
End If
```Under it add:
```
' crafting
If frmEditor_Map.optCraft.value Then
.Type = TILE_TYPE_CRAFT
.Data1 = skilltype
.Data2 = 0
.Data3 = 0
```in **ItemEditorInit** find this:
```
' Basic requirements
```ABOVE it add this:
```
If (frmEditor_Item.cmbType.ListIndex = ITEM_TYPE_RECIPE) Then
frmEditor_Item.fraRecipe.Visible = True
frmEditor_Item.scrlRecipe.value = .Data1
Else
frmEditor_Item.fraRecipe.Visible = False
End If
```**modDirectDraw7**
in sub BltBars find this:

```
' check for casting time bar
```ABOVE it add this:
```
' check for crafting time bar
If RecipeBuffer > 0 Then
If Recipe(PlayerRecipes(RecipeBuffer)).CraftTime > 0 Then
' lock to player
tmpX = GetPlayerX(MyIndex) * PIC_X + Player(MyIndex).XOffset + 16 - (sWidth / 2)
tmpY = GetPlayerY(MyIndex) * PIC_Y + Player(MyIndex).YOffset + 35 + sHeight + 1

' calculate the width to fill
barWidth = (timeGetTime - RecipeBufferTimer) / ((Recipe(PlayerRecipes(RecipeBuffer)).CraftTime * 1000)) * sWidth

' draw bar background
With sRECT
.top = sHeight * 3 ' cooldown bar background
.Left = 0
.Right = sWidth
.Bottom = .top + sHeight
End With
Engine_BltFast ConvertMapX(tmpX), ConvertMapY(tmpY), DDS_Bars, sRECT, DDBLTFAST_WAIT Or DDBLTFAST_SRCCOLORKEY

' draw the bar proper
With sRECT
.top = sHeight * 2 ' cooldown bar
.Left = 0
.Right = barWidth
.Bottom = .top + sHeight
End With
Engine_BltFast ConvertMapX(tmpX), ConvertMapY(tmpY), DDS_Bars, sRECT, DDBLTFAST_WAIT Or DDBLTFAST_SRCCOLORKEY
End If
End If
```In **BltHotbar** find this:
```
End Select
' render the numbers
```Above it add this:
```
Case 3 ' recipe
With sRECT
.top = 0
.Left = 32
.Bottom = 32
.Right = 64
End With
If Len(Recipe(Hotbar(i).Slot).Name) > 0 Then
If Item(Recipe(Hotbar(i).Slot).Result).Pic > 0 Then
If DDS_Item(Item(Recipe(Hotbar(i).Slot).Result).Pic) Is Nothing Then
Call InitDDSurf("items\" & Item(Recipe(Hotbar(i).Slot).Result).Pic, DDSD_Item(Item(Recipe(Hotbar(i).Slot).Result).Pic), DDS_Item(Item(Recipe(Hotbar(i).Slot).Result).Pic))
End If

Engine_BltToDC DDS_Item(Item(Recipe(Hotbar(i).Slot).Result).Pic), sRECT, dRECT, frmMain.picHotbar, False
End If
End If
```**modHandleData**

In Sub **InitMessages** add these under the other ones:

```
HandleDataSub(SRecipeEditor) = GetAddress(AddressOf HandleRecipeEditor)
HandleDataSub(SUpdateRecipe) = GetAddress(AddressOf HandleUpdateRecipe)
HandleDataSub(SRecipes) = GetAddress(AddressOf HandleRecipes)
HandleDataSub(SClearRecipeBuffer) = GetAddress(AddressOf HandleClearRecipeBuffer)
HandleDataSub(SPlayerCraftEXP) = GetAddress(AddressOf HandlePlayerCraftExp)
```**modEnumerations**
Add these to the Server packets:

```
SrecipeEditor
SUpdaterecipe
SRecipes
SClearRecipeBuffer
SPlayerCraftEXP
```Next add these to the client packets:
```
CRequestEditRecipes
CSaverecipe
CRequestrecipes
CForgetRecipe
CCraft
CSwapRecipeSlots
CRecipes
```**modGameLogic**

In sub **CheckDirection** find:

```
' Check to see if the map tile is tree or not
If Map.Tile(X, Y).Type = TILE_TYPE_RESOURCE Then
CheckDirection = True
Exit Function
End If
```Under it add:
```
' Check to see if the map tile is crafting or not
If Map.Tile(X, Y).Type = TILE_TYPE_CRAFT Then
CheckDirection = True
Exit Function
End If
```In **GameLoop** find this:
```
' check if we need to unlock the player's spell casting restriction
If SpellBuffer > 0 Then
If SpellBufferTimer + (Spell(PlayerSpells(SpellBuffer)).CastTime * 1000) < Tick Then
SpellBuffer = 0
SpellBufferTimer = 0
End If
End If
```under that add this:
```
' check if we need to unlock the player's crafting restriction
If RecipeBuffer > 0 Then
If RecipeBufferTimer + (Recipe(PlayerRecipes(RecipeBuffer)).CraftTime * 1000) < Tick Then
RecipeBuffer = 0
RecipeBufferTimer = 0
End If
End If
```in Sub **CheckAttack** find :
```
If StunDuration > 0 Then Exit Sub ' stunned, can't attack
```under it add this:
```
If RecipeBuffer > 0 Then Exit Sub ' currently crafting, can't attack
```In Sub **CanMove** find this:
```
' make sure they're not stunned
If StunDuration > 0 Then
CanMove = False
Exit Function
End If
```Under that add this:
```
' Make sure they haven't just used a recipe
If RecipeBuffer > 0 Then
CanMove = False
Exit Function
End If
```in **Public Sub dialogueHandler** find this:
```
End Select
ElseIf Index = 3 Then ' no button
```ABOVE that add this:
```
Case DIALOGUE_TYPE_FORGET_RECIPE
ForgetRecipe dialogueData1
```**modClientTCP**

In Sub **SendHotbarUse** find:

```
' check if spell
If Hotbar(Slot).sType = 2 Then ' spell
For i = 1 To MAX_PLAYER_SPELLS
' is the spell matching the hotbar?
If PlayerSpells(i) = Hotbar(Slot).Slot Then
If SpellBuffer = i Then Exit Sub
' found it, cast it
CastSpell i
Exit Sub
End If
Next

' can't find the spell, exit out
Exit Sub
End If
```Under that add this:
```
' check if recipe
If Hotbar(Slot).sType = 3 Then ' recipe
For i = 1 To MAX_PLAYER_RECIPES
' is the spell matching the hotbar?
If PlayerRecipes(i) = Hotbar(Slot).Slot Then
If RecipeBuffer = i Then Exit Sub
' found it, cast it
CraftRecipe i
Exit Sub
End If
Next

' can't find the recipe, exit out
Exit Sub
End If
```**modText**

In **BltMapAttributes** find:

```
Case TILE_TYPE_SLIDE
DrawText TexthDC, tX, tY, "S", QBColor(BrightCyan)
```Under that add this:
```
Case TILE_TYPE_CRAFT
DrawText TexthDC, tX, tY, "CR", QBColor(White)
```**Client Form Work**

In **frmEditors** add this:

```
Private Sub RecipeEditor()
If GetPlayerAccess(MyIndex) < ADMIN_DEVELOPER Then
MsgBox ("You need to be a developer to do this.")
Exit Sub
End If

SendRequestEditRecipe
End Sub
```In **Private Sub imgEditor_Click**
Add a new case that looks like this:
```
Case 9: RecipeEditor
```Now on the frmEditors copy and paste one of the buttons and change the index to 9

**frmMain**

On **frmMain** you will see a picture box located at the bottom called **picItemDesc**. Copy a paste that onto frmMain. When asked if you want to make a control array click no. Rename the box: **picRecipeDesc**

Rename the top label:**lblRecipeName**

Rename the smaller pic box in the middle:**picRecipeDescPic**
And below that rename the other label: **lblRecipeDesc**

in **Private Sub Form_MouseMove** find:
```
picSpellDesc.Visible = False
```under it add this:
```
picRecipeDesc.Visible = False
```in **Private Sub imgButton_Click** in Each Case add this:
```
picRecipes.Visible = False
picSkills.Visible = False
```in **Private Sub picCover_MouseMove** find this:
```
picSpellDesc.Visible = False
```Under it add this:
```
picRecipeDesc.Visible = False
```in **Private Sub picHotbar_MouseDown** replace the sub with this:
```
Private Sub picHotbar_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim SlotNum As Long

' If debug mode, handle error then exit out
If Options.Debug = 1 Then On Error GoTo errorhandler

SlotNum = IsHotbarSlot(X, Y)

If Button = 1 Then
If SlotNum <> 0 Then
If SpellBuffer = SlotNum Then Exit Sub
If RecipeBuffer = SlotNum Then Exit Sub
SendHotbarUse SlotNum
End If
ElseIf Button = 2 Then
If SlotNum <> 0 Then
SendHotbarChange 0, 0, SlotNum
End If
End If

' Error handler
Exit Sub
errorhandler:
HandleError "picHotbar_MouseDown", "frmMain", Err.Number, Err.Description, Err.Source, Err.HelpContext
Err.Clear
Exit Sub
End Sub
```Replace **Private Sub picHotbar_MouseMove** with:
```
Private Sub picHotbar_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim SlotNum As Long

' If debug mode, handle error then exit out
If Options.Debug = 1 Then On Error GoTo errorhandler

SlotNum = IsHotbarSlot(X, Y)

If SlotNum <> 0 Then
If Hotbar(SlotNum).sType = 1 Then ' item
X = X + picHotbar.Left + 1
Y = Y + picHotbar.top - picItemDesc.height - 1
UpdateDescWindow Hotbar(SlotNum).Slot, X, Y
LastItemDesc = Hotbar(SlotNum).Slot ' set it so you don't re-set values
Exit Sub
ElseIf Hotbar(SlotNum).sType = 2 Then ' spell
X = X + picHotbar.Left + 1
Y = Y + picHotbar.top - picSpellDesc.height - 1
UpdateSpellWindow Hotbar(SlotNum).Slot, X, Y
LastSpellDesc = Hotbar(SlotNum).Slot ' set it so you don't re-set values
Exit Sub
ElseIf Hotbar(SlotNum).sType = 3 Then ' Recipe
X = X + picHotbar.Left + 1
Y = Y + picHotbar.top - picRecipeDesc.height - 1
UpdateRecipeWindow Hotbar(SlotNum).Slot, X, Y
LastRecipeDesc = Hotbar(SlotNum).Slot ' set it so you don't re-set values
Exit Sub
End If
End If

picItemDesc.Visible = False
LastItemDesc = 0 ' no item was last loaded

picSpellDesc.Visible = False
LastSpellDesc = 0 ' no spell was last loaded

picRecipeDesc.Visible = False
LastRecipeDesc = 0 ' no recipe was last loaded

' Error handler
Exit Sub
errorhandler:
HandleError "picHotbar_MouseMove", "frmMain", Err.Number, Err.Description, Err.Source, Err.HelpContext
Err.Clear
Exit Sub
End Sub
```in **Private Sub picScreen_MouseMove** find this:
```
' hide the descriptions
picItemDesc.Visible = False
picSpellDesc.Visible = False
```under that add this:
```
picRecipeDesc.Visible = False
```in **Private Sub picShop_MouseMove** add this under the spelldesc:
```
picRecipeDesc.Visible = False
```Add this to the bottom of **frmMain**:
```
Private Sub picRecipeDesc_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
' If debug mode, handle error then exit out
If Options.Debug = 1 Then On Error GoTo errorhandler

picRecipeDesc.Visible = False

' Error handler
Exit Sub
errorhandler:
HandleError "picRecipeDesc_MouseMove", "frmMain", Err.Number, Err.Description, Err.Source, Err.HelpContext
Err.Clear
Exit Sub
End Sub

Private Sub picRecipes_DblClick()
Dim recipenum As Long

' If debug mode, handle error then exit out
If Options.Debug = 1 Then On Error GoTo errorhandler

recipenum = IsPlayerRecipe(RecipeX, RecipeY)

If recipenum <> 0 Then
Call CraftRecipe(recipenum)
Exit Sub
End If

' Error handler
Exit Sub
errorhandler:
HandleError "picRecipes_DblClick", "frmMain", Err.Number, Err.Description, Err.Source, Err.HelpContext
Err.Clear
Exit Sub
End Sub

Private Sub picRecipes_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim recipenum As Long

' If debug mode, handle error then exit out
If Options.Debug = 1 Then On Error GoTo errorhandler

recipenum = IsPlayerRecipe(RecipeX, RecipeY)
If Button = 1 Then ' left click
If recipenum <> 0 Then
DragRecipe = recipenum
Exit Sub
End If
ElseIf Button = 2 Then ' right click
If recipenum <> 0 Then
Dialogue "Forget Recipe", "Are you sure you want to forget how to craft " & Trim$(Recipe(PlayerRecipes(recipenum)).Name) & "?", DIALOGUE_TYPE_FORGET_RECIPE, True, recipenum
Exit Sub
End If
End If

' Error handler
Exit Sub
errorhandler:
HandleError "picrecipes_MouseDown", "frmMain", Err.Number, Err.Description, Err.Source, Err.HelpContext
Err.Clear
Exit Sub
End Sub

Private Sub picRecipes_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim recipeSlot As Long
Dim x2 As Long, y2 As Long

' If debug mode, handle error then exit out
If Options.Debug = 1 Then On Error GoTo errorhandler

RecipeX = X
RecipeY = Y

recipeSlot = IsPlayerRecipe(X, Y)

If DragRecipe > 0 Then
Call BltDraggedRecipe(X + picRecipes.Left, Y + picRecipes.top)
Else
If recipeSlot <> 0 Then
x2 = X + picRecipes.Left - picRecipeDesc.width - 1
y2 = Y + picRecipes.top - picRecipeDesc.height - 1
UpdateRecipeWindow PlayerRecipes(recipeSlot), x2, y2
LastRecipeDesc = PlayerRecipes(recipeSlot)
Exit Sub
End If
End If

picRecipeDesc.Visible = False
LastRecipeDesc = 0

' Error handler
Exit Sub
errorhandler:
HandleError "picrecipes_MouseMove", "frmMain", Err.Number, Err.Description, Err.Source, Err.HelpContext
Err.Clear
Exit Sub
End Sub

Private Sub picRecipes_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim i As Long
Dim recPos As RECT

' If debug mode, handle error then exit out
If Options.Debug = 1 Then On Error GoTo errorhandler

If DragRecipe > 0 Then
' drag + drop
For i = 1 To MAX_PLAYER_RECIPES
With recPos
.top = RecipeTop + ((RecipeOffsetY + 32) * ((i - 1) \ RecipeColumns))
.Bottom = .top + PIC_Y
.Left = RecipeLeft + ((RecipeOffsetX + 32) * (((i - 1) Mod RecipeColumns)))
.Right = .Left + PIC_X
End With

If X >= recPos.Left And X <= recPos.Right Then
If Y >= recPos.top And Y <= recPos.Bottom Then
If DragRecipe <> i Then
SendChangeRecipeSlots DragRecipe, i
Exit For
End If
End If
End If
Next
' hotbar
For i = 1 To MAX_HOTBAR
With recPos
.top = picHotbar.top - picRecipes.top
.Left = picHotbar.Left - picRecipes.Left + (HotbarOffsetX * (i - 1)) + (32 * (i - 1))
.Right = .Left + 32
.Bottom = picHotbar.top - picRecipes.top + 32
End With

If X >= recPos.Left And X <= recPos.Right Then
If Y >= recPos.top And Y <= recPos.Bottom Then
SendHotbarChange 3, DragRecipe, i
DragRecipe = 0
picTempRecipe.Visible = False
Exit Sub
End If
End If
Next
End If

DragRecipe = 0
picTempRecipe.Visible = False

' Error handler
Exit Sub
errorhandler:
HandleError "picrecipes_MouseUp", "frmMain", Err.Number, Err.Description, Err.Source, Err.HelpContext
Err.Clear
Exit Sub
End Sub

Private Function IsPlayerRecipe(ByVal X As Single, ByVal Y As Single) As Long
Dim tempRec As RECT
Dim i As Long

' If debug mode, handle error then exit out
If Options.Debug = 1 Then On Error GoTo errorhandler

IsPlayerRecipe = 0

For i = 1 To MAX_PLAYER_RECIPES

If PlayerRecipes(i) > 0 And PlayerRecipes(i) <= MAX_RECIPES Then

With tempRec
.top = RecipeTop + ((RecipeOffsetY + 32) * ((i - 1) \ RecipeColumns))
.Bottom = .top + PIC_Y
.Left = RecipeLeft + ((RecipeOffsetX + 32) * (((i - 1) Mod RecipeColumns)))
.Right = .Left + PIC_X
End With

If X >= tempRec.Left And X <= tempRec.Right Then
If Y >= tempRec.top And Y <= tempRec.Bottom Then
IsPlayerRecipe = i
Exit Function
End If
End If
End If

Next

' Error handler
Exit Function
errorhandler:
HandleError "IsPlayerRecipe", "frmMain", Err.Number, Err.Description, Err.Source, Err.HelpContext
Err.Clear
Exit Function
End Function

```On frmMain copy and paste picSpells. When it ask if you want to make a control array click 'no' and rename it : **PicRecipes**

Copy and paste it again and rename the pic to: **PicSkills**

Inside of PicSkills make 10 labels all named :lblCraftLv
when asked if you want a control array say yes. Then change the one with an index of 0 to 10.

Next to those labels create 10 more named : lblCraftExp
when asked if you want a control array say yes. Then change the one with an index of 0 to 10.

at the bottom of picSkills create a buttom and double click it:
add this code:
```
If Not picRecipes.Visible Then
' show the window
picCharacter.Visible = False
picInventory.Visible = False
picSpells.Visible = False
picOptions.Visible = False
picParty.Visible = False
picQuests.Visible = False
picSkills.Visible = False

picRecipes.Visible = True
Else
picRecipes.Visible = False
End If
```On frmMain where your other buttons are create a new one and double click it and add this code:
```
If Not picSkills.Visible Then
' show the window
picCharacter.Visible = False
picInventory.Visible = False
picSpells.Visible = False
picOptions.Visible = False

picParty.Visible = False
picQuests.Visible = False
picSkills.Visible = True

picRecipes.Visible = False
Else
picSkills.Visible = False
End If
```**frmEditor_Item**

In **Private Sub cmbType_Click** find:

```
If (cmbType.ListIndex = ITEM_TYPE_SPELL) Then
fraSpell.Visible = True
Else
fraSpell.Visible = False
End If
```under it add:
```
If (cmbType.ListIndex = ITEM_TYPE_RECIPE) Then
fraRecipe.Visible = True
Else
fraRecipe.Visible = False
End If
```Add this to the bottom of frmEditor_Item:
```
'craft
Private Sub scrlRecipe_Change()
' If debug mode, handle error then exit out
If Options.Debug = 1 Then On Error GoTo errorhandler

If EditorIndex = 0 Or EditorIndex > MAX_ITEMS Then Exit Sub

If Len(Trim$(Recipe(scrlRecipe.value).Name)) > 0 Then
lblRecipeName.Caption = "Name: " & Trim$(Recipe(scrlRecipe.value).Name)
Else
lblRecipeName.Caption = "Name: None"
End If

lblRecipe.Caption = "recipe: " & scrlRecipe.value

Item(EditorIndex).Data1 = scrlRecipe.value

' Error handler
Exit Sub
errorhandler:
HandleError "scrlrecipe_Change", "frmEditor_Item", Err.Number, Err.Description, Err.Source, Err.HelpContext
Err.Clear
Exit Sub
End Sub
```On **frmEditor_Item** under the list properties of **cmbType** add : **Recipe**

Somewhere on **frmEditor_Item** make a new Frame and name it : **fraRecipe**

Inside **fraRecipe** make a label named: **lblRecipeName**

Inside **fraRecipe** make a label named: **lblRecipe**

Inside **fraRecipe** make a scroll bar named: **scrlRecipe**

**frmEditor_Map**

On **frmEditor_Map** inside of **fraAttribs** make a new option button named: **optCraft**
Double click and add this:
```
Private Sub optCraft_Click()
ClearAttributeDialogue
picAttributes.Visible = True
fraCraft.Visible = True

scrlCraft.max = 9
lblCType.Caption = "Type :" & scrlCraft.value
End Sub
```On **frmEditor_Map** inside of **picAttributes** make a new frame named: **fraCraft** Make sure to set the **Visible** to **False**

Inside **fraCraft** make a label named: **lblCType**

Under that label make a scroll bar named: **scrlCraft**

Still inside of **fraCraft** make a command button named: **cmdCOk**

Paste this at the bottom of **frmEditor_Map**

```
Private Sub scrlCraft_Change()
With lblCType
Select Case scrlCraft.value
Case 0
.Caption = "None"
Case 1
.Caption = "Blacksmith"
Case 2
.Caption = "Alchemy"
Case 3
.Caption = "Cooking"
Case 4
.Caption = "Enchant"
Case 5
.Caption = "Fletching"
Case 6
.Caption = "Goldsmith"
Case 7
.Caption = "Tailor"
Case 8
.Caption = "Woodwork"
End Select
End With
End Sub

Private Sub cmdCOk_Click()
skilltype = scrlCraft.value
fraCraft.Visible = False
picAttributes.Visible = False
End Sub
```After all that you should be done with adding this system. Do keep in mind that you will have to do all the gui pics yourself and feel free to change around anything you want to your liking. I included some basic profession levels for you to see you can add remove whatever you need too.

LET ME KNOW IF I MISSED ANYTHING.

[Officer Johnson]

justn i love to see you back and working away on tutorials 

Nice addition man.

[Colonello]

Very nice tutorial :) Lots of features not seen in other crafting systems.

[Mohenjo Daro]

Well, this sucks XD I already have the old system with edits and don't feel like pulling them all out, oh well, I'll keep mine for now I guess

Anyways, great addition, thanks for sharing it!

[SkywardRiver]

Nice to see you back JustN

[J. Black]

```

Edit: fixed.
```