(EO)House System

[tslusny]

Ok i fixed Alatars House System, i finnaly added tutorial 

Default key for open house editor is: DELETE

Default key for house teleport is: HOME

Download this: [Download from Mediafire](http://www.mediafire.com/?530ip9wrd91ucpe)

TUTORIAL

SERVER SIDE

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.MP) = GetPlayerMaxVital(Index, Vitals.MP)
```

Add:

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

modGameLogic

Find:

```
If IsSpell Then
```

Replace with:

```
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

CanPlayerAttackNpc = 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

At bottom of Sub InitMessages add:

```
HandleDataSub(CRequestEditHouse) = GetAddress(AddressOf HandleRequestEditHouse)

HandleDataSub(CHouseManager) = GetAddress(AddressOf HandleHouseManager)

HandleDataSub(CCheckGold) = GetAddress(AddressOf HandleCheckGold)

HandleDataSub(CWarpToHouse) = GetAddress(AddressOf HandleWarpToHouse)
```

In Sub HandleWarpMeTo find:

```
If GetPlayerAccess(Index) < ADMIN_MAPPER Then

Exit Sub

End If
```

Replace it with this:

```
'[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 botom of ModHandleData add:

```
'Deathbeam - Alatar House system fix

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)

Call AddHouse(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)

Call DeleteHouse(HMapNum)

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 Not HCancel = 1 Then

If CheckGold(index, GoldItemNum, GoldAmount) = True Then

TakeInvItem index, GoldItemNum, GoldAmount

Set Buffer = New clsBuffer

Buffer.WriteLong SGoldChecked

SendDataTo index, Buffer.ToArray()

Set Buffer = Nothing

Else

PlayerMsg index, "Not enought gold", BrightRed

End If

Else

GiveInvItem index, GoldItemNum, GoldAmount

End If

End Sub

Sub HandleWarpToHouse(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)

Dim House As Long

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

'Deathbeam - Alatar House system fix
```

ModServerTCP

Find:

```
Buffer.WriteByte .DirBlock
```

Add:

```
Buffer.WriteString .Data4 'House Editor
```

At bottom of ModServerTCP add:

```
'Deathbeam - Alatar House system fix

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

If FindHouse(HMapNum) Then

Call PlayerMsg(index, "This house is already sold", White)

Else

HType = "Buy"

HGold = HBuy

End If

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

'Deathbeam - Alatar House system fix
```

ModTypes:

Find type TileRec and add at bottom of it:

```
Data4 As String 'House Editor
```

Find Type NpcRec and add at bottom of it:

```
HMapNum As Long

HBuy As Long

HSell As Long
```

Find type ResourceRec and add at bottom of it:

```
Spot As Byte
```

modServerLoop

In UpdateMapLogic, find the if cause below this:

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

And replace it with:

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

modEnumerations

Find:

```
' Make sure SMSG_COUNT is below everything else
```

Add above it:

```
'House Editor:

SEditHouse

SInitManager

SSendHouse

SGoldChecked
```

Find:

```
' Make sure CMSG_COUNT is below everything else
```

Add above it:

```
'House Editor:

CRequestEditHouse

CHouseManager

CCheckGold

CWarpToHouse
```

Find:

```
Enum MapLayer
```

And add above Layer_Count:

```
Roof 'House Editor
```

modPlayer

Find:

```
If .Type = TILE_TYPE_SLIDE Then

ForcePlayerMove index, MOVING_WALKING, .Data1

Moved = YES

End If
```

Add below it:

```
'House Editor

If .Type = TILE_TYPE_HOUSESIGN Then

PlayerMsg index, "[Sign Reads]: " & .Data4, Yellow

End If

'/House Editor
```

Add at bottom of ModPlayer:

```
'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
```

ModDatabase

Add this at bottom of ModDatabase:

```
'Deathbeam - Alatar House system fix

Sub DeleteHouse(ByVal HMapNum As Long)

