[EO] House Editor

[Alatar]

Well, i've managed to find some time and i've made this tutorial so people can install in their own projects the House Editor that i was working on. Anyway, when i was checking the project I found it a bit complicated, and maybe in the future i shall re-do the entire code so it could be more efficient. But right now if anyone wants it, here it is xD

Link to download the code: http://www.touchofdeathforums.com/smf/index.php/topic,64019.0.html


**HOUSE EDITOR FEATURES**

- **New form: House Editor.**
This editor handles the layers, attributes and also the map properties, all in one. With this editor the owner of a house can modify that map easily by pressing F2\. It loads a pre-setted tileset and can handle music from a different source than the normal map editor music.

- **New map moral: HOUSE.**
Shows the map name in cyan color. This type of maps allow the users to edit them if they are the owners of the map.

- **New npc type: Manager.**
This new type of npc's stands on the place but can management the houses, selling, buying, or even warping to them depending on the case.

- **Attributes are not longer free** (if you wan't)
Not for the House Owners. This can easily be changed and allow some gold cost on putting the attributes on the ground. It also allow to return some of the money by right clicking on the attributes and make them to vanish.

- **New Layer: Roof**
A layer over the Fringe2 that can be showed or not depending if the player has passed through a Threshold attribute or not. Also from the House Form this can be hidden in orden to map better.

- **New attribute: Threshold**
Shows/hides the Roof layer when a player walks over it.

- **New attribute: Sign**
Displays a message on the ground when a player walks over it.

- **New attribute: Spot**
Allow the use of resources by the house owner. The resources should be setted as Spot in the Resource Editor.

- **WarpToHouse**
By pressing F3 you can Warp to your house if you are in a safe map. This code can easily be setted in items or spells.

- **Additions to the Default Forms**
MAINGAME: picHouse that displays the ways to buy/sell houses.
NPC: In order to proper handle the data of the Npc Manager, also really easy to understand and use.
RESOURCES: Added check that set if that resource acts or not as a spot attribute.

_Install, step by step:_

**Server**

**modConstants**

Find:

> Public Const MAP_MORAL_SAFE As Byte = 1

Add:

> Public Const MAP_MORAL_HOUSE As Byte = 2

Find:

> Public Const TILE_TYPE_SLIDE As Byte = 14

Add:

> Public Const TILE_TYPE_SIGN As Byte = 15
> Public Const TILE_TYPE_THRESHOLD As Byte = 16

Find:

> Public Const NPC_BEHAVIOUR_GUARD As Byte = 4

Add:

> Public Const NPC_BEHAVIOUR_MANAGER As Byte = 5

**modDatabase**

Find:

> Player(Index).Vital(Vitals.SP) = GetPlayerMaxVital(Index, Vitals.SP)

Add:

> PutVar App.Path & "\data\accounts\houses.ini", "OPTIONS", "" & Player(Index).Name, 0

**modGameLogic**

Find the If sentence that starts with "

> ' exit out early

Replace with:

> ' exit out early
>             If IsSpell Then
>                 If Npc(NpcNum).Behaviour <> NPC_BEHAVIOUR_FRIENDLY And Npc(NpcNum).Behaviour <> NPC_BEHAVIOUR_SHOPKEEPER And Npc(NpcNum).Behaviour <> NPC_BEHAVIOUR_MANAGER Then
>                     CanAttackNpc = True
>                     Exit Function
>                 End If
>             End If

Find:

> Case DIR_RIGHT
>                     NpcX = MapNpc(MapNum).Npc(MapNpcNum).x - 1
>                     NpcY = MapNpc(MapNum).Npc(MapNpcNum).y
>             End Select

Below, replace the if sentence with this:

> If NpcX = GetPlayerX(Attacker) Then
>                 If NpcY = GetPlayerY(Attacker) Then
>                     If Npc(NpcNum).Behaviour <> NPC_BEHAVIOUR_FRIENDLY And Npc(NpcNum).Behaviour <> NPC_BEHAVIOUR_SHOPKEEPER And Npc(NpcNum).Behaviour <> NPC_BEHAVIOUR_MANAGER Then 'House Editor
>                         CanAttackNpc = True
>                     Else
>                         'House Editor
>                         If Npc(NpcNum).Behaviour = NPC_BEHAVIOUR_MANAGER Then
>                             Call SendInitManager(Attacker, CInt(GetVar(App.Path & "\data\accounts\houses.ini", "OPTIONS", "" & Player(Attacker).Name)), Npc(NpcNum).HMapNum, Npc(NpcNum).HBuy, Npc(NpcNum).HSell)
>                         End If
>                         '/House Editor
>                        
>                         If Len(Trim$(Npc(NpcNum).AttackSay)) > 0 Then
>                             PlayerMsg Attacker, Trim$(Npc(NpcNum).Name) & ": " & Trim$(Npc(NpcNum).AttackSay), White
>                         End If
>                     End If
>                 End If
>             End If

**modHandleData**

Find:

> HandleDataSub(CUntradeItem) = GetAddress(AddressOf HandleUntradeItem)

Add:

> HandleDataSub(CRequestEditHouse) = GetAddress(AddressOf HandleRequestEditHouse)
>     HandleDataSub(CHouseManager) = GetAddress(AddressOf HandleHouseManager)
>     HandleDataSub(CCheckGold) = GetAddress(AddressOf HandleCheckGold)
>     HandleDataSub(CWarpToHouse) = GetAddress(AddressOf HandleWarpToHouse)

In MapHandleData, Find:

> If GetPlayerAccess(Index) < ADMIN_MAPPER Then
>             Exit Sub
>         End If

Replace with:

> '[House Editor]
>     If Not GetOwner(Index) = True Then
>         If GetPlayerAccess(Index) < ADMIN_MAPPER Then
>             Exit Sub
>         End If
>     End If
>     '[/House Editor]

Find:

> Map(MapNum).Tile(x, y).DirBlock = Buffer.ReadByte

Add:

> Map(MapNum).Tile(x, y).Data4 = Buffer.ReadString 'House Editor

At the bottom of the module, add:

> '[House Editor]
> Sub HandleRequestEditHouse(ByVal Index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
>     Dim Buffer As clsBuffer
>     Dim Owner As Long
>    
>     Owner = GetVar(App.Path & "\data\accounts\houses.ini", "OPTIONS", "" & Player(Index).Name)
>    
>     Set Buffer = New clsBuffer
>     Buffer.WriteLong SEditHouse
>     Buffer.WriteLong Owner
>     SendDataTo Index, Buffer.ToArray()
>     Set Buffer = Nothing
> End Sub
>
> Sub HandleHouseManager(ByVal Index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
>     Dim Buffer As clsBuffer
>     Dim HType As String
>     Dim HMapNum As Long
>     Dim HGold As Long
>     Dim i As Long
>     Dim GoldItemNum As Long
>    
>     Set Buffer = New clsBuffer
>     Buffer.WriteBytes Data()
>     HType = Buffer.ReadString
>     HMapNum = Buffer.ReadLong
>     HGold = Buffer.ReadLong
>     Set Buffer = Nothing
>    
>     GoldItemNum = 1 'This works as the HOUSE_GOLD on server
>    
>     Select Case HType
>         Case "Buy"
>             If CheckGold(Index, GoldItemNum, HGold) = True Then
>                 Call PutVar(App.Path & "\data\accounts\houses.ini", "OPTIONS", "" & Player(Index).Name, "" & HMapNum)
>                 TakeInvItem Index, GoldItemNum, HGold
>             Else
>                 HType = "Gold"
>             End If
>        
>         Case "Sell"
>             Call PutVar(App.Path & "\data\accounts\houses.ini", "OPTIONS", "" & Player(Index).Name, 0)
>             GiveInvItem Index, GoldItemNum, HGold
>     End Select
>
>     Set Buffer = New clsBuffer
>     Buffer.WriteLong SSendHouse
>     Buffer.WriteString HType
>     Buffer.WriteLong HMapNum
>     SendDataTo Index, Buffer.ToArray()
>     Set Buffer = Nothing
> End Sub
>
> Sub HandleCheckGold(ByVal Index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
>     Dim Buffer As clsBuffer
>     Dim GoldItemNum As Long
>     Dim GoldAmount As Long
>     Dim HCancel As Long
>     Dim i As Long
>    
>     Set Buffer = New clsBuffer
>     Buffer.WriteBytes Data()
>     GoldItemNum = Buffer.ReadLong
>     GoldAmount = Buffer.ReadLong
>     HCancel = Buffer.ReadLong
>     Set Buffer = Nothing
>
>     If CheckGold(Index, GoldItemNum, GoldAmount) = True Then
>         If Not HCancel = 1 Then
>             TakeInvItem Index, GoldItemNum, GoldAmount
>             Set Buffer = New clsBuffer
>             Buffer.WriteLong SGoldChecked
>             SendDataTo Index, Buffer.ToArray()
>             Set Buffer = Nothing
>         Else
>             GiveInvItem Index, GoldItemNum, GoldAmount
>         End If
>     End If
> End Sub
>
> Sub HandleWarpToHouse(ByVal Index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
>     Dim Buffer As clsBuffer
>     Dim House As Long
>     Set Buffer = New clsBuffer
>     Buffer.WriteBytes Data()
>     Set Buffer = Nothing
>    
>     House = GetVar(App.Path & "\data\accounts\houses.ini", "OPTIONS", "" & Player(Index).Name)
>    
>     If House = 0 Then
>         If GetPlayerAccess(Index) < ADMIN_MAPPER Then
>             Exit Sub
>         End If
>     ElseIf House < 0 Or House > MAX_MAPS Then
>         Exit Sub
>     End If
>
>     Call PlayerWarp(Index, House, GetPlayerX(Index), GetPlayerY(Index))
>     Call PlayerMsg(Index, "You have been warped to your house.", BrightBlue)
>     Call AddLog(GetPlayerName(Index) & " warped to map #" & House & ", his/her house.", ADMIN_LOG)
> End Sub
> '[/House Editor]

**modServerTCP**

In MapCache_Create Find:

> Buffer.WriteByte .DirBlock

Add:

> Buffer.WriteString .Data4 'House Editor

At the bottom of the Module, Add:

> '[House Editor]
> Sub SendInitManager(ByVal Index As Long, ByVal MapOwner As Long, ByVal HMapNum As Long, ByVal HBuy As Long, ByVal HSell As Long)
>     Dim Buffer As clsBuffer
>     Dim HType As String
>     Dim HGold As Long
>    
>     If MapOwner = 0 Then
>         HType = "Buy"
>         HGold = HBuy
>     Else
>         If MapOwner = HMapNum Then
>             HType = "Sell"
>             HGold = HSell
>         Else
>             HType = "Nothing"
>             HGold = 0
>         End If
>     End If
>    
>     Set Buffer = New clsBuffer
>     Buffer.WriteLong SInitManager
>     Buffer.WriteLong HMapNum
>     Buffer.WriteString HType
>     Buffer.WriteLong HGold
>     SendDataTo Index, Buffer.ToArray()
>     Set Buffer = Nothing
> End Sub
>
> '[/House Editor]

**modTypes**

Find the type TileRec and add at the bottom of it:

> Data4 As String 'House Editor

Find the type NpcRec and add at the bottom of it:

> HMapNum As Long
>     HBuy As Long
>     HSell As Long

Find the type ResourceRec and add at the bottom of it:

> Spot As Byte

**modServerLoop**

In UpdateNpcAi, find the if cause below this:

> ' Check to see if its time for the npc to walk

And replace with

> If Npc(NpcNum).Behaviour <> NPC_BEHAVIOUR_SHOPKEEPER And Npc(NpcNum).Behaviour <> NPC_BEHAVIOUR_MANAGER Then 'House Editor

**modEnumerations**

Find

> STradeStatus

Add below:

> 'House Editor:
>     SEditHouse
>     SInitManager
>     SSendHouse
>     SGoldChecked

Find:

> CUntradeItem

Add below:

> 'House Editor:
>     CRequestEditHouse
>     CHouseManager
>     CCheckGold
>     CWarpToHouse

Find:

> Enum MapLayer

Add below, above the Layer_Count:

> Roof 'House Editor

**modPlayer**

Find:

> If .Type = TILE_TYPE_TRAP Then
>             Amount = .Data1
>             SendActionMsg GetPlayerMap(Index), "-" & Amount, BrightRed, ACTIONMSG_SCROLL, GetPlayerX(Index) * 32, GetPlayerY(Index) * 32, 1
>             If GetPlayerVital(Index, HP) - Amount <= 0 Then
>                 KillPlayer Index
>                 PlayerMsg Index, "You're killed by a trap.", BrightRed
>             Else
>                 SetPlayerVital Index, HP, GetPlayerVital(Index, HP) - Amount
>                 PlayerMsg Index, "You're injured by a trap.", BrightRed
>                 Call SendVital(Index, HP)
>             End If
>             Moved = YES
>         End If

Add below:

> 'House Editor
>         If .Type = TILE_TYPE_SIGN Then
>             PlayerMsg Index, "[Sign Reads]: " & .Data4, Yellow
>         End If
>         '/House Editor

Add at the bottom of the module:

> 'House Editor
> Function CheckGold(ByVal Index As Long, ByVal GoldItemNum As Long, ByVal GoldAmount As Long) As Boolean
>     Dim i As Long
>    
>     For i = 1 To MAX_INV
>         If GetPlayerInvItemNum(Index, i) = GoldItemNum Then
>             If Item(GoldItemNum).Type = ITEM_TYPE_CURRENCY Then
>                 If GoldAmount <= GetPlayerInvItemValue(Index, i) Then
>                     CheckGold = True 'Enought gold :)
>                 Else
>                     CheckGold = False 'Not enought gold :(
>                 End If
>             End If
>         End If
>     Next
> End Function
>
> Function GetOwner(ByVal Index As Long) As Boolean
>     GetOwner = False
>        
>     If Index > MAX_PLAYERS Then Exit Function
>     If GetVar(App.Path & "\data\accounts\houses.ini", "OPTIONS", "" & Player(Index).Name) = GetPlayerMap(Index) Then
>         GetOwner = True
>     End If
> End Function
> '/House Editor

**Client**

**frmMainGame**

Replace the entire sub "picScreen_MouseDown"

with this:

> Private Sub picScreen_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
>
>     If InMapEditor Then
>         '[House Editor]
>         If InHouseEditor = True Then
>             Call HouseEditorMouseDown(Button, X, Y, False)
>             Call SetFocusOnChat
>             Exit Sub
>         End If '[/House Editor]
>         Call MapEditorMouseDown(Button, X, Y, False)
>     Else
>         ' left click
>         If Button = vbLeftButton Then
>             ' if we're in the middle of choose the trade target or not
>             If Not TradeRequest Then
>                 ' targetting
>                 Call PlayerSearch(CurX, CurY)
>             Else
>                 ' trading
>                 Call SendTradeRequest(CurX, CurY)
>             End If
>         ' right click
>         ElseIf Button = vbRightButton Then
>             If ShiftDown Then
>                 ' admin warp if we're pressing shift and right clicking
>                 If GetPlayerAccess(MyIndex) >= 2 Then AdminWarp CurX, CurY
>             End If
>         End If
>     End If
>
>     Call SetFocusOnChat
> End Sub

In the sub: picScreen_MouseMove
Find:

> If InMapEditor Then

Add:

> '[House Editor]
>         If InHouseEditor = True Then
>             frmEditor_House.shpLoc.Visible = False
>             If Button = vbLeftButton Or Button = vbRightButton Then
>                 Call HouseEditorMouseDown(Button, X, Y)
>             End If
>             picItemDesc.Visible = False
>             Exit Sub
>         End If '[/House Editor]

Find:

> Case vbKeyF1
>             If Player(MyIndex).Access > 0 Then
>                 picAdmin.Visible = Not picAdmin.Visible
>             End If

Add:

> Case vbKeyF2 '[House Editor]
>             SendRequestEditHouse
>         Case vbKeyF3
>             If Map.Moral = 1 Then
>                 WarpToHouse
>             End If
>             '[/House Editor]

At the bottom of the form:

> '[House Editor]
> Private Sub lblHouseOk_Click()
>     Call SendHouseManager(lblHouseAsk.Tag, CInt(picHouse.Tag), CInt(lblHouseOk.Tag))
> End Sub
>
> Private Sub lblHouseCancel_Click()
>     picHouse.Visible = False
>     lblHouseCancel = "Decline"
> End Sub
>
> Private Sub lblHouseGoTo_Click()
>     picHouse.Visible = False
>     WarpToHouse
> End Sub
> '[/House Editor]

**frmEditor_NPC**

Replace cmbBehaviour_Click with this:

> Private Sub cmbBehaviour_Click()
>     Npc(EditorIndex).Behaviour = cmbBehaviour.ListIndex
>    
>     'House Editor
>     If (cmbBehaviour.ListIndex = NPC_BEHAVIOUR_MANAGER) Then
>         fraHouse.Visible = True
>     Else
>         fraHouse.Visible = False
>     End If '/House Editor
> End Sub

In Form Load, add:

> scrlHouseMapNumber.Max = MAX_MAPS 'House Editor

At the bottom of the form, add:

> 'House Editor
> Private Sub scrlHouseMapNumber_Change()
>     lblHouseMapNumber = "Map Number: " & scrlHouseMapNumber.Value
>     Npc(EditorIndex).HMapNum = scrlHouseMapNumber.Value
> End Sub
>
> Private Sub scrlHouseBuy_Change()
>     lblHouseBuy = "House Buy: " & scrlHouseBuy.Value
>     Npc(EditorIndex).HBuy = scrlHouseBuy.Value
> End Sub
>
> Private Sub scrlHouseSell_Change()
>     lblHouseSell = "House Sell: " & scrlHouseSell.Value
>     Npc(EditorIndex).HSell = scrlHouseSell.Value
> End Sub '/House Editor

**modClientTCP**

In SendMap, find "Buffer.WriteByte .DirBlock" and add:

> Buffer.WriteString .Data4

In Sub SendMap, at the bottom of the sub, before the end sub add:

> CanMoveNow = True

At the bottom of the module, add this:

> '[House Editor]
> Public Sub SendRequestEditHouse()
>     Dim Buffer As clsBuffer
>     Set Buffer = New clsBuffer
>     Buffer.WriteLong CRequestEditHouse
>     SendData Buffer.ToArray()
>     Set Buffer = Nothing
> End Sub
>
> Public Sub SendHouseManager(ByVal HType As String, ByVal HMapNum As Long, ByVal HGold As Long) 'ByVal HBuy As Long, ByVal HSell As Long)
>     Dim Buffer As clsBuffer
>     Set Buffer = New clsBuffer
>     Buffer.WriteLong CHouseManager
>     Buffer.WriteString HType
>     Buffer.WriteLong HMapNum
>     Buffer.WriteLong HGold
>     SendData Buffer.ToArray()
>     Set Buffer = Nothing
> End Sub
>
> Public Sub SendCheckGold(ByVal GoldItemNum As Long, ByVal GoldAmount As Long, Optional HCancel As Long)
>     Dim Buffer As clsBuffer
>     Set Buffer = New clsBuffer
>     Buffer.WriteLong CCheckGold
>     Buffer.WriteLong GoldItemNum
>     Buffer.WriteLong GoldAmount
>     Buffer.WriteLong HCancel
>     SendData Buffer.ToArray()
>     Set Buffer = Nothing
> End Sub
>
> Public Sub WarpToHouse()
>     Dim Buffer As clsBuffer
>     Set Buffer = New clsBuffer
>     Buffer.WriteLong CWarpToHouse
>     SendData Buffer.ToArray()
>     Set Buffer = Nothing
> End Sub
> '[/House Editor]

**modConstants**

Find this:

> ' ********************************************************
> ' * The values below must match with the server's values *
> ' ********************************************************

Add this before that:

> 'House Editor Normal Constants
> Public Const HOUSE_TILESET As Integer = 3
> Public Const HOUSE_MAX_X As Byte = 30
> Public Const HOUSE_MAX_Y As Byte = 30
> Public Const HOUSE_MUSIC As String = "\Data Files\music\"
> 'House Editor Attribute Constants
> Public Const HOUSE_GOLD As Long = 1
> Public Const HOUSE_ATTR_B As Integer = 2
> Public Const HOUSE_ATTR_B_UNDO As Integer = 1
> Public Const HOUSE_ATTR_S As Integer = 2
> Public Const HOUSE_ATTR_S_UNDO As Integer = 1
> Public Const HOUSE_ATTR_U As Integer = 3
> Public Const HOUSE_ATTR_U_UNDO As Integer = 1
> Public Const HOUSE_ATTR_R As Integer = 400
> Public Const HOUSE_ATTR_R_UNDO As Integer = 40

Find:

> Public Const MAP_MORAL_SAFE As Byte = 1

Add:

> Public Const MAP_MORAL_HOUSE As Byte = 2 'House Editor

Find:

> Public Const TILE_TYPE_SLIDE As Byte = 14

Add:

> 'House Editor
> Public Const TILE_TYPE_SIGN As Byte = 15
> Public Const TILE_TYPE_THRESHOLD As Byte = 16

Find:

> Public Const NPC_BEHAVIOUR_GUARD As Byte = 4

Add:

> Public Const NPC_BEHAVIOUR_MANAGER As Byte = 5 'House Editor

**modGlobals**

Add this at the bottom:

> 'House Editor
> Public InHouseEditor As Boolean
> Public HouseSign As String
> Public Threshold As Boolean
> Public SpotNum As Long

**modGameEditors**

In NPCEditorInit find:

> .txtEXP.text = Npc(EditorIndex).EXP

Add:

> 'House Editor:
>         .scrlHouseMapNumber.Value = Npc(EditorIndex).HMapNum
>         .scrlHouseBuy.Value = Npc(EditorIndex).HBuy
>         .scrlHouseSell.Value = Npc(EditorIndex).HSell

In ResourceEditorInit find:

> frmEditor_Resource.scrlAnimation.Value = Resource(EditorIndex).Animation

Add this:

> frmEditor_Resource.chkSpot.Value = Resource(EditorIndex).Spot 'House Editor

At the bottom of the module, add this:

> ' //////////////////
> ' // House Editor //
> ' //////////////////
> Public Sub HouseEditorInit()
>     Dim i As Long
>
>     InMapEditor = True
>     frmEditor_House.Visible = True
>     frmEditor_House.Caption = "House Editor - '" & Trim$(Map.Name) & "'"
>     InHouseEditor = True
>     Call InitDDSurf("misc", DDSD_Misc, DDS_Misc)
>     Call EditorHouse_BltTileset
>     frmEditor_House.scrlPictureY.Max = (frmEditor_House.picBackSelect.height \ PIC_Y) - (frmEditor_House.picBack.height \ PIC_Y)
>     frmEditor_House.scrlPictureX.Max = (frmEditor_House.picBackSelect.width \ PIC_X) - (frmEditor_House.picBack.width \ PIC_X)
>     If frmEditor_House.fMusic.Path <> App.Path & HOUSE_MUSIC Then frmEditor_House.fMusic.Path = App.Path & HOUSE_MUSIC
>
>     With frmEditor_House
>         .cmdSend.Enabled = True
>         .cmdCancel.Enabled = True
>        
>         .txtName.text = Trim$(Map.Name)
>         If .fMusic.ListIndex >= 0 Then
>             .fMusic.ListIndex = 0
>             For i = 1 To .fMusic.ListIndex
>                 If .fMusic.List(i) = Trim$(Map.Music) Then
>                     .fMusic.ListIndex = i
>                 End If
>             Next
>         End If
>         If Trim$(Map.Music) = vbNullString Then .chkMusic.Value = 1
>     End With
> End Sub
>
> Public Sub HouseEditorSetTile(ByVal X As Long, ByVal Y As Long, ByVal CurLayer As Long, Optional ByVal multitile As Boolean = False)
> Dim x2 As Long, y2 As Long
>
>     If Not multitile Then
>         With Map.Tile(X, Y)
>             .Layer(CurLayer).X = EditorTileX
>             .Layer(CurLayer).Y = EditorTileY
>             .Layer(CurLayer).tileset = frmEditor_House.chkTileset.Caption
>         End With
>     Else
>         y2 = 0
>         For Y = CurY To CurY + EditorTileHeight - 1
>             x2 = 0
>             For X = CurX To CurX + EditorTileWidth - 1
>                 If X >= 0 And X <= Map.MaxX Then
>                     If Y >= 0 And Y <= Map.MaxY Then
>                         With Map.Tile(X, Y)
>                             .Layer(CurLayer).X = EditorTileX + x2
>                             .Layer(CurLayer).Y = EditorTileY + y2
>                             .Layer(CurLayer).tileset = frmEditor_House.chkTileset.Caption
>                         End With
>                     End If
>                 End If
>                 x2 = x2 + 1
>             Next
>             y2 = y2 + 1
>         Next
>     End If
> End Sub
>
> Public Sub HouseEditorMouseDown(ByVal Button As Integer, ByVal X As Long, ByVal Y As Long, Optional ByVal movedMouse As Boolean = True)
> Dim i As Long
> Dim CurLayer As Long
> Dim tmpDir As Byte
>
>     For i = 1 To MapLayer.Layer_Count - 1
>         If frmEditor_House.optLayer(i).Value Then
>             CurLayer = i
>             Exit For
>         End If
>     Next
>
>     If Not isInBounds Then Exit Sub
>     If Button = vbLeftButton Then
>         If frmEditor_House.optLayers.Value Then
>             If EditorTileWidth = 1 And EditorTileHeight = 1 Then
>                 HouseEditorSetTile CurX, CurY, CurLayer
>             Else
>                 HouseEditorSetTile CurX, CurY, CurLayer, True
>             End If
>         ElseIf frmEditor_House.optAttributes.Value Then
>             With Map.Tile(CurX, CurY)
>                 If frmEditor_House.optBlocked.Value Then
>                     If .Type <> TILE_TYPE_BLOCKED Then SendCheckGold HOUSE_GOLD, HOUSE_ATTR_B
>                 ElseIf frmEditor_House.optSign.Value Then
>                     If .Type <> TILE_TYPE_SIGN Then SendCheckGold HOUSE_GOLD, HOUSE_ATTR_S
>                 ElseIf frmEditor_House.optThreshold.Value Then
>                     If .Type <> TILE_TYPE_THRESHOLD Then SendCheckGold HOUSE_GOLD, HOUSE_ATTR_U
>                 ElseIf frmEditor_House.optSpot.Value Then
>                     If .Type <> TILE_TYPE_RESOURCE Then SendCheckGold HOUSE_GOLD, HOUSE_ATTR_R
>                 End If
>             End With
>         End If
>     End If
>
>     If Button = vbRightButton Then
>         If frmEditor_House.optLayers.Value Then
>             With Map.Tile(CurX, CurY)
>                 .Layer(CurLayer).X = 0
>                 .Layer(CurLayer).Y = 0
>                 .Layer(CurLayer).tileset = 0
>             End With
>         ElseIf frmEditor_House.optAttributes.Value Then
>             With Map.Tile(CurX, CurY)
>                 If .Type = TILE_TYPE_BLOCKED Then SendCheckGold HOUSE_GOLD, HOUSE_ATTR_B_UNDO, 1
>                 If .Type = TILE_TYPE_SIGN Then SendCheckGold HOUSE_GOLD, HOUSE_ATTR_S_UNDO, 1
>                 If .Type = TILE_TYPE_THRESHOLD Then SendCheckGold HOUSE_GOLD, HOUSE_ATTR_U_UNDO, 1
>                 If .Type = TILE_TYPE_RESOURCE Then SendCheckGold HOUSE_GOLD, HOUSE_ATTR_R_UNDO, 1
>                 .Type = 0
>                 .Data1 = 0
>                 .Data2 = 0
>                 .Data3 = 0
>             End With
>         End If
>     End If
> End Sub
>
> Public Sub HouseEditorChooseTile(Button As Integer, X As Single, Y As Single)
>
>     If Button = vbLeftButton Then
>    
>         EditorTileWidth = 1
>         EditorTileHeight = 1
>        
>         EditorTileX = X \ PIC_X
>         EditorTileY = Y \ PIC_Y
>        
>         frmEditor_House.shpSelected.Top = EditorTileY * PIC_Y
>         frmEditor_House.shpSelected.Left = EditorTileX * PIC_X
>        
>         frmEditor_House.shpSelected.width = PIC_X
>         frmEditor_House.shpSelected.height = PIC_Y
>     End If
>
> End Sub
>
> Public Sub HouseEditorDrag(Button As Integer, X As Single, Y As Single)
>
>     If Button = vbLeftButton Then
>         X = (X \ PIC_X) + 1
>         Y = (Y \ PIC_Y) + 1
>
>         If X < 0 Then X = 0
>         If X > frmEditor_House.picBackSelect.width / PIC_X Then X = frmEditor_House.picBackSelect.width / PIC_X
>         If Y < 0 Then Y = 0
>         If Y > frmEditor_House.picBackSelect.height / PIC_Y Then Y = frmEditor_House.picBackSelect.height / PIC_Y
>
>         If X > EditorTileX Then
>             EditorTileWidth = X - EditorTileX
>         Else
>             ' TO DO
>         End If
>         If Y > EditorTileY Then
>             EditorTileHeight = Y - EditorTileY
>         Else
>             ' TO DO
>         End If
>         frmEditor_House.shpSelected.width = EditorTileWidth * PIC_X
>         frmEditor_House.shpSelected.height = EditorTileHeight * PIC_Y
>     End If
>
> End Sub
>
> Public Sub HouseEditorTileScroll()
>     frmEditor_House.picBackSelect.Top = (frmEditor_House.scrlPictureY.Value * PIC_Y) * 1
>     frmEditor_House.picBackSelect.Left = (frmEditor_House.scrlPictureX.Value * PIC_X) '* -1
> End Sub
>
> Public Sub HouseEditorSend()
>     Call SendMap
>     InMapEditor = False
>     frmEditor_House.Visible = False
>     Set DDS_Misc = Nothing
> End Sub
>
> Public Sub HouseEditorCancel()
>     Dim Buffer As clsBuffer
>     Set Buffer = New clsBuffer
>     Buffer.WriteLong CNeedMap
>     Buffer.WriteLong 1
>     SendData Buffer.ToArray()
>     InMapEditor = False
>     frmEditor_House.Visible = False
>     Set DDS_Misc = Nothing
> End Sub
>
> Public Sub HouseEditorClearLayer()
> Dim i As Long
> Dim X As Long
> Dim Y As Long
> Dim CurLayer As Long
>
>     For i = 1 To MapLayer.Layer_Count - 1
>         If frmEditor_House.optLayer(i).Value Then
>             CurLayer = i
>             Exit For
>         End If
>     Next
>    
>     If CurLayer = 0 Then Exit Sub
>
>     If MsgBox("Are you sure you wish to clear this layer?", vbYesNo, GAME_NAME) = vbYes Then
>         For X = 0 To Map.MaxX
>             For Y = 0 To Map.MaxY
>                 Map.Tile(X, Y).Layer(CurLayer).X = 0
>                 Map.Tile(X, Y).Layer(CurLayer).Y = 0
>                 Map.Tile(X, Y).Layer(CurLayer).tileset = 0
>             Next
>         Next
>     End If
> End Sub
>
> Public Sub HouseEditorFillLayer()
> Dim i As Long
> Dim X As Long
> Dim Y As Long
> Dim CurLayer As Long
>
>     For i = 1 To MapLayer.Layer_Count - 1
>         If frmEditor_House.optLayer(i).Value Then
>             CurLayer = i
>             Exit For
>         End If
>     Next
>
>     If MsgBox("Are you sure you wish to fill this layer?", vbYesNo, GAME_NAME) = vbYes Then
>         For X = 0 To Map.MaxX
>             For Y = 0 To Map.MaxY
>                 Map.Tile(X, Y).Layer(CurLayer).X = EditorTileX
>                 Map.Tile(X, Y).Layer(CurLayer).Y = EditorTileY
>                 Map.Tile(X, Y).Layer(CurLayer).tileset = frmEditor_House.chkTileset.Caption
>             Next
>         Next
>     End If
> End Sub
>
> Public Sub HouseEditorClearAttribs()
>     Dim X As Long
>     Dim Y As Long
>
>     If MsgBox("Are you sure you wish to clear the attributes on this house?", vbYesNo, GAME_NAME) = vbYes Then
>
>         For X = 0 To Map.MaxX
>             For Y = 0 To Map.MaxY
>                 Map.Tile(X, Y).Type = 0
>             Next
>         Next
>
>     End If
>
> End Sub
>
> Public Sub HouseEditorLeaveMap()
>
>     If InMapEditor Then
>         If MsgBox("Save changes to current house?", vbYesNo) = vbYes Then
>             Call HouseEditorSend
>         Else
>             Call HouseEditorCancel
>         End If
>     End If
>
> End Sub
>
> Public Sub HideHouseAttributes()
>     With frmEditor_House
>         .fraHSign.Visible = False
>         .fraHSpot.Visible = False
>     End With
> End Sub
> '[/HOUSE EDITOR]

**modDirectDraw7**

Add this sub:

> 'House Editor
> Public Sub BltHouseRoof(ByVal X As Long, ByVal Y As Long)
>     Dim rec As DxVBLib.RECT
>     Dim i As Long
>
>     With Map.Tile(X, Y)
>         i = MapLayer.Roof
>             If .Layer(i).tileset > 0 Then
>                 rec.Top = .Layer(i).Y * PIC_Y
>                 rec.Bottom = rec.Top + PIC_Y
>                 rec.Left = .Layer(i).X * PIC_X
>                 rec.Right = rec.Left + PIC_X
>                
>                 If Not Threshold = True Then
>                     Call Engine_BltFast(ConvertMapX(X * PIC_X), ConvertMapY(Y * PIC_Y), DDS_Tileset(.Layer(i).tileset), rec, DDBLTFAST_WAIT Or DDBLTFAST_SRCCOLORKEY)
>                 End If
>             End If
>     End With
> End Sub
> '/House Editor
>
> '[House Editor]
> Public Sub EditorHouse_BltTileset()
>     Dim height As Long
>     Dim width As Long
>     Dim tileset As Byte
>     Dim sRECT As DxVBLib.RECT
>     Dim dRECT As DxVBLib.RECT
>    
>     ' find tileset number
>     tileset = frmEditor_House.chkTileset.Caption
>    
>     ' exit out if doesn't exist
>     If tileset < 0 Or tileset > NumTileSets Then Exit Sub
>    
>     ' make sure it's loaded
>     If DDS_Tileset(tileset) Is Nothing Then
>         Call InitDDSurf("tilesets\" & tileset, DDSD_Tileset(tileset), DDS_Tileset(tileset))
>     End If
>    
>     height = DDSD_Tileset(tileset).lHeight
>     width = DDSD_Tileset(tileset).lWidth
>    
>     dRECT.Top = 0
>     dRECT.Bottom = height
>     dRECT.Left = 0
>     dRECT.Right = width
>    
>     frmEditor_House.picBackSelect.height = height
>     frmEditor_House.picBackSelect.width = width
>    
>     Call Engine_BltToDC(DDS_Tileset(tileset), sRECT, dRECT, frmEditor_House.picBackSelect)
> End Sub
> '[/House Editor]

Find this:

> For Y = TileView.Top To TileView.Bottom
>                 If IsValidMapPoint(X, Y) Then
>                     Call BltMapFringeTile(X, Y)

Add this below that, before the end if:

> Call BltHouseRoof(X, Y) 'House Editor

Find this:

> ' Blit out map attributes
>     If InMapEditor Then
>         Call BltMapAttributes
>     End If

Replace with this:

> ' Blit out map attributes
>     If InMapEditor Then
>         Call BltMapAttributes
>         Call BltHouseAttributes 'House Editor
>     End If

**modEnumerations**

Find:

> STradeStatus

Add:

> 'House Editor:
>     SEditHouse
>     SInitManager
>     SSendHouse
>     SGoldChecked

Find:

> CUntradeItem

Add:

> 'House Editor:
>     CRequestEditHouse
>     CHouseManager
>     CCheckGold
>     CWarpToHouse

Find Enum MapLayer, at the bottom before Layer_Count, add:

> Roof 'House Editor

**modHandleData**

Find:

> HandleDataSub(STradeStatus) = GetAddress(AddressOf HandleTradeStatus)

Add:

> 'House Editor:
>     HandleDataSub(SEditHouse) = GetAddress(AddressOf HandleEditHouse)
>     HandleDataSub(SInitManager) = GetAddress(AddressOf HandleInitManager)
>     HandleDataSub(SSendHouse) = GetAddress(AddressOf HandleSendHouse)
>     HandleDataSub(SGoldChecked) = GetAddress(AddressOf HandleGoldChecked)

In HandleMapData, find:

> Map.Tile(X, Y).DirBlock = Buffer.ReadByte

Add this:

> Map.Tile(X, Y).Data4 = Buffer.ReadString 'House Editor

At the bottom of the module add this:

> '[House Editor]
> Private Sub HandleEditHouse(ByVal Index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
>     Dim Buffer As clsBuffer
>     Dim Owner As Long
>     Set Buffer = New clsBuffer
>     Buffer.WriteBytes Data()
>     Owner = Buffer.ReadLong
>     If Not Owner = GetPlayerMap(Index) Then Exit Sub
>     Call HouseEditorInit
> End Sub
>
> Private Sub HandleInitManager(ByVal Index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
>     Dim Buffer As clsBuffer
>     Dim HMapNum As Long
>     Dim HType As String
>     Dim HGold As Long
>    
>     Set Buffer = New clsBuffer
>     Buffer.WriteBytes Data()
>     HMapNum = Buffer.ReadLong
>     HType = Buffer.ReadString
>     HGold = Buffer.ReadLong
>     Set Buffer = Nothing
>    
>     With frmMainGame
>         Select Case HType
>             Case "Buy"
>                 .picHouse.Visible = True
>                 .lblHouseOk.Visible = True
>                 .lblHouseCancel.Visible = True
>                 .lblHouseGoTo.Visible = False
>                 .lblHouseAsk = "Buy this house for " & HGold & "?"
>                 .picHouse.Tag = HMapNum
>                 .lblHouseAsk.Tag = HType
>                 .lblHouseOk.Tag = HGold
>            
>             Case "Sell"
>                 .picHouse.Visible = True
>                 .lblHouseOk.Visible = True
>                 .lblHouseCancel.Visible = True
>                 .lblHouseGoTo.Visible = False
>                 .lblHouseAsk = "Sell your house for " & HGold & "?"
>                 .picHouse.Tag = HMapNum
>                 .lblHouseAsk.Tag = HType
>                 .lblHouseOk.Tag = HGold
>            
>             Case "Nothing"
>                 Exit Sub
>                
>         End Select
>        
>        
>     End With
> End Sub
>
> Private Sub HandleSendHouse(ByVal Index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
>     Dim Buffer As clsBuffer
>     Dim HType As String
>     Dim HMapNum As Long
>    
>     Set Buffer = New clsBuffer
>     Buffer.WriteBytes Data()
>     HType = Buffer.ReadString
>     HMapNum = Buffer.ReadLong
>     Set Buffer = Nothing
>    
>     With frmMainGame
>         Select Case HType
>             Case "Buy"
>                 .lblHouseOk.Visible = False
>                 .lblHouseCancel.Visible = False
>                 .lblHouseGoTo.Visible = True
>                 .lblHouseAsk = "House bought!"
>                 .picHouse.Tag = HMapNum
>            
>             Case "Sell"
>                 .lblHouseOk.Visible = False
>                 .lblHouseCancel = "Close"
>                 .lblHouseAsk = "House sold!"
>                 .picHouse.Tag = 0
>            
>             Case "Gold"
>                 .picHouse.Visible = False
>                 MsgBox "Not enought gold!", vbInformation, "" & GAME_NAME
>                
>         End Select
>     End With
> End Sub
>
> Private Sub HandleGoldChecked(ByVal Index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
>     Dim Buffer As clsBuffer
>    
>     Set Buffer = New clsBuffer
>     Buffer.WriteBytes Data()
>     Set Buffer = Nothing
>    
>     If InHouseEditor = True Then
>         With Map.Tile(CurX, CurY)
>             If frmEditor_House.optBlocked.Value Then
>                 .Type = TILE_TYPE_BLOCKED
>                 .Data1 = 0
>                 .Data2 = 0
>                 .Data3 = 0
>             ElseIf frmEditor_House.optSign.Value Then
>                 .Type = TILE_TYPE_SIGN
>                 .Data1 = 0
>                 .Data2 = 0
>                 .Data3 = 0
>                 .Data4 = CStr(HouseSign)
>             ElseIf frmEditor_House.optThreshold.Value Then
>                 .Type = TILE_TYPE_THRESHOLD
>                 .Data1 = 0
>                 .Data2 = 0
>                 .Data3 = 0
>             ElseIf frmEditor_House.optSpot.Value Then
>                 .Type = TILE_TYPE_RESOURCE
>                 .Data1 = SpotNum
>                 .Data2 = 0
>                 .Data3 = 0
>             End If
>         End With
>     End If
> End Sub
>
> '[/House Editor]

**frmEditor_Resource**

At the bottom, add:

> 'House Editor:
> Private Sub chkSpot_Click()
>     Resource(EditorIndex).Spot = chkSpot.Value
> End Sub

**modText**

Add this:

> '[House Editor]
> Public Function BltHouseAttributes()
>     Dim X As Long
>     Dim Y As Long
>     Dim tX As Long
>     Dim tY As Long
>
>     If frmEditor_House.optAttributes.Value = True Then
>         For X = TileView.Left To TileView.Right
>             For Y = TileView.Top To TileView.Bottom
>                 If IsValidMapPoint(X, Y) Then
>                     With Map.Tile(X, Y)
>                         tX = ((ConvertMapX(X * PIC_X)) - 4) + (PIC_X * 0.5)
>                         tY = ((ConvertMapY(Y * PIC_Y)) - 7) + (PIC_Y * 0.5)
>                         Select Case .Type
>                             Case TILE_TYPE_BLOCKED
>                                 DrawText TexthDC, tX, tY, "B", QBColor(BrightRed)
>                             Case TILE_TYPE_SIGN
>                                 DrawText TexthDC, tX, tY, "S", QBColor(Yellow)
>                             Case TILE_TYPE_THRESHOLD
>                                 DrawText TexthDC, tX, tY, "T", QBColor(BrightCyan)
>                             Case TILE_TYPE_RESOURCE
>                                 DrawText TexthDC, tX, tY, "S", QBColor(BrightGreen)
>                         End Select
>                     End With
>                 End If
>             Next
>         Next
>     End If
>
> End Function
> '[/House Editor]

**modTypes**

In TileRec, find DirBlock As Byte
Add this:

> Data4 As String 'House Editor

In NPCRec, find Animation As Long
Add this:

> 'House Editor:
>     HMapNum As Long
>     HBuy As Long
>     HSell As Long

In ResourceRec, find Animation As Long
Add this:

> Spot As Byte 'House Editor

**modGameLogic**

in CheckDirection, Find:

> Case DIR_RIGHT
>             X = GetPlayerX(MyIndex) + 1
>             Y = GetPlayerY(MyIndex)
>     End Select

Add this:

> 'House Editor
>     If Map.Tile(X, Y).Type = TILE_TYPE_THRESHOLD Then
>         Threshold = Not Threshold
>         Exit Function
>     End If '/House Editor

In UpdateDrawMapName Find:

> Case MAP_MORAL_SAFE
>             DrawMapNameColor = QBColor(White)

Add this:

> 'House Editor
>         Case MAP_MORAL_HOUSE
>             DrawMapNameColor = QBColor(BrightCyan)
>         '/House Editor

**Extras**

In frmMainGame add:
• PictureBox: picHouse
• Label: lblHouseAsk
• Label: lblHouseOK
• Label: lblHouseGoTo (visible false)
• Label: lblHouseCancel

Use this image as reference:


Download the **frmEditor_House**, add to the project.

And that's all ;D credits to me (?) :P

[MarBos]

I will give this a try. If it works out, it's a very great addition.

Thank you for investing your time to create tutorials for the community :)

[erkro1]

Do you need to delete all old maps?

[kibbelz]

Im glad that you are posting thisas a tutorial because i prefere to have the tutorial on how to add stuff rather then download the finnished source and then have to add all of my code into that. I have a guild system, and a recruitment system which i made in my game and that will take AGES to convert. Although its always good to have a download link for non-vb6 users can still use the source. Nice work keep it up!

[crzyone9584]

@erkro1:

> Do you need to delete all old maps?

Thats my question. Is there anyway to save a map from having to be deleted?

[Helladen]

No. You would have to make a converter.

[erkro1]

Please, would someone make an converter?  ;D

[crzyone9584]

Ok thanks Helladen. Off to finish client edits then to re create the only map there is lol.

[Helladen]

Late reply but just don't add the sign part with the data 4 if you want to keep your maps without converting. The data 4 is basically another attribute data type, it allows it to hold strings, such as messages. So if you don't want that then just don't add it.

[erkro1]

@Helladen:

> Late reply but just don't add the sign part with the data 4 if you want to keep your maps without converting. The data 4 is basically another attribute data type, it allows it to hold strings, such as messages. So if you don't want that then just don't add it.

So when we don't add this :

> Data4 As String 'House Editor

It works without we need to delete all maps?

[Helladen]

You won't have to delete map if you don't add the sign attribute and data 4\. The sign attribute requires a string data type from the map.

[erkro1]

Ok, thanks for your help :cheesy:

[crzyone9584]

Thanks for the info. But I've started to work on creating the new map. Wish I knew this before i started to remap the main map.

[Iann]

House Editor In Eclipse Origins V1.3.1 ??

[Jhow]

It works in the 1.5.0?

[Guest]

Wow, thats a hell of a lot of code additions. Great job on it. I hope it works good and doesn't couse some kind of problems somewhere else in the engine.
I will be looking for that modified easyer to use version you mentioned.

[Alatar]

Hmm this was made for EO 1.1.0 if i remember well, I don't know if it would work perfectly on the last version. Anyways is not the best way on doing this, but it works xD

[Fbu]

In the custom EO you give, the directional blocks no longer work.

[wiimanclassic]

Question. What if a player leaves for a few months or something? What would you do to put the house back on the market? Just delete and recreate the NPC?

Also what would need to be done for this to work with 1.4?

[Jacquelinett]

Both the download version and the code doesnt work for me :-/

for the code, im using EO 2.0

[McCull96]

@TianaJRP:

> Both the download version and the code doesnt work for me :-/
>
> for the code, im using EO 2.0

This was made with EO 1.0 so you will most likely need to change parts of the code to get it to work

[Whackeddie99]

I'd like to use this for 2.0, too bad it doesn't work :(

[Jacquelinett]

but even when i download his source version, still doesnt work!

[crzyone9584]

@Whackeddie99:

> I'd like to use this for 2.0, too bad it doesn't work :(

yes it does. He just left out forms you need. I have it working with all orginal code.

[Jacquelinett]

@crzyone9584:

> yes it does. He just left out forms you need. I have it working with all orginal code.

then can you please help us to get this work, please B(