Justn Posted December 23, 2014 Author Share Posted December 23, 2014 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**![](http://indierising.net/filehost/images/recipeeditorqyq.jpg)With this new editor you can edit every aspect of your recipes as you can see there are some new additions.**Crafting Timer Bar**![](http://indierising.net/filehost/images/recipetimerggg.jpg)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 professionAnd 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 IfEnd 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: cmdReloadrecipesDouble 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 NextEnd 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 SendRequestEditRecipeEnd 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 Suberrorhandler: HandleError "picHotbar_MouseDown", "frmMain", Err.Number, Err.Description, Err.Source, Err.HelpContext Err.Clear Exit SubEnd 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 Suberrorhandler: HandleError "picHotbar_MouseMove", "frmMain", Err.Number, Err.Description, Err.Source, Err.HelpContext Err.Clear Exit SubEnd 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 Suberrorhandler: HandleError "picRecipeDesc_MouseMove", "frmMain", Err.Number, Err.Description, Err.Source, Err.HelpContext Err.Clear Exit SubEnd SubPrivate 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 Suberrorhandler: HandleError "picRecipes_DblClick", "frmMain", Err.Number, Err.Description, Err.Source, Err.HelpContext Err.Clear Exit SubEnd SubPrivate 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 Suberrorhandler: HandleError "picrecipes_MouseDown", "frmMain", Err.Number, Err.Description, Err.Source, Err.HelpContext Err.Clear Exit SubEnd SubPrivate Sub picRecipes_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)Dim recipeSlot As LongDim 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 Suberrorhandler: HandleError "picrecipes_MouseMove", "frmMain", Err.Number, Err.Description, Err.Source, Err.HelpContext Err.Clear Exit SubEnd SubPrivate Sub picRecipes_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)Dim i As LongDim 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 Suberrorhandler: HandleError "picrecipes_MouseUp", "frmMain", Err.Number, Err.Description, Err.Source, Err.HelpContext Err.Clear Exit SubEnd SubPrivate Function IsPlayerRecipe(ByVal X As Single, ByVal Y As Single) As LongDim tempRec As RECTDim 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 Functionerrorhandler: HandleError "IsPlayerRecipe", "frmMain", Err.Number, Err.Description, Err.Source, Err.HelpContext Err.Clear Exit FunctionEnd 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 :lblCraftLvwhen 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 : lblCraftExpwhen 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:```'craftPrivate 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 Suberrorhandler: HandleError "scrlrecipe_Change", "frmEditor_Item", Err.Number, Err.Description, Err.Source, Err.HelpContext Err.Clear Exit SubEnd 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.valueEnd 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 WithEnd SubPrivate Sub cmdCOk_Click() skilltype = scrlCraft.value fraCraft.Visible = False picAttributes.Visible = FalseEnd 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. Link to comment Share on other sites More sharing options...
Officer Johnson Posted December 23, 2014 Share Posted December 23, 2014 justn i love to see you back and working away on tutorials Nice addition man. Link to comment Share on other sites More sharing options...
Colonello Posted December 23, 2014 Share Posted December 23, 2014 Very nice tutorial :) Lots of features not seen in other crafting systems. Link to comment Share on other sites More sharing options...
Mohenjo Daro Posted December 23, 2014 Share Posted December 23, 2014 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 guessAnyways, great addition, thanks for sharing it! Link to comment Share on other sites More sharing options...
SkywardRiver Posted December 23, 2014 Share Posted December 23, 2014 Nice to see you back JustN Link to comment Share on other sites More sharing options...
J. Black Posted January 22, 2015 Share Posted January 22, 2015 ```Edit: fixed.``` Link to comment Share on other sites More sharing options...
Recommended Posts
Create an account or sign in to comment
You need to be a member in order to leave a comment
Create an account
Sign up for a new account in our community. It's easy!
Register a new accountSign in
Already have an account? Sign in here.
Sign In Now