Dim f1 As Long

Dim f2 As Long

Dim s As String

Call FileCopy(App.Path & "\data\accounts\houses.txt", App.Path & "\data\accounts\housestemp.txt")

' Destroy house from houses

f1 = FreeFile

Open App.Path & "\data\accounts\housestemp.txt" For Input As #f1

f2 = FreeFile

Open App.Path & "\data\accounts\houses.txt" For Output As #f2

Do While Not EOF(f1)

Input #f1, s

If s <> HMapNum Then

Print #f2, s

End If

Loop

Close #f1

Close #f2

Call Kill(App.Path & "\data\accounts\housestemp.txt")

End Sub

Sub AddHouse(ByVal HMapNum As Long)

Dim F As Long

F = FreeFile

Open App.Path & "\data\accounts\houses.txt" For Append As #F

Print #F, HMapNum

Close #F

End Sub

Function FindHouse(ByVal HMapNum As Long) As Boolean

Dim F As Long

Dim s As String

F = FreeFile

Open App.Path & "\data\accounts\houses.txt" For Input As #F

Do While Not EOF(F)

Input #F, s

If s = HMapNum Then

FindHouse = True

Close #F

Exit Function

End If

Loop

Close #F

End Function

'Deathbeam - Alatar House system fix
```

CLIENT SIDE

In Private Sub picScreen_MouseDown find:

```
If InMapEditor Then

Call MapEditorMouseDown(Button, x, y, False)

Else
```

Replace it with this:

```
If InMapEditor Then

'[House Editor]

If InHouseEditor = True Then

Call HouseEditorMouseDown(Button, X, Y, False)

Exit Sub

End If '[/House Editor]

Call MapEditorMouseDown(Button, X, Y, False)

Else
```

In the sub: picScreen_MouseMove find:

```
If InMapEditor Then

frmEditor_Map.shpLoc.Visible = False

If Button = vbLeftButton Or Button = vbRightButton Then

Call MapEditorMouseDown(Button, x, y)

End If

End If
```

Replace it with this:

```
If InMapEditor Then

'[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]

frmEditor_Map.shpLoc.visible = False

If Button = vbLeftButton Or Button = vbRightButton Then

Call MapEditorMouseDown(Button, X, Y)

End If

End If
```

Find:

```
Case vbKeyInsert
```

Add this below it:

```
Case vbKeyDelete 'Deathbeam - Alatar House system fix

SendRequestEditHouse

Case vbKeyHome

If Map.Moral = 1 Then

WarpToHouse

End If 'Deathbeam - Alatar House system fix
```

At bottom of frmMain add:

```
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

Find this:

```
NPC(EditorIndex).Behaviour = cmbBehaviour.ListIndex
```

Add this below it:

```
'House Editor

If (cmbBehaviour.ListIndex = NPC_BEHAVIOUR_MANAGER) Then

fraHouse.visible = True

Else

fraHouse.visible = False

End If '/House Editor
```

In Form Load, add:

```
scrlHouseMapNumber.Max = MAX_MAPS 'House Editor
```

At bottom of frmEditor_NPC add:

```
'/ALATAR

'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

Find:

```
Buffer.WriteByte .DirBlock
```

Add:

```
Buffer.WriteString .Data4
```

At bottom of ModClientTcp add this:

```
'Deathbeam - Alatar House system fix

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

'Deathbeam - Alatar House system fix
```

modConstants

Find this:

```
' ********************************************************

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

' ********************************************************
```

Add this above:

```
'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 bottom of ModGameEditors 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, Options.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, Options.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, Options.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

At bottom add this:

```
'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:

```
If NumTileSets > 0 Then

For X = TileView.Left To TileView.Right

For Y = TileView.top To TileView.Bottom

If IsValidMapPoint(X, Y) Then

Call BltMapFringeTile(X, Y)

End If

Next

Next

End If
```

Under:

```
Call BltMapFringeTile(X, Y)
```

Add this:

```
Call BltHouseRoof(X, Y) 'House Editor
```

Find this:

```
' Blit out map attributes

If InMapEditor Then

Call BltMapAttributes

End If
```

Replace it with this:

```
' Blit out map attributes

If InMapEditor Then

Call BltMapAttributes

Call BltHouseAttributes 'House Editor

End If
```

ModEnumerations

Find this:

```
' Make sure SMSG_COUNT is below everything else
```

Add this above:

```
'House Editor:

SEditHouse

SInitManager

SSendHouse

SGoldChecked
```

Find this:

```
' Make sure CMSG_COUNT is below everything else
```

Add this above:

```
'House Editor:

CRequestEditHouse

CHouseManager

CCheckGold

CWarpToHouse
```

Find Enum MapLayer and add above:

```
Layer_Count
```

this:

```
Roof 'House Editor
```

ModHandleData

At bottom of sub InitMessages add:

```
'House Editor:

HandleDataSub(SEditHouse) = GetAddress(AddressOf HandleEditHouse)

HandleDataSub(SInitManager) = GetAddress(AddressOf HandleInitManager)

HandleDataSub(SSendHouse) = GetAddress(AddressOf HandleSendHouse)

HandleDataSub(SGoldChecked) = GetAddress(AddressOf HandleGoldChecked)
```

Find:

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

```
Add this:

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

At bottom of ModHandleData 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 frmMain

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 frmMain

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, "" & Options.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)

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 Function CheckDirection, Find:

```
Case DIR_RIGHT

X = GetPlayerX(MyIndex) + 1

Y = GetPlayerY(MyIndex)

End Select
```

Add this below it:

```
'House Editor

If Map.Tile(X, Y).Type = TILE_TYPE_THRESHOLD Then

Threshold = Not Threshold

Exit Function

End If '/House Editor
```

In Public Sub UpdateDrawMapName() find:

```
Case MAP_MORAL_SAFE

DrawMapNameColor = QBColor(White)
```

Add this below it:

```
Case MAP_MORAL_HOUSE

DrawMapNameColor = QBColor(BrightCyan)

'/House Editor
```

FORM WORK:

Copy picHouse with everything in it from House Speech.frm, what i added to attachments (its in file HouseFiles.rar) , to your frmMain (this pic is used for talking with npc manager).

Add frmEditor_House.frm to your project (its located in HouseFiles.rar too)

Add checkbox to frmEditor_Resource with:

Name: chkSpot

Caption: Spot?

In frmEditor_NPC

add to cmbBehavior list new item **Manager**

add fraHouse with everything in it from House NPC Editor Frame.frm (included in HouseFiles.rar)

to frmEditor_NPC (u must make some room for this)

In frmEditor_MapProperties

add to cmbMoral list new item **House**

And now youre done 

I think i dont forget anything.

Please post any bugs u found.

[erkro1]

Can you maybe make a tutorial with what you've changed to fix it?

[tslusny]

Yea of course i can :D

Give me few minutes :D
I cant find original post so i must redo tutorial

[tslusny]

Ok tutorial finished :DDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDD

[JohnPony]

- Snip. FAIL!

[tslusny]

@John:

> Here is the original tutorial: http://www.touchofdeathforums.com/smf2/index.php/topic,70502.560.html
> took me some time to find it xD

This is link for Alatars Quest System, i think original house system post is deleted already

[JohnPony]

@Deathbeam:

> This is link for Alatars Quest System, i think original house system post is deleted already

Epic fail on my part, i just seen Alatar's pop up after 10 minuets of searching and got excited xD

[tslusny]

:DD But + 1 for Effort :cheesy:

[Justn]

I don't see where u fixed the issue with people being able to buy houses owned by other players? Can u show where that part is?

wait I found out where u fixed it at… Was bugging me I gave up on this awhile ago cause I couldn't fix that problem thanks a lot...  You have any plans of converting the ini file to a utd? :p thanks for sharing and glad someone got it working correctly..

Edit2: hmm how could I get it to not display the npcs name with a blank msg if the house is sold.. currently it displays it under the "this house is sold" message

[tslusny]

You mean this?

```
If MapOwner = 0 Then
        If FindHouse(HMapNum) Then
            Call PlayerMsg(index, "This house is already sold", White)
        Else
```
Its in Sub SendInitManager

[JohnPony]

Im planning on converting this system to work with CS:DE sometime in the future, i just have to find the time. When i do i will also convert it to UDT.

[Vus]

Wow, great work, ill try this. Thanks :)

P.S. teda, z tebe se stal uplnej codemaster, jen tak dal :D

EDIT: I downloaded that EO with  this tutorial, and once I tried to add some stuff into my house, when i hit Send, server displayed runtime error 9, subscript out of range. I tried to restart it, but it doesnt work.

[tslusny]

@Vus:

> P.S. teda, z tebe se stal uplnej codemaster, jen tak dal :D

Sak potreboval som uz ten House system do hry a tak som teda spravil aj tutorial :cheesy:

[tslusny]

Cant fix that thing with ScrlPictureX and Y max

[Likestodraw]

Um… I downloaded the lazy version and it had RTE5- invalid cell arrangement
Isn't that what happened with the other one?

[Growlith1223]

is there a way to make it so the house is just added automatically instead of having to buy it?

I have been trying to do that for ages xD

[tslusny]

@ZeroX8:

> is there a way to make it so the house is just added automatically instead of having to buy it?
>
> I have been trying to do that for ages xD

Yes its possible you must modify handleaddchar or someting like it

@Likestodraw:

> Um… I downloaded the lazy version and it had RTE5- invalid cell arrangement
> Isn't that what happened with the other one?

Dont you deleted accounts folder on server? Becouse i dont added check if fileexist Houses.txt then create it, so u must make that text file in server/data/accounts

[Likestodraw]

Well it was just the lazy version (I wanted to play around with the housing system before I actually made my programmer put it in because housing is my favorite system out of any possible system in a game), so it should have been done… I'll check again...

EDIT- It still won't work, and apparently RTE5 is invalid procedure or argument, but oh, well.

[tslusny]

@Likestodraw:

> Well it was just the lazy version (I wanted to play around with the housing system before I actually made my programmer put it in because housing is my favorite system out of any possible system in a game), so it should have been done… I'll check again...
>
> EDIT- It still won't work, and apparently RTE5 is invalid procedure or argument, but oh, well.

I dont know what doing this problem, but on my pc it works good, and i converted my game to CS:DE and i followed this tutorial to add it to game and no problems ( but u must make some changes to code to work with cs:de)

[DarkOne5890]

@Deathbeam:

> I dont know what doing this problem, but on my pc it works good, and i converted my game to CS:DE and i followed this tutorial to add it to game and no problems ( but u must make some changes to code to work with cs:de)

WhatIsthe problem sorry for comenting on a diffrent post but look its weird

[Likestodraw]

@DarkBeast:

> WhatIsthe problem sorry for comenting on a diffrent post but look its weird

Um… that confuses me.
@DeathBeam- I'll try it again, but it probably won't work...

[tslusny]

@DarkBeast:

> WhatIsthe problem sorry for comenting on a diffrent post but look its weird

You dont added dim NpcY as Long at top of sub

[Likestodraw]

I re-downloaded the lazy version, tried again, and it still gets RTE5.

[Justn]

When do u get the error cause I downloaded it to play around with and it seemed to work fine for the 5-10 mins I was messing with it??

[Likestodraw]

It's right when I open Eclipse. I got the same error when trying to use Eclipse Galaxy, and I got errors when trying to open EO 2.5 and 2.6\. I have no idea what could be causing this, and am really annoyed.