Player Housing
From VbGORE Visual Basic Online RPG Engine
Ready to add player housing/property (I say property because you could extend this to have guild HQ and such).
First download the Resources.zip. The Messages go into the Data directory and 147.png and 153.png into the grh directory.
Resources: http://www.vbgore.com/forums/download/file.php?id=261
Contents |
Grh's
Next Open GrhRaw.txt and add the following to it:
<ini>'**** Servant Window **** Grh196=1-147-0-0-123-167-(128)
'**** Chair NPC (Furniture) **** Grh197=1-153-1-9-29-47-(128) Grh198=1-153-33-8-29-48-(128) Grh199=1-153-66-12-28-45-(128) Grh200=1-153-98-12-28-45-(128) </ini>
Now go to your Hair.dat file in the Data directory. Add this to it:
<ini>'Chair [3] 1=199 2=198 3=200 4=197 5=199 6=198 7=200 8=197</ini>
change [3] to whatever is free.
Ok, this is a cheat really, but furniture (once placed on the map) are NPCs with no body or head, just a hair sprite. Oh, and just a note, it may be a good idea to label each hair, body, head, etc. in their appropriate *.dat files to make it easy to remember what is what.
Editions ----------
DAT FILES -------------
Now open GrhRaw.txt Find "'**** Servant Window ****" Change the line below that too: <vb> Grh196=1-147-0-0-123-176-(128) </vb>
Open up your skin file (for me it is "bluewave.ini") and find the [SERVANTMENU] and replace that section of code with this:
<vb>
[SERVANTMENU]
ScreenX=340
ScreenY=217
ScreenWidth=121
ScreenHeight=176
Locked=0
Grh=196
RestWidth=37 RestHeight=19 RestX=49 RestY=16
StoreWidth=40 StoreHeight=19 StoreX=45 StoreY=37
MailWidth=76 MailHeight=19 MailX=28 MailY=58
BankWidth=83 BankHeight=19 BankX=26 BankY=79
PremiumWidth=110 PremiumHeight=19 PremiumX=25 PremiumY=100
SellHouseWidth=110 SellHouseHeight=19 SellHouseX=25 SellHouseY=121
BuyHouseWidth=110 BuyHouseHeight=19 BuyHouseX=25 BuyHouseY=37 </vb>
Database
Now go to your database. Add a table called "property". Add the following columns:
<vb> 1. MapNumber - DataType: smallint - Len: 6 - Not Null: checked - Comment: Map # of property 2. Owner - DataType: varchar - Len: 255 - Comment: Username of player 3. Value - DataType: int - Len: 11 - Default: 0 - Not Null: checked - Property Value/worth 4. ItemsInStore - DataType: Text - Comment: Items in the store 5. LastVisit - date - Date of owner's last visit 6. Furniture - text - Furniture on map 7. Premium - smallInt - Len: 3 - Default: 5 - Not Null: checked - Comment: Premium charge on items sold in store </vb>
Btw, the Premium is a rate (-15% to 15%) that modifies the value of objects in the store. I set it up to change in increments of 5.
Ex: Premium of 10. Obj Value of 100. New Obj Value = 100 + (100 * 10%) = 110
Now go to the NPC table and open it to edit the values. Add the following two Records: <vb> 1. Servant: - Name: Servant - Descr: A loyal house servant - AI: 8 - char_hair: (your choice) - char_head: (your choice) - char_body: (your choice) 2. Chair - Name: Chair - Description: It looks very comfortable. - AI: 9 - Drops: 12 1 100 - char_hair: 3 (or whatever number you used when adding to the chair item to the hair.dat file - char_head: 0 - char_body: 0 </vb>
Now go to the Objects Table. Open it to edit columns. Add this column: <vb> - Field Name: NPC_Spawn - DataType: smallint - len: 6 - Default: -1 - Not Null: checked - Comment: Index of NPC to Spawn </vb>
Now open it to edit values. add the following records: <vb> 3. Wooden Chair - Name: Wooden Chair - price: 25 - objtype: 8 - grhIndex: 200 - NPC_Spawn: 9 </vb>
Map Editor
Go to frmMapInfo. Add a checkbox to the form and name it IsProperty. I gave it the caption "Is Property".
Add a button next to it called cmdApply. I gave it the caption "Apply"
Now go to the code for this form. Here's the code for the Apply button:
<vb>Private Sub cmdApply_Click()
MapInfo.Property = IsProperty.Value
End Sub</vb>
Now go to SizeCmd_Click. Find "MapInfo.Height = Val(HeightTxt.text) and below that add:
<vb>MapInfo.Property = IsProperty.Value</vb>
go to TileEngine.bas and find "Public Type MapInfo". Change it to this:
<vb>'Hold info about each map Public Type MapInfo
Name As String StartPos As WorldPos MapVersion As Integer Weather As Byte Property As Byte Music As Byte Width As Byte Height As Byte
End Type</vb>
Go to General.bas.
Go to Game_Map_Switch
Find frmMapInfo.HeightTxt.Text = MapInfo.Height. Below that add:
<vb> frmMapInfo.IsProperty.Value = MapInfo.Property</vb>
Further down locate
<vb>MapInfo.Music = Val(Var_Get(MapEXPath & Map & ".dat", "1", "Music"))</vb>
and below it add this:
<vb>MapInfo.Property = Val(Var_Get(MapEXPath & Map & ".dat", "1", "Property"))</vb>
And locate "With frmMapInfo". In that section of code add:
<vb>.IsProperty.Value = MapInfo.Property</vb>
Now locate Game_SaveMapData. Find "'Write .dat file". Change that section of code to:
<vb>'Write .dat file
If IsBackup Then
Var_Write MapEXPath & MapNum & ".dat.bak", "1", "Name", MapInfo.Name
Var_Write MapEXPath & MapNum & ".dat.bak", "1", "Weather", Str$(MapInfo.Weather)
Var_Write MapEXPath & MapNum & ".dat.bak", "1", "Music", Str$(MapInfo.Music)
Var_Write MapEXPath & MapNum & ".dat.bak", "1", "Property", Str$(MapInfo.Property)
Else
Var_Write MapEXPath & MapNum & ".dat", "1", "Name", MapInfo.Name
Var_Write MapEXPath & MapNum & ".dat", "1", "Weather", Str$(MapInfo.Weather)
Var_Write MapEXPath & MapNum & ".dat", "1", "Music", Str$(MapInfo.Music)
Var_Write MapEXPath & MapNum & ".dat", "1", "Property", Str$(MapInfo.Property)
End If</vb>
And that's the changes to the map editor. Next is the GameClient...
GameClient
Go to frmMain.frm
Go to OnDataArrival.
Go to the line:
<vb>Case .User_Trade_UpdateTrade: Data_User_Trade_UpdateTrade rBuf</vb>
and below it add:
<vb> Case .User_House_Owner: Data_User_House_Owner rBuf
Case .User_House_Visitor: Data_User_House_Visitor rBuf
Case .User_House_Other: Data_User_House_Other rBuf
Case .Refresh_House_Store: Data_User_Refresh_Store rBuf
</vb>
Now go to DataIDs.bas.
Find "Public Type DataCode" and in this section of code add:
<vb> User_House_Owner As Byte
User_House_Visitor As Byte User_House_Other As Byte User_HouseRest As Byte User_HouseBuy As Byte User_HouseBank As Byte User_HouseMail As Byte User_HouseStore As Byte Refresh_House_Store As Byte User_HouseSell As Byte</vb>
Now Find InitDataCommands and in there find ".Server_KeepAlive = 121" and add the following below it:
<vb> .User_House_Owner = 125 'Create Menu of Options for House Owner
.User_House_Visitor = 126 'Create Menu of Options for House Visitor of house owned
.User_House_Other = 127 'Offer to sell house to visitor of house not owned
.User_HouseRest = 129 'Rest up at house
.User_HouseBuy = 130 'Buy House
.User_HouseBank = 131 'Access Bank through house servant
.User_HouseMail = 132 'Access Mail through house servant
.User_HouseStore = 133 'Access House Owner's Store through house servant
.Refresh_House_Store = 134 'Refresh House Store (to update changes)
.User_HouseSell = 135 'Sell House</vb>
Go to Declares.bas
Find "'Client Character type" and in the section of code add this:
<vb>Public Const ClientCharType_Furniture As Byte = 5</vb>
Go to General.bas
Go to Game_Config_Save
Find this line "End With". Above it add:
<vb> Var_Write t, "SERVANTMENU", "ScreenX", Str$(.HouseOther.Screen.X)
Var_Write t, "SERVANTMENU", "ScreenY", Str$(.HouseOther.Screen.Y)
Var_Write t, "SERVANTMENU", "Locked", BooleanToString(.HouseOther.Locked)
</vb>
Go to Input.bas
Go to Input_Mouse_LeftClick_Window
Find "Select Case WindowIndex" and below it add:
<vb> Case HouseOwnerWindow
If ShowGameWindow(HouseOwnerWindow) Then
With GameWindow.HouseOwner
If Engine_Collision_Rect(MousePos.X, MousePos.Y, 1, 1, .Screen.X, .Screen.Y, .Screen.Width, .Screen.Height) Then
Input_Mouse_LeftClick_Window = 1
LastClickedWindow = HouseOwnerWindow
SelGameWindow = HouseOwnerWindow
End If
'Rest
If Engine_Collision_Rect(MousePos.X, MousePos.Y, 1, 1, .Screen.X + .RestLbl.X, .Screen.Y + .RestLbl.Y, .RestLbl.Width, .RestLbl.Height) Then
sndBuf.Put_Byte DataCode.User_HouseRest
HideShowWindow (HouseOwnerWindow)
Exit Function
End If
'Store
If Engine_Collision_Rect(MousePos.X, MousePos.Y, 1, 1, .Screen.X + .StoreLbl.X, .Screen.Y + .StoreLbl.Y, .StoreLbl.Width, .StoreLbl.Height) Then
sndBuf.Put_Byte DataCode.User_HouseStore
sndBuf.Put_Integer .ServantIndex
HideShowWindow (HouseOwnerWindow)
Exit Function
End If
'Mail
If Engine_Collision_Rect(MousePos.X, MousePos.Y, 1, 1, .Screen.X + .MailLbl.X, .Screen.Y + .MailLbl.Y, .MailLbl.Width, .MailLbl.Height) Then
sndBuf.Put_Byte DataCode.User_HouseMail
sndBuf.Put_Integer .ServantIndex
HideShowWindow (HouseOwnerWindow)
Exit Function
End If
'Bank
If Engine_Collision_Rect(MousePos.X, MousePos.Y, 1, 1, .Screen.X + .BankLbl.X, .Screen.Y + .BankLbl.Y, .BankLbl.Width, .BankLbl.Height) Then
sndBuf.Put_Byte DataCode.User_HouseBank
sndBuf.Put_Integer .ServantIndex
HideShowWindow (HouseOwnerWindow)
Exit Function
End If
'Sell House
If Engine_Collision_Rect(MousePos.X, MousePos.Y, 1, 1, .Screen.X + .SellHouseLbl.X, .Screen.Y + .SellHouseLbl.Y, .SellHouseLbl.Width, .SellHouseLbl.Height) Then
sndBuf.Put_Byte DataCode.User_HouseSell
HideShowWindow (HouseOwnerWindow)
Exit Function
End If
End With
End If
Case HouseVisitorWindow
If ShowGameWindow(HouseVisitorWindow) Then
With GameWindow.HouseVisitor
If Engine_Collision_Rect(MousePos.X, MousePos.Y, 1, 1, .Screen.X, .Screen.Y, .Screen.Width, .Screen.Height) Then
Input_Mouse_LeftClick_Window = 1
LastClickedWindow = HouseVisitorWindow
SelGameWindow = HouseVisitorWindow
End If
'Rest
If Engine_Collision_Rect(MousePos.X, MousePos.Y, 1, 1, .Screen.X + .RestLbl.X, .Screen.Y + .RestLbl.Y, .RestLbl.Width, .RestLbl.Height) Then
sndBuf.Put_Byte DataCode.User_HouseRest
HideShowWindow (HouseVisitorWindow)
Exit Function
End If
'Store
If Engine_Collision_Rect(MousePos.X, MousePos.Y, 1, 1, .Screen.X + .StoreLbl.X, .Screen.Y + .StoreLbl.Y, .StoreLbl.Width, .StoreLbl.Height) Then
sndBuf.Put_Byte DataCode.User_HouseStore
sndBuf.Put_Integer .ServantIndex
HideShowWindow (HouseVisitorWindow)
Exit Function
End If
End With
End If
Case HouseOtherWindow
If ShowGameWindow(HouseOtherWindow) Then
With GameWindow.HouseOther
If Engine_Collision_Rect(MousePos.X, MousePos.Y, 1, 1, .Screen.X, .Screen.Y, .Screen.Width, .Screen.Height) Then
Input_Mouse_LeftClick_Window = 1
LastClickedWindow = HouseOtherWindow
SelGameWindow = HouseOtherWindow
End If
'Rest
If Engine_Collision_Rect(MousePos.X, MousePos.Y, 1, 1, .Screen.X + .RestLbl.X, .Screen.Y + .RestLbl.Y, .RestLbl.Width, .RestLbl.Height) Then
sndBuf.Put_Byte DataCode.User_HouseRest
HideShowWindow (HouseOtherWindow)
Exit Function
End If
'Buy House
If Engine_Collision_Rect(MousePos.X, MousePos.Y, 1, 1, .Screen.X + .BuyHouseLbl.X, .Screen.Y + .BuyHouseLbl.Y, .BuyHouseLbl.Width, .BuyHouseLbl.Height) Then
sndBuf.Put_Byte DataCode.User_HouseBuy
HideShowWindow (HouseOtherWindow)
Exit Function
End If
End With
End If</vb>
Go to Input_Mouse_Move
Find "Select Case SelGameWindow" and below it add:
<vb> ' Move House-Servant Window (OWNER)
Case HouseOwnerWindow
If Not GameWindow.HouseOwner.Locked Then
With GameWindow.HouseOwner.Screen
.X = .X + MousePosAdd.X
.Y = .Y + MousePosAdd.Y
If WindowsInScreen Then
If .X < 0 Then .X = 0
If .Y < 0 Then .Y = 0
If .X > ScreenWidth - .Width Then .X = ScreenWidth - .Width
If .Y > ScreenHeight - .Height Then .Y = ScreenHeight - .Height
End If
End With
End If
' Move House-Servant Window (VISITOR)
Case HouseVisitorWindow
If Not GameWindow.HouseVisitor.Locked Then
With GameWindow.HouseVisitor.Screen
.X = .X + MousePosAdd.X
.Y = .Y + MousePosAdd.Y
If WindowsInScreen Then
If .X < 0 Then .X = 0
If .Y < 0 Then .Y = 0
If .X > ScreenWidth - .Width Then .X = ScreenWidth - .Width
If .Y > ScreenHeight - .Height Then .Y = ScreenHeight - .Height
End If
End With
End If
' Move House-Servant Window (OTHER)
Case HouseOtherWindow
If Not GameWindow.HouseOther.Locked Then
With GameWindow.HouseOther.Screen
.X = .X + MousePosAdd.X
.Y = .Y + MousePosAdd.Y
If WindowsInScreen Then
If .X < 0 Then .X = 0
If .Y < 0 Then .Y = 0
If .X > ScreenWidth - .Width Then .X = ScreenWidth - .Width
If .Y > ScreenHeight - .Height Then .Y = ScreenHeight - .Height
End If
End With
End If</vb>
Go to TCP.bas
Add the following new Subs:
<vb>Sub Data_User_House_Other(ByRef rBuf As DataBuffer) '************************************************************ 'Open Menu for House Servant (Other) '************************************************************
With GameWindow.HouseOther
'Get Value of House
.HouseValue = rBuf.Get_Integer
'Get Servant Index
.ServantIndex = rBuf.Get_Integer
End With
'Render Menu
HideShowWindow (HouseOtherWindow)
End Sub
Sub Data_User_Refresh_Store(ByRef rBuf As DataBuffer) '************************************************************ 'Refresh House Store '************************************************************
HideShowWindow (ShopWindow)
End Sub
Sub Data_User_House_Visitor(ByRef rBuf As DataBuffer) '************************************************************ 'Open Menu for House Servant (Visitor) '************************************************************
With GameWindow.HouseVisitor
'Get Owner of House
.Owner = rBuf.Get_String
'Get Items In Store of House
.ItemsInStore = rBuf.Get_String
'Get Value of House
.HouseValue = rBuf.Get_Integer
'Get Servant Index
.ServantIndex = rBuf.Get_Integer
End With
'Render Menu
HideShowWindow (HouseVisitorWindow)
End Sub
Sub Data_User_House_Owner(ByRef rBuf As DataBuffer) '************************************************************ 'Open Menu for House Servant (Owner) '************************************************************
With GameWindow.HouseOwner
'Get Items In Store of House
.ItemsInStore = rBuf.Get_String
'Get Value of House
.HouseValue = (rBuf.Get_Integer) * 0.75 'reduce value when selling (get 75% of what owner paid). Update server if you change this (Data_User_House_Sell)
'Get Servant Index
.ServantIndex = rBuf.Get_Integer
End With
'Render Menu
HideShowWindow (HouseOwnerWindow)
End Sub</vb>
Go to TileEngine.bas
Go to Engine_Render_Char
Locate "Render Extras". Below that are the sections of code that render the character name, icons, etc. Put all of that inside this IF statement: "If Not CharList(CharIndex).CharType = ClientCharType_Furniture Then"
If you are confused by what I just said, here's the clippet from my code:
<vb>'***** Render Extras (Render only if not furniture) *****
If Not CharList(CharIndex).CharType = ClientCharType_Furniture Then
'Add Border around name
Engine_Render_Text Font_Default, CharList(CharIndex).DisplayName, PixelOffsetX + 16 - CharList(CharIndex).NameOffset + Offset.X, PixelOffsetY - 41 + Offset.Y, -16777216
Engine_Render_Text Font_Default, CharList(CharIndex).DisplayName, PixelOffsetX + 16 - CharList(CharIndex).NameOffset + Offset.X, PixelOffsetY - 39 + Offset.Y, -16777216
Engine_Render_Text Font_Default, CharList(CharIndex).DisplayName, PixelOffsetX + 15 - CharList(CharIndex).NameOffset + Offset.X, PixelOffsetY - 40 + Offset.Y, -16777216
Engine_Render_Text Font_Default, CharList(CharIndex).DisplayName, PixelOffsetX + 17 - CharList(CharIndex).NameOffset + Offset.X, PixelOffsetY - 40 + Offset.Y, -16777216
'Draw name over head
If CharList(CharIndex).HealthPercent = 100 Then
Engine_Render_Text Font_Default, CharList(CharIndex).DisplayName, PixelOffsetX + 16 - CharList(CharIndex).NameOffset + Offset.X, PixelOffsetY - 40 + Offset.Y, -14104576
ElseIf CharList(CharIndex).HealthPercent > 90 Then
Engine_Render_Text Font_Default, CharList(CharIndex).DisplayName, PixelOffsetX + 16 - CharList(CharIndex).NameOffset + Offset.X, PixelOffsetY - 40 + Offset.Y, -11483136
ElseIf CharList(CharIndex).HealthPercent > 80 Then
Engine_Render_Text Font_Default, CharList(CharIndex).DisplayName, PixelOffsetX + 16 - CharList(CharIndex).NameOffset + Offset.X, PixelOffsetY - 40 + Offset.Y, -8861696
ElseIf CharList(CharIndex).HealthPercent > 70 Then
Engine_Render_Text Font_Default, CharList(CharIndex).DisplayName, PixelOffsetX + 16 - CharList(CharIndex).NameOffset + Offset.X, PixelOffsetY - 40 + Offset.Y, -6240256
ElseIf CharList(CharIndex).HealthPercent > 50 Then
Engine_Render_Text Font_Default, CharList(CharIndex).DisplayName, PixelOffsetX + 16 - CharList(CharIndex).NameOffset + Offset.X, PixelOffsetY - 40 + Offset.Y, -3618816
ElseIf CharList(CharIndex).HealthPercent > 40 Then
Engine_Render_Text Font_Default, CharList(CharIndex).DisplayName, PixelOffsetX + 16 - CharList(CharIndex).NameOffset + Offset.X, PixelOffsetY - 40 + Offset.Y, -3629056
ElseIf CharList(CharIndex).HealthPercent > 30 Then
Engine_Render_Text Font_Default, CharList(CharIndex).DisplayName, PixelOffsetX + 16 - CharList(CharIndex).NameOffset + Offset.X, PixelOffsetY - 40 + Offset.Y, -3639296
ElseIf CharList(CharIndex).HealthPercent > 20 Then
Engine_Render_Text Font_Default, CharList(CharIndex).DisplayName, PixelOffsetX + 16 - CharList(CharIndex).NameOffset + Offset.X, PixelOffsetY - 40 + Offset.Y, -3649536
ElseIf CharList(CharIndex).HealthPercent > 10 Then
Engine_Render_Text Font_Default, CharList(CharIndex).DisplayName, PixelOffsetX + 16 - CharList(CharIndex).NameOffset + Offset.X, PixelOffsetY - 40 + Offset.Y, -3659776
ElseIf CharList(CharIndex).HealthPercent > 0 Then
Engine_Render_Text Font_Default, CharList(CharIndex).DisplayName, PixelOffsetX + 16 - CharList(CharIndex).NameOffset + Offset.X, PixelOffsetY - 40 + Offset.Y, -3670016
End If
'Count the number of icons that will be needed to draw
With CharList(CharIndex).CharStatus
IconCount = 0
IconCount = .Blessed + .Protected + .Strengthened + .Cursed + .WarCursed + .IronSkinned + .Exhausted
End With
'Health/Mana bars
Engine_Render_Rectangle PixelOffsetX - 4 + Offset.X, PixelOffsetY + 34 + Offset.Y, (CharList(CharIndex).HealthPercent / 100) * 40, 4, 1, 1, 1, 1, 1, 1, 0, 0, HealthColor, HealthColor, HealthColor, HealthColor, 0, False
Engine_Render_Rectangle PixelOffsetX - 4 + Offset.X, PixelOffsetY + 38 + Offset.Y, (CharList(CharIndex).ManaPercent / 100) * 40, 4, 1, 1, 1, 1, 1, 1, 0, 0, ManaColor, ManaColor, ManaColor, ManaColor, 0, False
'Draw the icons
If IconCount > 0 Then
'Calculate the icon offset
IconOffset = PixelOffsetX + 16 - (IconCount * 8) + Offset.X
If CharList(CharIndex).CharStatus.Blessed Then
Engine_Init_Grh TempGrh, 15
Engine_Render_Grh TempGrh, IconOffset, PixelOffsetY - 50 + Offset.Y, 0, 0, False
IconOffset = IconOffset + 16
End If
If CharList(CharIndex).CharStatus.Protected Then
Engine_Init_Grh TempGrh, 20
Engine_Render_Grh TempGrh, IconOffset, PixelOffsetY - 50 + Offset.Y, 0, 0, False
IconOffset = IconOffset + 16
End If
If CharList(CharIndex).CharStatus.Strengthened Then
Engine_Init_Grh TempGrh, 17
Engine_Render_Grh TempGrh, IconOffset, PixelOffsetY - 50 + Offset.Y, 0, 0, False
IconOffset = IconOffset + 16
End If
If CharList(CharIndex).CharStatus.Cursed Then
Engine_Init_Grh TempGrh, 18
Engine_Render_Grh TempGrh, IconOffset, PixelOffsetY - 50 + Offset.Y, 0, 0, False
IconOffset = IconOffset + 16
End If
If CharList(CharIndex).CharStatus.WarCursed Then
Engine_Init_Grh TempGrh, 19
Engine_Render_Grh TempGrh, IconOffset, PixelOffsetY - 50 + Offset.Y, 0, 0, False
IconOffset = IconOffset + 16
End If
If CharList(CharIndex).CharStatus.IronSkinned Then
Engine_Init_Grh TempGrh, 16
Engine_Render_Grh TempGrh, IconOffset, PixelOffsetY - 50 + Offset.Y, 0, 0, False
IconOffset = IconOffset + 16
End If
If CharList(CharIndex).CharStatus.Exhausted Then
Engine_Init_Grh TempGrh, 22
Engine_Render_Grh TempGrh, IconOffset, PixelOffsetY - 50 + Offset.Y, 0, 0, False
IconOffset = IconOffset + 16
End If
End If
'Emoticons
If CharList(CharIndex).EmoDir > 0 Then
'Fade in
If CharList(CharIndex).EmoDir = 1 Then
CharList(CharIndex).EmoFade = CharList(CharIndex).EmoFade + (ElapsedTime * 1.5)
If CharList(CharIndex).EmoFade >= 255 Then
CharList(CharIndex).EmoFade = 255
CharList(CharIndex).EmoDir = 2
End If
End If
'Fade out
If CharList(CharIndex).Emoticon.Started = 0 Then 'Animation has stopped
If CharList(CharIndex).EmoDir = 2 Then
CharList(CharIndex).EmoFade = CharList(CharIndex).EmoFade - (ElapsedTime * 1.5)
If CharList(CharIndex).EmoFade <= 0 Then
CharList(CharIndex).EmoFade = 0
CharList(CharIndex).EmoDir = 0
End If
'Stop at the last frame, don't roll over to the first
CharList(CharIndex).Emoticon.FrameCounter = GrhData(CharList(CharIndex).Emoticon.GrhIndex).NumFrames
End If
End If
'Render
Engine_Render_Grh CharList(CharIndex).Emoticon, PixelOffsetX + 8 + Offset.X, PixelOffsetY - 40 + Offset.Y, 0, 1, False, D3DColorARGB(CharList(CharIndex).EmoFade, 255, 255, 255), D3DColorARGB(CharList(CharIndex).EmoFade, 255, 255, 255), D3DColorARGB(CharList(CharIndex).EmoFade, 255, 255, 255), D3DColorARGB(CharList(CharIndex).EmoFade, 255, 255, 255)
End If
End If</vb>
Locate the line "Public Const NumGameWindows As Byte = " line, and above add these lines:
<vb>Public Const HouseOwnerWindow As Byte = 17 Public Const HouseVisitorWindow As Byte = 18 Public Const HouseOtherWindow As Byte = 19</vb>
Change those numbers (17-19) to whatever is not yet used. Then update NumGameWindows to the highest of those numbers (in this case 19).
Locate "Public Type GameWindow" and above it add:
<vb>Public Type HouseOwnerWindow
Screen As Rectangle SkinGrh As Grh Locked As Boolean RestLbl As Rectangle StoreLbl As Rectangle MailLbl As Rectangle BankLbl As Rectangle SellHouseLbl As Rectangle HouseValue As Integer 'Temporarily Store House Value ItemsInStore As String 'Temporarily Store Items In store ServantIndex As Integer 'Index of Servant NPC
End Type
Public Type HouseVisitorWindow
Screen As Rectangle SkinGrh As Grh Locked As Boolean RestLbl As Rectangle StoreLbl As Rectangle HouseValue As Integer 'Temporarily Store House Value Owner As String 'Temporarily Store Owner of house ItemsInStore As String 'Temporarily Store Items In store ServantIndex As Integer 'Index of Servant NPC
End Type
Public Type HouseOtherWindow
Screen As Rectangle SkinGrh As Grh Locked As Boolean RestLbl As Rectangle BuyHouseLbl As Rectangle HouseValue As Integer 'Temporarily Store House Value ServantIndex As Integer 'Index of Servant NPC
End Type</vb>
Find "Public Type GameWindow" again and in that section of code add:
<vb> HouseOwner As HouseOwnerWindow
HouseVisitor As HouseVisitorWindow HouseOther As HouseOtherWindow</vb>
Go to Engine_Init_GUI and find "'Load Quickbar" and above it add:
<vb> 'Load House Servant Menu (OWNER)
With GameWindow.HouseOwner
If LoadCustomPos Then
.Screen.X = Val(Var_Get(t, "SERVANTMENU", "ScreenX"))
.Screen.Y = Val(Var_Get(t, "SERVANTMENU", "ScreenY"))
.Locked = Val(Var_Get(t, "SERVANTMENU", "Locked"))
Else
.Screen.X = Val(Var_Get(s, "SERVANTMENU", "ScreenX"))
.Screen.Y = Val(Var_Get(s, "SERVANTMENU", "ScreenY"))
.Locked = Val(Var_Get(s, "SERVANTMENU", "Locked"))
End If
.Screen.Width = Val(Var_Get(s, "SERVANTMENU", "ScreenWidth"))
.Screen.Height = Val(Var_Get(s, "SERVANTMENU", "ScreenHeight"))
Engine_Init_Grh .SkinGrh, Val(Var_Get(s, "SERVANTMENU", "Grh"))
End With
With GameWindow.HouseOwner.RestLbl
.X = Val(Var_Get(s, "SERVANTMENU", "RestX"))
.Y = Val(Var_Get(s, "SERVANTMENU", "RestY"))
.Width = Val(Var_Get(s, "SERVANTMENU", "RestWidth"))
.Height = Val(Var_Get(s, "SERVANTMENU", "RestHeight"))
End With
With GameWindow.HouseOwner.StoreLbl
.X = Val(Var_Get(s, "SERVANTMENU", "StoreX"))
.Y = Val(Var_Get(s, "SERVANTMENU", "StoreY"))
.Width = Val(Var_Get(s, "SERVANTMENU", "StoreWidth"))
.Height = Val(Var_Get(s, "SERVANTMENU", "StoreHeight"))
End With
With GameWindow.HouseOwner.MailLbl
.X = Val(Var_Get(s, "SERVANTMENU", "MailX"))
.Y = Val(Var_Get(s, "SERVANTMENU", "MailY"))
.Width = Val(Var_Get(s, "SERVANTMENU", "MailWidth"))
.Height = Val(Var_Get(s, "SERVANTMENU", "MailHeight"))
End With
With GameWindow.HouseOwner.BankLbl
.X = Val(Var_Get(s, "SERVANTMENU", "BankX"))
.Y = Val(Var_Get(s, "SERVANTMENU", "BankY"))
.Width = Val(Var_Get(s, "SERVANTMENU", "BankWidth"))
.Height = Val(Var_Get(s, "SERVANTMENU", "BankHeight"))
End With
With GameWindow.HouseOwner.SellHouseLbl
.X = Val(Var_Get(s, "SERVANTMENU", "SellHouseX"))
.Y = Val(Var_Get(s, "SERVANTMENU", "SellHouseY"))
.Width = Val(Var_Get(s, "SERVANTMENU", "SellHouseWidth"))
.Height = Val(Var_Get(s, "SERVANTMENU", "SellHouseHeight"))
End With
'Load House Servant Menu (VISITOR)
With GameWindow.HouseVisitor
If LoadCustomPos Then
.Screen.X = Val(Var_Get(t, "SERVANTMENU", "ScreenX"))
.Screen.Y = Val(Var_Get(t, "SERVANTMENU", "ScreenY"))
.Locked = Val(Var_Get(t, "SERVANTMENU", "Locked"))
Else
.Screen.X = Val(Var_Get(s, "SERVANTMENU", "ScreenX"))
.Screen.Y = Val(Var_Get(s, "SERVANTMENU", "ScreenY"))
.Locked = Val(Var_Get(s, "SERVANTMENU", "Locked"))
End If
.Screen.Width = Val(Var_Get(s, "SERVANTMENU", "ScreenWidth"))
.Screen.Height = Val(Var_Get(s, "SERVANTMENU", "ScreenHeight"))
Engine_Init_Grh .SkinGrh, Val(Var_Get(s, "SERVANTMENU", "Grh"))
End With
With GameWindow.HouseVisitor.RestLbl
.X = Val(Var_Get(s, "SERVANTMENU", "RestX"))
.Y = Val(Var_Get(s, "SERVANTMENU", "RestY"))
.Width = Val(Var_Get(s, "SERVANTMENU", "RestWidth"))
.Height = Val(Var_Get(s, "SERVANTMENU", "RestHeight"))
End With
With GameWindow.HouseVisitor.StoreLbl
.X = Val(Var_Get(s, "SERVANTMENU", "StoreX"))
.Y = Val(Var_Get(s, "SERVANTMENU", "StoreY"))
.Width = Val(Var_Get(s, "SERVANTMENU", "StoreWidth"))
.Height = Val(Var_Get(s, "SERVANTMENU", "StoreHeight"))
End With
'Load House Servant Menu (OTHER)
With GameWindow.HouseOther
If LoadCustomPos Then
.Screen.X = Val(Var_Get(t, "SERVANTMENU", "ScreenX"))
.Screen.Y = Val(Var_Get(t, "SERVANTMENU", "ScreenY"))
.Locked = Val(Var_Get(t, "SERVANTMENU", "Locked"))
Else
.Screen.X = Val(Var_Get(s, "SERVANTMENU", "ScreenX"))
.Screen.Y = Val(Var_Get(s, "SERVANTMENU", "ScreenY"))
.Locked = Val(Var_Get(s, "SERVANTMENU", "Locked"))
End If
.Screen.Width = Val(Var_Get(s, "SERVANTMENU", "ScreenWidth"))
.Screen.Height = Val(Var_Get(s, "SERVANTMENU", "ScreenHeight"))
Engine_Init_Grh .SkinGrh, Val(Var_Get(s, "SERVANTMENU", "Grh"))
End With
With GameWindow.HouseOther.RestLbl
.X = Val(Var_Get(s, "SERVANTMENU", "RestX"))
.Y = Val(Var_Get(s, "SERVANTMENU", "RestY"))
.Width = Val(Var_Get(s, "SERVANTMENU", "RestWidth"))
.Height = Val(Var_Get(s, "SERVANTMENU", "RestHeight"))
End With
With GameWindow.HouseOther.BuyHouseLbl
.X = Val(Var_Get(s, "SERVANTMENU", "BuyHouseX"))
.Y = Val(Var_Get(s, "SERVANTMENU", "BuyHouseY"))
.Width = Val(Var_Get(s, "SERVANTMENU", "BuyHouseWidth"))
.Height = Val(Var_Get(s, "SERVANTMENU", "BuyHouseHeight"))
End With</vb>
Go to Engine_Render_GUI_Window
Find "Case TradeWindow" and above it add:
<vb> Case HouseOwnerWindow
With GameWindow.HouseOwner
Engine_Render_Grh .SkinGrh, .Screen.X, .Screen.Y, 0, 1, True, GUIColorValue, GUIColorValue, GUIColorValue, GUIColorValue
Engine_Render_Text Font_Default, "Rest", .Screen.X + .RestLbl.X, .Screen.Y + .RestLbl.Y, D3DColorARGB(255, 255, 255, 255)
Engine_Render_Text Font_Default, "Store", .Screen.X + .StoreLbl.X, .Screen.Y + .StoreLbl.Y, D3DColorARGB(255, 255, 255, 255)
Engine_Render_Text Font_Default, "Access Bank", .Screen.X + .BankLbl.X, .Screen.Y + .BankLbl.Y, D3DColorARGB(255, 255, 255, 255)
Engine_Render_Text Font_Default, "Access Mail", .Screen.X + .MailLbl.X, .Screen.Y + .MailLbl.Y, D3DColorARGB(255, 255, 255, 255)
Engine_Render_Text Font_Default, "Sell: ", .Screen.X + .SellHouseLbl.X, .Screen.Y + .SellHouseLbl.Y, D3DColorARGB(255, 255, 255, 255)
Engine_Render_Text Font_Default, .HouseValue, .Screen.X + .SellHouseLbl.X + 30, .Screen.Y + .SellHouseLbl.Y, D3DColorARGB(255, 255, 255, 0)
End With
Case HouseVisitorWindow
With GameWindow.HouseVisitor
Engine_Render_Grh .SkinGrh, .Screen.X, .Screen.Y, 0, 1, True, GUIColorValue, GUIColorValue, GUIColorValue, GUIColorValue
Engine_Render_Text Font_Default, "Rest", .Screen.X + .RestLbl.X, .Screen.Y + .RestLbl.Y, D3DColorARGB(255, 255, 255, 255)
Engine_Render_Text Font_Default, "Store", .Screen.X + .StoreLbl.X, .Screen.Y + .StoreLbl.Y, D3DColorARGB(255, 255, 255, 255)
Engine_Render_Text Font_Default, .Owner & "'s", .Screen.X + Round(Abs(.Screen.Width - Engine_GetTextWidth(Font_Default, .Owner & "'s")) / 2), .Screen.Y + 100, D3DColorARGB(255, 255, 255, 0)
Engine_Render_Text Font_Default, "House", .Screen.X + 45, .Screen.Y + 110, D3DColorARGB(255, 255, 255, 255)
End With
Case HouseOtherWindow
With GameWindow.HouseOther
Engine_Render_Grh .SkinGrh, .Screen.X, .Screen.Y, 0, 1, True, GUIColorValue, GUIColorValue, GUIColorValue, GUIColorValue
Engine_Render_Text Font_Default, "Rest", .Screen.X + .RestLbl.X, .Screen.Y + .RestLbl.Y, D3DColorARGB(255, 255, 255, 255)
Engine_Render_Text Font_Default, "Buy: ", .Screen.X + .BuyHouseLbl.X, .Screen.Y + .BuyHouseLbl.Y, D3DColorARGB(255, 255, 255, 255)
Engine_Render_Text Font_Default, .HouseValue, .Screen.X + .BuyHouseLbl.X + 30, .Screen.Y + .BuyHouseLbl.Y, D3DColorARGB(255, 255, 255, 0)
End With</vb>
Editions -------------
go to TCP.bas
Replace the subs Data_User_House_Owner, Data_User_House_Visitor, and Data_User_House_Other with these: <vb>
Sub Data_User_House_Other(ByRef rBuf As DataBuffer) '************************************************************ 'Open Menu for House Servant (Other) '************************************************************
With GameWindow.HouseOther
'Get Value of House
.HouseValue = rBuf.Get_Integer
'Get Servant Index
.ServantIndex = rBuf.Get_Integer
End With
'Render Menu
If Not ShowGameWindow(HouseOtherWindow) = 0 Then
HideShowWindow (HouseOtherWindow)
End If
End Sub
Sub Data_User_House_Visitor(ByRef rBuf As DataBuffer) '************************************************************ 'Open Menu for House Servant (Visitor) '************************************************************
With GameWindow.HouseVisitor
'Get Owner of House
.Owner = rBuf.Get_String
'Get Items In Store of House
.ItemsInStore = rBuf.Get_String
'Get Value of House
.HouseValue = rBuf.Get_Integer
'Get Servant Index
.ServantIndex = rBuf.Get_Integer
End With
'Render Menu
If Not ShowGameWindow(HouseVisitorWindow) = 0 Then
HideShowWindow (HouseVisitorWindow)
End If
End Sub
Sub Data_User_House_Owner(ByRef rBuf As DataBuffer) '************************************************************ 'Open Menu for House Servant (Owner) '************************************************************
With GameWindow.HouseOwner
'Get Items In Store of House
.ItemsInStore = rBuf.Get_String
'Get Value of House
.HouseValue = (rBuf.Get_Integer) * 0.75 'reduce value when selling (get 75% of what owner paid). Update server if you change this (Data_User_House_Sell)
'Get Servant Index
.ServantIndex = rBuf.Get_Integer
'Get Premium Charge on Items In Store
.PremiumValue = rBuf.Get_Integer
End With
'Render Menu
If ShowGameWindow(HouseOwnerWindow) = 0 Then
HideShowWindow (HouseOwnerWindow)
End If
End Sub </vb>
go to DataIDs.bas
Go to <vb> User_HouseSell As Byte </vb> and below it add this: <vb> User_ChangePremium As Byte </vb>
then find
<vb>
.TeleportToHouseEffect = 137 'Teleport To House Particle Effect
</vb>
and below it add this:
<vb>
.User_ChangePremium = 138 'Change Premium of items in store
</vb>
Go to Input.bas
Go to Input_Mouse_LeftClick_Window
Find this "Case HouseOwnerWindow" and in that section of code find: <vb>
'Sell House
If Engine_Collision_Rect(MousePos.X, MousePos.Y, 1, 1, .Screen.X + .SellHouseLbl.X, .Screen.Y + .SellHouseLbl.Y, .SellHouseLbl.Width, .SellHouseLbl.Height) Then
sndBuf.Put_Byte DataCode.User_HouseSell
HideShowWindow (HouseOwnerWindow)
Exit Function
End If
and below it add this:
Code:
'Sell House
If Engine_Collision_Rect(MousePos.X, MousePos.Y, 1, 1, .Screen.X + .SellHouseLbl.X, .Screen.Y + .SellHouseLbl.Y, .SellHouseLbl.Width, .SellHouseLbl.Height) Then
sndBuf.Put_Byte DataCode.User_HouseSell
HideShowWindow (HouseOwnerWindow)
Exit Function
End If
</vb>
Go to TileEngine.bas Find this: <vb> Public Type HouseOwnerWindow </vb>
and in that section of code add this: <vb>
PremiumLbl As Rectangle PremiumValue As Integer 'Premium charge on items in store
</vb>
Go to Engine_Init_Gui
find this: <vb>
With GameWindow.HouseOwner.SellHouseLbl
.X = Val(Var_Get(s, "SERVANTMENU", "SellHouseX"))
.Y = Val(Var_Get(s, "SERVANTMENU", "SellHouseY"))
.Width = Val(Var_Get(s, "SERVANTMENU", "SellHouseWidth"))
.Height = Val(Var_Get(s, "SERVANTMENU", "SellHouseHeight"))
End With
</vb>
and below it add this: <vb>
With GameWindow.HouseOwner.PremiumLbl
.X = Val(Var_Get(s, "SERVANTMENU", "PremiumX"))
.Y = Val(Var_Get(s, "SERVANTMENU", "PremiumY"))
.Width = Val(Var_Get(s, "SERVANTMENU", "PremiumWidth"))
.Height = Val(Var_Get(s, "SERVANTMENU", "PremiumHeight"))
End With
</vb>
go to Engine_Render_Gui_Window
Find "Case HouseOwnerWindow" and below it find <vb> Engine_Render_Text Font_Default, .HouseValue, .Screen.X + .SellHouseLbl.X + 30, .Screen.Y + .SellHouseLbl.Y, D3DColorARGB(255, 255, 255, 0) </vb>
and below that add this: <vb>
Engine_Render_Text Font_Default, "Premium: ", .Screen.X + .PremiumLbl.X, .Screen.Y + .PremiumLbl.Y, D3DColorARGB(255, 255, 255, 255)
Engine_Render_Text Font_Default, .PremiumValue, .Screen.X + .PremiumLbl.X + 60, .Screen.Y + .PremiumLbl.Y, D3DColorARGB(255, 255, 255, 0)
</vb>
Add this to General.bas
<vb>
Function BooleanToString(ByVal BooleanVal As Boolean) As String
If BooleanVal Then
BooleanToString = "1"
Else
BooleanToString = "0"
End If
End Function </vb>
And if you don't already have this function from another of my tutorials, you may need to add it:
<vb>
Function HideShowWindow(ByVal WindowIndex As Byte) As Byte
If ShowGameWindow(WindowIndex) Then
ShowGameWindow(WindowIndex) = 0
If LastClickedWindow = WindowIndex Then LastClickedWindow = 0
Else
ShowGameWindow(WindowIndex) = 1
LastClickedWindow = WindowIndex
End If
End Function </vb>
Fix --------------
Go to the top of the Engine_Render_Char function in TileEngine.bas of the client
Add this Variable declaration:
<vb> Dim Offset As Position </vb>
Ok, next is the final bit of code...the Server
Server
Go to frmMain.frm
go to StartServer
Find "Const cMessages" and change the section of code to this:
<vb>Const cMessages As String = "2,7,8,12,17,20,24,25,26,29,33,34,36,37,38,48,49," & _
"51,57,60,61,64,69,70,79,81,82,83,84,85,97,98,99,101,102,109,111,112,113,114," & _
"116,119,121,123,125,127,130,131,132,133,134,135,136,137,138,139,140,141,142,143,144," & _
"145,146,147,148,149"</vb>
Go to onDataArrival
Find "Case .User_Use: Data_User_Use rBuf, Index" and below that add:
<vb> Case .User_HouseRest: Data_User_House_Rest Index
Case .User_HouseBuy: Data_User_House_Buy Index
Case .User_HouseBank: Data_User_House_Bank rBuf, Index
Case .User_HouseMail: Data_User_House_Mail rBuf, Index
Case .User_HouseStore: Data_User_House_Store rBuf, Index
Case .User_HouseSell: Data_User_House_Sell Index</vb>
Go to Declares.bas
Find udtObjData and add to it this:
<vb>NPC_Spawn As Integer 'Index of NPC to spawn when item is used</vb>
Find "'Client character types" and add to that section of code this:
<vb>Public Const ClientCharType_Furniture As Byte = 5</vb>
then find "'Object Types" and add to that section of code this:
<vb>Public Const OBJTYPE_FURNITURE As Byte = 8 'Furniture</vb>
find "Type MapInfo" and change that section of code to:
<vb>Type MapInfo 'Map information
NumUsers As Integer 'Number of users on the map Name As String 'Name of the map MapVersion As Integer 'Version of the map Width As Byte 'Dimensions of the map Height As Byte Weather As Byte 'What weather effects the map has going Music As Byte 'The music file number of the map Property As Byte 'Is Map an ownable property DataLoaded As Byte 'If the map data is loaded UnloadTimer As Long 'How long until the surface unloads Data() As MapBlock 'Holds the information on each tile; Data(TileX, TileY) ObjTile() As ObjBlock 'Holds the information on the objects on the tiles; Obj(TileX, TileY)
End Type</vb>
Go to FileIO.bas
Go to Load_Objs and fine ".SpriteWings = Val(DB_RS!sprite_wings) and add below it this:
<vb>.NPC_Spawn = Val(DB_RS!NPC_Spawn)</vb>
Go to Load_Maps.
Find "Load_Maps_Data Map" and below that line add this:
<vb>Load_Map_Furniture Map</vb>
That goes before "Save_Maps_Temp Map"
Add this new sub to the code:
<vb>Private Sub Load_Map_Furniture(ByVal MapNum As Integer) '***************************************************************** 'Loads all furniture for properties '***************************************************************** Dim i As Long Dim j As Byte Dim FurnitureOnMap As String Dim FurnitureList() As String Dim FurnitureInfo() As String Dim X As Long Dim Y As Long Dim NPCIndex As Integer
If MapInfo(MapNum).Property Then
'User is on a Property type map. Check that it is theirs
DB_RS.Open "SELECT * FROM property WHERE `MapNumber`=" & MapNum, DB_Conn, adOpenStatic, adLockOptimistic
'Make sure property Info Exists
If DB_RS.EOF Then
DB_RS.Close
Exit Sub
End If
'Retrieve Furniture Info
With DB_RS
'Get Furniture for Property
FurnitureOnMap = !Furniture
'Get Array of Furniture
FurnitureList = Split(FurnitureOnMap, vbNewLine)
'Check if there is furniture
If UBound(FurnitureList) > 0 Then
j = UBound(FurnitureList)
'Loop through Furniture NPCs and Add To Map's NPC list
For i = 0 To j - 1
FurnitureInfo = Split(Trim$(FurnitureList(i)), " ")
'Get Furniture NPC Info
NPCIndex = Val(FurnitureInfo(0))
X = Val(FurnitureInfo(1))
Y = Val(FurnitureInfo(2))
'Add Furniture NPC to map Info
If (NPCIndex > 0 And X > 0 And Y > 0) Then
MapInfo(MapNum).Data(X, Y).NPCIndex = NPCIndex
End If
Next i
End If
DB_RS.Close
End With
End If
End Sub</vb>
Go to NPCs.bas
Go to NPC_AI
Add this to the very end (but before "End Select") of the sub:
<vb> '*** Player House Servant ***
'Case 8
'This NPC has no AI here - the only reference to the Servant AI is in the clicking events.
' Just do a search for "ai = 7" in Users.bas to find it.
' But the 'meat' of the code is in NPC_House_Servant</vb>
Now add this new Sub to the code:
<vb>Sub NPC_House_Servant(ByVal UserIndex As Integer, ByVal NPCIndex As Integer, ByVal Map As Integer) '***************************************************************** 'Open Player House Servant Options '***************************************************************** Dim Owner As String Dim Value As Integer Dim ItemsInStore As String Dim LastVisit As Date
'Map is an Ownable Property. Load Current Property Info DB_RS.Open "SELECT * FROM property WHERE `MapNumber`=" & Map, DB_Conn, adOpenStatic, adLockOptimistic
'Make sure property Info Exists
If DB_RS.EOF Then
DB_RS.Close
Exit Sub
End If
With DB_RS
'Update ownership
Owner = !Owner
If Owner = UserList(UserIndex).Name Then
'Update Owner's Last Visit
!LastVisit = Date$
ElseIf Not Trim(Owner) = "" Then
'Check that owner still visits house at least once every three months
LastVisit = !LastVisit
If DateDiff("m", LastVisit, Date$) >= 3 Then
'House not visited in 3 months. It's abandoned...
Owner = ""
!Owner = Owner
!ItemsInStore = ""
End If
End If
'Get property Info
Value = Val(!Value)
ItemsInStore = !ItemsInStore
'Update and Close the recordset
.Update
.Close
End With
'Check if Property is owned
If Not Trim(Owner) = "" Then
'Owned
If Owner = UserList(UserIndex).Name Then
'---------------------------
'- Owner Actions Available:
' - Remove Items from store
' - Get Items from bank
' - Access Mail
' - Rest
' - Sell House
' - when selling property, you get a % of its value
'---------------------------
'Send Property Info To User
ConBuf.Put_Byte DataCode.User_House_Owner
ConBuf.Put_String ItemsInStore
ConBuf.Put_Integer Value
ConBuf.Put_Integer NPCIndex
Else
'---------------------------
'- Visitor Actions Available: (Anything bought goes to owner)
' - Buy Items for sale by owner
' - Rest
'---------------------------
'Send Property Info To User
ConBuf.Put_Byte DataCode.User_House_Visitor
ConBuf.Put_String Owner
ConBuf.Put_String ItemsInStore
ConBuf.Put_Integer Value
ConBuf.Put_Integer NPCIndex
End If
Data_Send ToIndex, UserIndex, ConBuf.Get_Buffer
Else
'Not Owned
'---------------------------
'- Offer to sell house
' - Rest
' - If User decides to buy, check that they don't already own a property
'---------------------------
'Check of Player fits requirements to buy property
If UserList(UserIndex).Stats.BaseStat(SID.ELV) > 30 Then
DB_RS.Open "SELECT * FROM property WHERE `MapNumber`=" & Map, DB_Conn, adOpenStatic, adLockOptimistic
'Make sure Player doesn't already own propery
If DB_RS.EOF Then
DB_RS.Close
Exit Sub
End If
DB_RS.Close
'Send Property Info to user
ConBuf.Put_Byte DataCode.User_House_Other
ConBuf.Put_Integer Value
ConBuf.Put_Integer NPCIndex
Data_Send ToIndex, UserIndex, ConBuf.Get_Buffer
Else
'MESSAGE USER THAT THEY ARE NOT A HIGH ENOUGH LEVEL TO PURCHASE PROPERTY
Data_Send ToIndex, UserIndex, cMessage(146).Data
End If
End If
End Sub</vb>
And also add this new sub to the code:
<vb>Sub NPC_FurnitureClick(ByVal UserIndex As Integer, ByVal NPCIndex As Integer, ByVal Map As Integer) '***************************************************************** 'Destroy Furniture NPC and add appropriate furniture item to inventory '***************************************************************** Dim i As Long Dim j As Byte Dim FurnitureOnMap As String Dim FurnitureList() As String Dim FurnitureInfo() As String Dim NewFurnitureList As String Dim FurnitureID As Integer Dim X As Integer Dim Y As Integer Dim ObjIndex As Integer Dim Owner As String
'Map is an Ownable Property. Load Current Property Info DB_RS.Open "SELECT * FROM property WHERE `MapNumber`=" & Map, DB_Conn, adOpenStatic, adLockOptimistic
'Make sure property Info Exists
If DB_RS.EOF Then
DB_RS.Close
Exit Sub
End If
With DB_RS
'Update ownership
Owner = !Owner
'Only Owners can update property
If Owner = UserList(UserIndex).Name Then
'Update Owner's Last Visit
!LastVisit = Date$
'Get Furniture for Property
FurnitureOnMap = !Furniture
'Get Array of Furniture
FurnitureList = Split(FurnitureOnMap, vbNewLine)
'Check if there is furniture
If UBound(FurnitureList) > 0 Then
j = UBound(FurnitureList)
'Loop through Furniture NPCs
For i = 0 To j - 1
FurnitureInfo = Split(Trim$(FurnitureList(i)), " ")
'Get Furniture NPC Info
FurnitureID = Val(FurnitureInfo(0))
X = Val(FurnitureInfo(1))
Y = Val(FurnitureInfo(2))
Heading = Val(FurnitureInfo(3))
'If FurnitureID does not match selected NPC, then keep on map
If NPCList(NPCIndex).id = FurnitureID And NPCList(NPCIndex).Pos.X = X And NPCList(NPCIndex).Pos.Y = Y Then
'Get Furniture Item ID From NPC Drop List (NOTE! Furniture NPC's drop list should contain only 1 item: The furniture Item it represents)
ObjIndex = NPCList(NPCIndex).DropItems(1).ObjIndex
'Add Furniture Item To Inventory
User_GiveObj UserIndex, ObjIndex, 1
'Destory NPC
NPC_EraseChar NPCIndex, 0
Else
NewFurnitureList = FurnitureID & " " & X & " " & Y & " " & Heading & vbNewLine
End If
Next i
'Update Furniture List
!Furniture = NewFurnitureList
End If
End If
'Update and Close the recordset
.Update
.Close
End With
End Sub</vb>
Go to NPC_MakeChar
Find:
<vb> If NPCList(NPCIndex).OwnerIndex > 0 Then
If ClientCharType_Slave <> .CharType Then
Flags = Flags Or 8192
...</vb>
and change that section of code to this:
<vb>If NPCList(NPCIndex).OwnerIndex > 0 Then
If ClientCharType_Slave <> .CharType Then
Flags = Flags Or 8192
.CharType = ClientCharType_Slave
PacketSize = PacketSize + 1
End If
Else
If NPCList(NPCIndex).AI = 9 Then
Flags = Flags Or 8192
.CharType = ClientCharType_Furniture
PacketSize = PacketSize + 1
ElseIf ClientCharType_NPC <> .CharType Then
Flags = Flags Or 8192
.CharType = ClientCharType_NPC
PacketSize = PacketSize + 1
End If
End If</vb>
Now find:
<vb> If NPCList(NPCIndex).OwnerIndex > 0 Then
If Flags And 8192 Then ConBuf.Put_Byte ClientCharType_Slave
If Flags And 16384 Then ConBuf.Put_Byte NPCList(NPCIndex).Char.Mount
If Flags And 32768 Then ConBuf.Put_Byte NPCList(NPCIndex).Char.Shield
ConBuf.Put_Integer UserList(NPCList(NPCIndex).OwnerIndex).Char.CharIndex
Else
.....</vb>
And change that section of code to this:
<vb> If NPCList(NPCIndex).OwnerIndex > 0 Then
If Flags And 8192 Then ConBuf.Put_Byte ClientCharType_Slave
If Flags And 16384 Then ConBuf.Put_Byte NPCList(NPCIndex).Char.Mount
If Flags And 32768 Then ConBuf.Put_Byte NPCList(NPCIndex).Char.Shield
ConBuf.Put_Integer UserList(NPCList(NPCIndex).OwnerIndex).Char.CharIndex
Else
If Flags And 8192 Then
If NPCList(NPCIndex).AI = 9 Then
ConBuf.Put_Byte ClientCharType_Furniture
Else
ConBuf.Put_Byte ClientCharType_NPC
End If
End If
If Flags And 16384 Then ConBuf.Put_Byte NPCList(NPCIndex).Char.Mount
If Flags And 32768 Then ConBuf.Put_Byte NPCList(NPCIndex).Char.Shield
End If</vb>
then find
<vb>If NPCList(NPCIndex).OwnerIndex > 0 Then
ConBuf.Put_Byte ClientCharType_Slave
ConBuf.Put_Integer NPCList(NPCIndex).Char.Mount
ConBuf.Put_Integer NPCList(NPCIndex).Char.Shield
ConBuf.Put_Integer UserList(NPCList(NPCIndex).OwnerIndex).Char.CharIndex
Else
...</vb>
and change that section of code to:
<vb> If NPCList(NPCIndex).OwnerIndex > 0 Then
ConBuf.Put_Byte ClientCharType_Slave
ConBuf.Put_Integer NPCList(NPCIndex).Char.Mount
ConBuf.Put_Integer NPCList(NPCIndex).Char.Shield
ConBuf.Put_Integer UserList(NPCList(NPCIndex).OwnerIndex).Char.CharIndex
Else
If NPCList(NPCIndex).AI = 9 Then
ConBuf.Put_Byte ClientCharType_Furniture
Else
ConBuf.Put_Byte ClientCharType_NPC
End If
ConBuf.Put_Integer NPCList(NPCIndex).Char.Mount
ConBuf.Put_Integer NPCList(NPCIndex).Char.Shield
End If</vb>
Ignore the bits about the mount and shield if it's not in your code. (that's part of another tutorial of mine)
Now add this New Sub to the code:
<vb>Public Function SpawnNewNPC(ByVal UserIndex As Integer, ByVal NPCIndex As Integer, ByVal Thralled As Byte, ByVal ThrallTime As Long, ByVal Attackable As Byte, ByVal Hostile As Byte, ByVal AI As Byte) As Integer '***************************************************************** 'Creates a new instance of an NPC near specified User '***************************************************************** Dim tIndex As Integer Dim CharIndex As Integer
'Summon the NPC
tIndex = Load_NPC(NPCIndex, Thralled, ThrallTime)
'Check for an invalid index (load failed)
If tIndex < 1 Then Exit Function
'Find a legal position
Server_ClosestLegalPos UserList(UserIndex).Pos, NPCList(tIndex).Pos
'Check if the position is legal
If Not Server_LegalPos(NPCList(tIndex).Pos.Map, NPCList(tIndex).Pos.X, NPCList(tIndex).Pos.Y, 0) Then
NPC_Close tIndex
Exit Function
End If
'Set up the NPC's information
NPCList(tIndex).ChatID = 0
NPCList(tIndex).Attackable = Attackable
NPCList(tIndex).Hostile = Hostile
NPCList(tIndex).AI = AI
NPCList(tIndex).Name = NPCList(tIndex).Name
NPCList(tIndex).BaseStat(SID.Agi) = NPCList(tIndex).BaseStat(SID.Agi) + (UserList(UserIndex).Stats.ModStat(SID.Mag) \ 10)
NPCList(tIndex).BaseStat(SID.DEF) = NPCList(tIndex).BaseStat(SID.DEF) + (UserList(UserIndex).Stats.ModStat(SID.Mag) \ 10)
NPCList(tIndex).BaseStat(SID.MinHIT) = NPCList(tIndex).BaseStat(SID.MinHIT) + (UserList(UserIndex).Stats.ModStat(SID.Mag) \ 10)
NPCList(tIndex).BaseStat(SID.MaxHIT) = NPCList(tIndex).BaseStat(SID.MaxHIT) + (UserList(UserIndex).Stats.ModStat(SID.Mag) \ 10)
NPCList(tIndex).BaseStat(SID.Speed) = NPCList(tIndex).BaseStat(SID.Speed) + (UserList(UserIndex).Stats.ModStat(SID.Mag) \ 20)
NPCList(tIndex).BaseStat(SID.MaxHP) = NPCList(tIndex).BaseStat(SID.MaxHP) + UserList(UserIndex).Stats.ModStat(SID.Mag)
NPCList(tIndex).BaseStat(SID.MinHP) = NPCList(tIndex).BaseStat(SID.MaxHP)
NPCList(tIndex).ModStat(SID.MaxHP) = NPCList(tIndex).BaseStat(SID.MaxHP)
NPCList(tIndex).Char.Heading = UserList(UserIndex).Char.Heading
NPC_UpdateModStats tIndex
'Set up the NPC on the map / char array
MapInfo(NPCList(tIndex).Pos.Map).Data(NPCList(tIndex).Pos.X, NPCList(tIndex).Pos.Y).NPCIndex = tIndex
CharIndex = Server_NextOpenCharIndex
NPCList(tIndex).Char.CharIndex = CharIndex
CharList(CharIndex).Index = tIndex
If (AI = 9) Then 'Furniture Char Type
CharList(CharIndex).CharType = ClientCharType_Furniture
Else 'NPC char Type
CharList(CharIndex).CharType = CharType_NPC
End If
'Display the NPC
NPC_Spawn tIndex
NPC_MakeChar ToMap, UserIndex, tIndex, NPCList(tIndex).Pos.Map, NPCList(tIndex).Pos.X, NPCList(tIndex).Pos.Y
'return index of new NPC
SpawnNewNPC = tIndex
End Function</vb>
Now the Function above is based on the summon bandit script. Rather than duplicate the code, I made a new function for it. So, if I were you, though this is optional, change the Skill_SummonBandid_PC function in Skills.bas to:
<vb>Public Sub Skill_SummonBandit_PC(ByVal CasterIndex As Integer) '***************************************************************** 'Summon a bandit to fight with you 'More info: http://www.vbgore.com/GameServer.Skills.Skill_SummonBandit_PC '***************************************************************** Dim tIndex As Integer
'Check for invalid values If UserList(CasterIndex).Flags.UserLogged = 0 Then Exit Sub If UserList(CasterIndex).Counters.SpellExhaustion > 0 Then Exit Sub
'Check if the caster knows the skill
If UserList(CasterIndex).KnownSkills(SkID.SummonBandit) = 0 Then
Data_Send ToIndex, CasterIndex, cMessage(37).Data
Exit Sub
End If
'Check for enough mana to cast
If UserList(CasterIndex).Stats.BaseStat(SID.MinMAN) < Int(UserList(CasterIndex).Stats.ModStat(SID.Mag) * SumBandit_Cost) Then
Data_Send ToIndex, CasterIndex, cMessage(38).Data
Exit Sub
End If
'Make sure the user doesn't have too many summons already
If UserList(CasterIndex).NumSlaves >= MaxSummons Then
Data_Send ToIndex, CasterIndex, cMessage(127).Data
Exit Sub
End If
'Summon the NPC tIndex = SpawnNewNPC(CasterIndex, 2, 1, SumBandit_Length, 1, 1, 7) NPCList(tIndex).Name = "Summoned " & NPCList(tIndex).Name 'Remove the summon's drop and shop items Erase NPCList(tIndex).DropItems Erase NPCList(tIndex).DropRate Erase NPCList(tIndex).VendItems NPCList(tIndex).NumDropItems = 0 NPCList(tIndex).NumVendItems = 0 'Bind the NPC to the user UserList(CasterIndex).NumSlaves = UserList(CasterIndex).NumSlaves + 1 ReDim Preserve UserList(CasterIndex).SlaveNPCIndex(1 To UserList(CasterIndex).NumSlaves) UserList(CasterIndex).SlaveNPCIndex(UserList(CasterIndex).NumSlaves) = tIndex NPCList(tIndex).OwnerIndex = CasterIndex 'Add the spell exhaustion and display it UserList(CasterIndex).Counters.SpellExhaustion = timeGetTime + SumBandit_Exhaust ConBuf.PreAllocate 4 ConBuf.Put_Byte DataCode.Server_IconSpellExhaustion ConBuf.Put_Byte 1 ConBuf.Put_Integer UserList(CasterIndex).Char.CharIndex Data_Send ToMap, CasterIndex, ConBuf.Get_Buffer, UserList(CasterIndex).Pos.Map, PP_StatusIcons 'Display the effect on the map - this must be done AFTER the NPC is made ConBuf.PreAllocate 6 ConBuf.Put_Byte DataCode.User_CastSkill ConBuf.Put_Byte SkID.SummonBandit ConBuf.Put_Integer NPCList(tIndex).Char.CharIndex Data_Send ToMap, CasterIndex, ConBuf.Get_Buffer, UserList(CasterIndex).Pos.Map, PP_DisplaySpell
'Reduce the user's mana UserList(CasterIndex).Stats.BaseStat(SID.MinMAN) = UserList(CasterIndex).Stats.BaseStat(SID.MinMAN) - Int(UserList(CasterIndex).Stats.ModStat(SID.Mag) * SumBandit_Cost)
End Sub</vb>
It basically makes use of the new function we added earlier. It's always good programming practice to eliminate duplicity in your code.
Go to TCP.Bas
Now go to Data_User_RequestMakeChar. Find
<vb>Case CharType_NPC</vb>
and change it to
<vb>Case CharType_NPC, ClientCharType_Furniture</vb>
Go to Data_User_Trade_SellToNPC and change the sub to this:
<vb>Sub Data_User_Trade_SellToNPC(ByRef rBuf As DataBuffer, ByVal UserIndex As Integer) '***************************************************************** 'Sell an item to a NPC '<Slot(B)><Amount(I)> 'More info: http://www.vbgore.com/GameServer.TCP.Data_User_Trade_SellToNPC '***************************************************************** Dim NPCIndex As Integer Dim AddMoney As Long Dim Amount As Integer Dim Slot As Byte Dim Owner As String
Log "Call Data_User_Trade_SellToNPC([" & ByteArrayToStr(rBuf.Get_Buffer) & "]," & UserIndex & ")", CodeTracker '//\\LOGLINE//\\
'Get the values Slot = rBuf.Get_Byte Amount = rBuf.Get_Integer 'Set the NPC index to trade with NPCIndex = UserList(UserIndex).Flags.TradeWithNPC
'Check for invalid values
If NPCIndex < 1 Then Exit Sub
If NPCIndex > LastNPC Then Exit Sub
If NPCList(NPCIndex).NumVendItems < 1 Then Exit Sub
If Slot <= 0 Then Exit Sub
If Slot > MAX_INVENTORY_SLOTS Then Exit Sub
If UserList(UserIndex).Flags.TradeWithNPC <= 0 Then Exit Sub
If Amount < 0 Then Exit Sub
If Amount > UserList(UserIndex).Object(Slot).Amount Then Exit Sub
If UserList(UserIndex).Object(Slot).ObjIndex < 1 Then Exit Sub
'Check for valid locations
If UserList(UserIndex).Pos.Map <> NPCList(NPCIndex).Pos.Map Then
Data_Send ToIndex, UserIndex, cMessage(36).Data
Exit Sub
End If
If Server_RectDistance(UserList(UserIndex).Pos.X, UserList(UserIndex).Pos.Y, NPCList(NPCIndex).Pos.X, NPCList(NPCIndex).Pos.Y, 6, 6) = 0 Then
Data_Send ToIndex, UserIndex, cMessage(36).Data
Exit Sub
End If
With UserList(UserIndex).Object(Slot)
'Check If Trade occurs with House Servant
If NPCList(NPCIndex).AI = 8 Then
Dim i As Integer
Dim ItemsInStore As String
Dim ItemFoundInStore As Boolean
'Make sure Map is an Ownable Property. Load Current Property Info
DB_RS.Open "SELECT * FROM property WHERE `MapNumber`=" & NPCList(NPCIndex).Pos.Map, DB_Conn, adOpenStatic, adLockOptimistic
'Make sure property Info Exists
If DB_RS.EOF Then
DB_RS.Close
Exit Sub
End If
With DB_RS
'Update Items In Store
For i = 1 To NPCList(NPCIndex).NumVendItems
'Update Amount of Item if it already is in store
If NPCList(NPCIndex).VendItems(i).ObjIndex = UserList(UserIndex).Object(Slot).ObjIndex Then
NPCList(NPCIndex).VendItems(i).Amount = NPCList(NPCIndex).VendItems(i).Amount + Amount
ItemFoundInStore = True
End If
ItemsInStore = ItemsInStore & NPCList(NPCIndex).VendItems(i).ObjIndex & " " & NPCList(NPCIndex).VendItems(i).Amount & vbNewLine
Next i
'Add Item to store if it is not already in there
If Not ItemFoundInStore Then
NPCList(NPCIndex).NumVendItems = NPCList(NPCIndex).NumVendItems + 1
ReDim Preserve NPCList(NPCIndex).VendItems(1 To NPCList(NPCIndex).NumVendItems)
NPCList(NPCIndex).VendItems(i).ObjIndex = UserList(UserIndex).Object(Slot).ObjIndex
NPCList(NPCIndex).VendItems(i).Amount = UserList(UserIndex).Object(Slot).Amount
ItemsInStore = ItemsInStore & NPCList(NPCIndex).VendItems(i).ObjIndex & " " & NPCList(NPCIndex).VendItems(i).Amount & vbNewLine
End If
'Save to databse
!ItemsInStore = ItemsInStore
'Get Owner
Owner = !Owner
.Update
End With
DB_RS.Close
End If
'Note, only give money if user doesn't own store (because owner would be adding items to store)
If Not Owner = UserList(UserIndex).Name Then
'Give the money
AddMoney = ObjData.Value(.ObjIndex) * 0.5 * Amount
UserList(UserIndex).Stats.BaseStat(SID.Gold) = UserList(UserIndex).Stats.BaseStat(SID.Gold) + AddMoney
ConBuf.PreAllocate 9 + Len(ObjData.Name(.ObjIndex))
ConBuf.Put_Byte DataCode.Server_Message
ConBuf.Put_Byte 96
ConBuf.Put_Integer Amount
ConBuf.Put_String ObjData.Name(.ObjIndex)
ConBuf.Put_Long AddMoney
Data_Send ToIndex, UserIndex, ConBuf.Get_Buffer
End If
'Remove the user's objects
.Amount = .Amount - Amount
'Check if the user lost all their objects
If .Amount = 0 Then
User_RemoveInvItem UserIndex, Slot
.ObjIndex = 0
End If
End With
'Update the inventory slot
User_UpdateInv False, UserIndex, Slot
'Refresh Store:
If NPCList(NPCIndex).AI = 8 Then
ConBuf.Put_Byte DataCode.Refresh_House_Store
Data_Send ToIndex, UserIndex, ConBuf.Get_Buffer
User_TradeWithNPC UserIndex, NPCIndex
End If
End Sub</vb>
Locate Data_User_Trade_BuyFromNPC and change that whole sub to this:
<vb> Sub Data_User_Trade_BuyFromNPC(ByRef rBuf As DataBuffer, ByVal UserIndex As Integer) '***************************************************************** 'Buy an item from NPC '<Slot(B)><Amount(I)> 'More info: http://www.vbgore.com/GameServer.TCP.Data_User_Trade_BuyFromNPC '***************************************************************** Dim AmountBought As Integer Dim PurchaseObj As Integer Dim NPCIndex As Integer Dim UserSlot As Integer Dim Amount As Integer Dim Slot As Byte Dim Owner As String Dim Premium As Integer Dim ObjectValue As Integer
Log "Call Data_User_Trade_BuyFromNPC([" & ByteArrayToStr(rBuf.Get_Buffer) & "]," & UserIndex & ")", CodeTracker '//\\LOGLINE//\\
Slot = rBuf.Get_Byte Amount = rBuf.Get_Integer
'Set the NPC index to trade with NPCIndex = UserList(UserIndex).Flags.TradeWithNPC
'Check for invalid values If NPCIndex <= 0 Then Exit Sub If NPCIndex > LastNPC Then Exit Sub If Slot > NPCList(NPCIndex).NumVendItems Then Exit Sub If Slot <= 0 Then Exit Sub If UserList(UserIndex).Flags.TradeWithNPC <= 0 Then Exit Sub If NPCList(NPCIndex).VendItems(Slot).ObjIndex <= 0 Then Exit Sub If NPCList(NPCIndex).VendItems(Slot).Amount = 0 Then Exit Sub If Amount < 0 Then Exit Sub
'Check for valid locations
If UserList(UserIndex).Pos.Map <> NPCList(NPCIndex).Pos.Map Then
Data_Send ToIndex, UserIndex, cMessage(36).Data
Exit Sub
End If
If Server_RectDistance(UserList(UserIndex).Pos.X, UserList(UserIndex).Pos.Y, NPCList(NPCIndex).Pos.X, NPCList(NPCIndex).Pos.Y, 6, 6) = 0 Then
Data_Send ToIndex, UserIndex, cMessage(36).Data
Exit Sub
End If
'Set the ObjData of the item to be purchased to the PurchaseObj variable
PurchaseObj = NPCList(NPCIndex).VendItems(Slot).ObjIndex
'Check if NPC is a house servant
If NPCList(NPCIndex).AI = 8 Then
'Make sure Map is an Ownable Property. Load Current Property Info
DB_RS.Open "SELECT * FROM property WHERE `MapNumber`=" & NPCList(NPCIndex).Pos.Map, DB_Conn, adOpenStatic, adLockOptimistic
Premium = Val(DB_RS!Premium)
'Make sure property Info Exists
If DB_RS.EOF Then
DB_RS.Close
Exit Sub
End If
'Get Owner of store
Owner = DB_RS!Owner
Else
Premium = 0
End If
'Add Premium to value
ObjectValue = ObjData.Value(PurchaseObj) + (ObjData.Value(PurchaseObj) * (Premium / 100))
'Check that the user has enough money (if they aren't owner)
If Not Owner = UserList(UserIndex).Name Then
If UserList(UserIndex).Stats.BaseStat(SID.Gold) < ObjectValue * Amount Then
ConBuf.PreAllocate 5 + Len(ObjData.Name(PurchaseObj))
ConBuf.Put_Byte DataCode.Server_Message
ConBuf.Put_Byte 65
ConBuf.Put_Integer Amount
ConBuf.Put_String ObjData.Name(PurchaseObj)
Data_Send ToIndex, UserIndex, ConBuf.Get_Buffer
Exit Sub
End If
End If
'Reduce the amount of items the NPC has If NPCList(NPCIndex).VendItems(Slot).Amount <> -1 Then
'Check if there is enough
If NPCList(NPCIndex).VendItems(Slot).Amount - Amount < 0 Then
ConBuf.PreAllocate 7 + Len(ObjData.Name(PurchaseObj))
ConBuf.Put_Byte DataCode.Server_Message
ConBuf.Put_Byte 66
ConBuf.Put_Integer Amount
ConBuf.Put_String ObjData.Name(PurchaseObj)
ConBuf.Put_Integer NPCList(NPCIndex).VendItems(Slot).Amount
Data_Send ToIndex, UserIndex, ConBuf.Get_Buffer
'Close access to database if it is open
If NPCList(NPCIndex).AI = 8 Then
DB_RS.Close
End If
Exit Sub
End If
'Reduce the amount
NPCList(NPCIndex).VendItems(Slot).Amount = NPCList(NPCIndex).VendItems(Slot).Amount - Amount
'Check if the NPC has hit 0
If NPCList(NPCIndex).VendItems(Slot).Amount = 0 Then
NPCList(NPCIndex).VendItems(Slot).ObjIndex = 0
User_TradeWithNPC UserIndex, NPCIndex 'Update the NPC trade page user-side
End If
'Update Servant Store Items in Database
If NPCList(NPCIndex).AI = 8 Then
Dim i As Integer
Dim ItemsInStore As String
Dim BankGold As Integer
With DB_RS
'Update Items In Store
For i = 1 To NPCList(NPCIndex).NumVendItems
If NPCList(NPCIndex).VendItems(i).Amount > 0 Then
ItemsInStore = ItemsInStore & NPCList(NPCIndex).VendItems(i).ObjIndex & " " & NPCList(NPCIndex).VendItems(i).Amount & vbNewLine
End If
Next i
!ItemsInStore = ItemsInStore
.Update
End With
DB_RS.Close
'Refresh Store:
ConBuf.Put_Byte DataCode.Refresh_House_Store
Data_Send ToIndex, UserIndex, ConBuf.Get_Buffer
User_TradeWithNPC UserIndex, NPCIndex
'Update Owner's Bank Gold
DB_RS.Open "SELECT * FROM users WHERE `name`='" & Owner & "'", DB_Conn, adOpenStatic, adLockOptimistic
If DB_RS.EOF Then
DB_RS.Close
Else
'Update Gold
BankGold = DB_RS!BankGold
DB_RS!BankGold = BankGold + (ObjectValue * AmountBought)
'Update the database
DB_RS.Update
'Close the recordset
DB_RS.Close
End If
End If
ElseIf NPCList(NPCIndex).AI = 8 Then
'Close access to database if it is open
With DB_RS
.Update
.Close
End With
End If
'Give the user the objects
AmountBought = User_GiveObj(UserIndex, PurchaseObj, Amount, True)
'Take the user's money UserList(UserIndex).Stats.BaseStat(SID.Gold) = UserList(UserIndex).Stats.BaseStat(SID.Gold) - (ObjectValue * AmountBought)
'Send the purchase message (if not owner of store)
If Not (NPCList(NPCIndex).AI = 8 And Owner = UserList(UserIndex).Name) Then
ConBuf.Put_Byte DataCode.Server_Message
ConBuf.Put_Byte 67
ConBuf.Put_Integer Amount
ConBuf.Put_String ObjData.Name(PurchaseObj)
ConBuf.Put_Long (ObjectValue * Amount)
Data_Send ToIndex, UserIndex, ConBuf.Get_Buffer
End If
End Sub </vb>
Now add this sub to the module: <vb>
Sub Data_User_ChangePremium(ByRef rBuf As DataBuffer, ByVal UserIndex As Integer) '***************************************************************** 'Change Premium Rate of Items in Store '***************************************************************** Dim Premium As Integer Dim ServantID As Integer
'Get Servant ID ServantID = rBuf.Get_Integer
'Make sure Map is an Ownable Property. Load Current Property Info DB_RS.Open "SELECT * FROM property WHERE `MapNumber`=" & UserList(UserIndex).Pos.Map, DB_Conn, adOpenStatic, adLockOptimistic
'Make sure property Info Exists
If DB_RS.EOF Then
DB_RS.Close
Exit Sub
End If
With DB_RS
Premium = Val(!Premium) + 5
If Premium > 15 Then
Premium = -15
End If
!Premium = Premium
'Update Changes
.Update
.Close
End With
'Refresh Servant Menu
NPC_House_Servant UserIndex, ServantID, UserList(UserIndex).Pos.Map
End Sub </vb>
Now add these new Subs to the code:
<vb>Sub Data_User_House_Rest(ByVal UserIndex As Integer) '***************************************************************** 'Rest up (Heal hp; Restore mana) '***************************************************************** Dim RestorePercent As Integer
'Percent to restore stats
RestorePercent = 25
If UserList(UserIndex).Stats.BaseStat(SID.MinHP) < UserList(UserIndex).Stats.BaseStat(SID.MaxHP) Then
'Restore % of the HP
UserList(UserIndex).Stats.BaseStat(SID.MinHP) = UserList(UserIndex).Stats.BaseStat(SID.MinHP) + (UserList(UserIndex).Stats.ModStat(SID.MaxHP) * (RestorePercent / 100))
End If
If UserList(UserIndex).Stats.BaseStat(SID.MinMAN) < (UserList(UserIndex).Stats.ModStat(SID.MaxMAN) * (RestorePercent / 100)) Then
'Restore % of the Mana
UserList(UserIndex).Stats.BaseStat(SID.MinMAN) = UserList(UserIndex).Stats.BaseStat(SID.MinMAN) + (UserList(UserIndex).Stats.ModStat(SID.MaxMAN) * (RestorePercent / 100))
End If
'MESSAGE USER THAT THEY REST AND HEAL
Data_Send ToIndex, UserIndex, cMessage(140).Data
End Sub
Sub Data_User_House_Buy(ByVal UserIndex As Integer) '***************************************************************** 'Buy House '***************************************************************** Dim Owner As String Dim Value As Integer
'Check if User already owns a property
DB_RS.Open "SELECT * FROM property WHERE `Owner`='" & UserList(UserIndex).Name & "'", DB_Conn, adOpenStatic, adLockOptimistic
'If user owns property, then quit
If Not DB_RS.EOF Then
DB_RS.Close
Exit Sub
End If
DB_RS.Close
'Check that Map is an Ownable Property. Load Current Property Info
DB_RS.Open "SELECT * FROM property WHERE `MapNumber`=" & UserList(UserIndex).Pos.Map, DB_Conn, adOpenStatic, adLockOptimistic
'Make sure property Info Exists
If DB_RS.EOF Then
DB_RS.Close
Exit Sub
End If
With DB_RS
'Get property
Owner = !Owner
Value = Val(!Value)
'Check if Property is owned
If Trim(Owner) = "" Then
'Check that user has enough gold
If UserList(UserIndex).Stats.BaseStat(SID.Gold) > Value Then
'Remove Gold from User
UserList(UserIndex).Stats.BaseStat(SID.Gold) = UserList(UserIndex).Stats.BaseStat(SID.Gold) - Value
'Set Owner of property
!Owner = UserList(UserIndex).Name
!LastVisit = Date$
'MESSAGE USER THEY BOUGHT HOUSE
ConBuf.Put_Byte DataCode.Server_Message
ConBuf.Put_Byte 141
ConBuf.Put_Integer Value
Data_Send ToIndex, UserIndex, ConBuf.Get_Buffer
Else
'MESSAGE USER THEY DON'T HAVE ENOUGH GOLD
Data_Send ToIndex, UserIndex, cMessage(142).Data
End If
Else
'MESSAGE USER HOUSE IS ALREADY OWNED
Data_Send ToIndex, UserIndex, cMessage(143).Data
End If
'Update the database
.Update
'Close the recordset
.Close
End With
End Sub
Sub Data_User_House_Sell(ByVal UserIndex As Integer) '***************************************************************** 'Sell House '***************************************************************** Dim Owner As String Dim Value As Integer Dim i As Long Dim j As Byte Dim ItemsInStore As String Dim StoreItems() As String Dim ItemSplit() As String
'Check that Map is an Ownable Property. Load Current Property Info
DB_RS.Open "SELECT * FROM property WHERE `MapNumber`=" & UserList(UserIndex).Pos.Map, DB_Conn, adOpenStatic, adLockOptimistic
'Make sure property Info Exists
If DB_RS.EOF Then
DB_RS.Close
Exit Sub
End If
With DB_RS
'Get property
Owner = !Owner
Value = Val(!Value)
'Check if user owns property
If Trim(Owner) = UserList(UserIndex).Name Then
'Add Gold to User
UserList(UserIndex).Stats.BaseStat(SID.Gold) = UserList(UserIndex).Stats.BaseStat(SID.Gold) + (Value * 0.75) 'reduce value when selling (get 75% of what owner paid). Update client if you change this (Data_User_House_Owner)
'Readd Items from store into user's bank:
If Not !ItemsInStore = "" Then
'Format Item List for Store
StoreItems = Split(!ItemsInStore, vbNewLine)
'Get Number of Store Items
If UBound(StoreItems) > 0 Then
'Load Items from database
j = UBound(StoreItems)
'Loop through Store Items and Add To user's bank
For i = 0 To j - 1
Log "Save_NPCs_Temp: Splitting item information (" & StoreItems(i) & ")", CodeTracker '//\\LOGLINE//\\
ItemSplit = Split(Trim$(StoreItems(i)), " ")
If UBound(ItemSplit) = 1 Then 'If ubound <> 1, we have an invalid item entry
If Not Val(ItemSplit(0)) = 0 And Not Val(ItemSplit(1)) Then
AddItemToBank UserIndex, Val(ItemSplit(0)), Val(ItemSplit(1))
End If
Else
Log "Save_NPCs_Temp: Invalid User shop/vending item entry found in the database. User: " & UserList(UserIndex).Name & " Slot: " & i, CriticalError '//\\LOGLINE//\\
End If
Next i
End If
End If
'Set Owner of property
!Owner = ""
!ItemsInStore = ""
'MESSAGE USER THEY SOLD HOUSE
ConBuf.Put_Byte DataCode.Server_Message
ConBuf.Put_Byte 144
ConBuf.Put_Integer Value
Data_Send ToIndex, UserIndex, ConBuf.Get_Buffer
Else
'MESSAGE USER THAT THEY DON'T OWN HOUSE
Data_Send ToIndex, UserIndex, cMessage(145).Data
End If
'Update the database
.Update
'Close the recordset
.Close
End With
End Sub
Sub Data_User_House_Bank(ByRef rBuf As DataBuffer, ByVal UserIndex As Integer) '***************************************************************** 'Access Bank Through House Servant '***************************************************************** Dim ServantID As Integer Dim LoopC As Long
'Get Servant ID
ServantID = rBuf.Get_Integer
'Access Bank
UserList(UserIndex).Flags.TradeWithNPC = ServantID
ConBuf.PreAllocate 2
ConBuf.Put_Byte DataCode.User_Bank_Open
For LoopC = 1 To MAX_INVENTORY_SLOTS
If UserList(UserIndex).Bank(LoopC).ObjIndex > 0 Then
ConBuf.Put_Byte LoopC
ConBuf.Put_Long ObjData.GrhIndex(UserList(UserIndex).Bank(LoopC).ObjIndex)
ConBuf.Put_Integer UserList(UserIndex).Bank(LoopC).Amount
End If
Next LoopC
ConBuf.Put_Byte 255 'Terminator byte - tells the client the list has ended
Data_Send ToIndex, UserIndex, ConBuf.Get_Buffer, , PP_Banking
End Sub
Sub Data_User_House_Mail(ByRef rBuf As DataBuffer, ByVal UserIndex As Integer)
'*****************************************************************
'Access Mail Through House Servant
'*****************************************************************
Dim ServantID As Integer
Dim LoopC As Long
Dim MsgData As MailData
'Get Servant ID ServantID = rBuf.Get_Integer 'Store the position of the mailbox for later reference in case user tries to use items away from mailbox UserList(UserIndex).MailboxPos.Map = NPCList(ServantID).Pos.Map UserList(UserIndex).MailboxPos.X = NPCList(ServantID).Pos.X UserList(UserIndex).MailboxPos.Y = NPCList(ServantID).Pos.Y
'Resend all the mail
ConBuf.PreAllocate 2 'One for header, one for end byte
ConBuf.Put_Byte DataCode.Server_MailBox
For LoopC = 1 To MaxMailPerUser
If UserList(UserIndex).MailID(LoopC) > 0 Then
MsgData = Load_Mail(UserList(UserIndex).MailID(LoopC))
ConBuf.Allocate 4 + Len(MsgData.WriterName) + Len(CStr(MsgData.RecieveDate)) + Len(MsgData.Subject)
ConBuf.Put_Byte MsgData.New
ConBuf.Put_String MsgData.WriterName
ConBuf.Put_String CStr(MsgData.RecieveDate)
ConBuf.Put_String MsgData.Subject
End If
Next LoopC
ConBuf.Put_Byte 255 'The byte of value 255 states that we have reached the end, while 0 or 1 means it is a new message (states the "New" flag)
Data_Send ToIndex, UserIndex, ConBuf.Get_Buffer, , PP_Mail
End Sub
Sub Data_User_House_Store(ByRef rBuf As DataBuffer, ByVal UserIndex As Integer) '***************************************************************** 'Access Store Through House Servant '***************************************************************** Dim ServantID As Integer Dim i As Long Dim j As Byte Dim ItemsInStore As String Dim StoreItems() As String Dim ItemSplit() As String
'Get Servant ID ServantID = rBuf.Get_Integer 'Make sure Map is an Ownable Property. Load Current Property Info DB_RS.Open "SELECT * FROM property WHERE `MapNumber`=" & NPCList(ServantID).Pos.Map, DB_Conn, adOpenStatic, adLockOptimistic
'Make sure property Info Exists
If DB_RS.EOF Then
DB_RS.Close
Exit Sub
End If
With DB_RS
'Get Items In Store from database
ItemsInStore = !ItemsInStore
'Format Item List for Store
StoreItems = Split(ItemsInStore, vbNewLine)
'Get Number of Store Items
If UBound(StoreItems) > 0 Then
'Load Items from database
j = UBound(StoreItems)
ReDim NPCList(ServantID).VendItems(1 To j)
NPCList(ServantID).NumVendItems = j
'Loop through Store Items and Add To House Servant's VendItems list
For i = 0 To j - 1
Log "Save_NPCs_Temp: Splitting item information (" & StoreItems(i) & ")", CodeTracker '//\\LOGLINE//\\
ItemSplit = Split(Trim$(StoreItems(i)), " ")
If UBound(ItemSplit) = 1 Then 'If ubound <> 1, we have an invalid item entry
If Not Val(ItemSplit(0)) = 0 And Not Val(ItemSplit(1)) Then
NPCList(ServantID).VendItems(i + 1).ObjIndex = Val(ItemSplit(0))
NPCList(ServantID).VendItems(i + 1).Amount = Val(ItemSplit(1))
End If
Else
Log "Save_NPCs_Temp: Invalid shop/vending item entry found in the database. NPC: " & NPCList(ServantID).Name & " Slot: " & i, CriticalError '//\\LOGLINE//\\
End If
Next i
Else
'Make sure store has at least 1 item to avoid problems with redimensioning arrays
ReDim NPCList(ServantID).VendItems(1 To 1)
j = 1
NPCList(ServantID).NumVendItems = j
'Create Default Item for store (one that is virtually worthless :P)
NPCList(ServantID).VendItems(i + 1).ObjIndex = 1
NPCList(ServantID).VendItems(i + 1).Amount = 1
End If
'Open Store
User_TradeWithNPC UserIndex, ServantID
DB_RS.Close
End With
End Sub</vb>
While we're in this TCP.bas, for those of you who have implemented my Guild system, here's a little addition for the function that assigns rank to a player "Data_User_Group_Assign". I basically added a new message to display when there is an invalid user or rank entered. So go to that function and find
<vb>If UBound(tNameRank) <> 1 Then</vb>
and change that section of code to this:
<vb> If UBound(tNameRank) <> 1 Then
' improper command syntaxx
Data_Send ToIndex, UserIndex, cMessage(149).Data()
Exit Sub
Else
If Val(tNameRank(1)) > 0 And Val(tNameRank(1)) < UBound(GroupRanks) And Len(tNameRank(0)) > 0 Then
tName = tNameRank(0)
tRank = tNameRank(1)
Else
'MESSAGE USER THEY ENTERED INVALID USERS FOR NAME AND/OR RANK
Data_Send ToIndex, UserIndex, cMessage(149).Data()
Exit Sub
End If
End If</vb>
In TCP.Bas, add this module:
<vb>
Public Function AddItemToBank(ByVal UserIndex As Integer, ByVal ObjIndex As Long, ByVal Amount As Integer) As Boolean
'*****************************************************************
'Put item in specified user's bank
'*****************************************************************
Dim PutSlot As Byte
'Check for a valid distance from the banker NPC
If UserList(UserIndex).Flags.TradeWithNPC > 0 Then
With NPCList(UserList(UserIndex).Flags.TradeWithNPC)
If Not (NPCList(UserList(UserIndex).Flags.TradeWithNPC).AI = 6 Or NPCList(UserList(UserIndex).Flags.TradeWithNPC).AI = 8) Then Exit Function 'Not a banker
If Server_RectDistance(UserList(UserIndex).Pos.X, UserList(UserIndex).Pos.Y, .Pos.X, .Pos.Y, MaxServerDistanceX, MaxServerDistanceY) = 0 Then Exit Function 'Out of range
End With
Else
Exit Function 'No clicked NPC
End If
'Check for item of the same type already in there
PutSlot = 1
If ObjData.Stacking(UserList(UserIndex).Bank(PutSlot).ObjIndex) > 1 Then
PutSlot = 0
Do
PutSlot = PutSlot + 1
If PutSlot > MAX_INVENTORY_SLOTS Then
PutSlot = 0
Exit Do
End If
Loop While UserList(UserIndex).Bank(PutSlot).ObjIndex <> ObjIndex
Else
PutSlot = 0 'Force to check the next free slot
End If
'If PutSlot = 0, no duplicate item was found, so use the next free slot
If PutSlot = 0 Then
Do
PutSlot = PutSlot + 1
If PutSlot > MAX_INVENTORY_SLOTS Then
'Bank is full
Data_Send ToIndex, UserIndex, cMessage(97).Data
Exit Function
End If
Loop While UserList(UserIndex).Bank(PutSlot).ObjIndex > 0
'Just as a pre-caution, we empty the amount value since we are going to be adding on to it and it should be empty
UserList(UserIndex).Bank(PutSlot).Amount = 0
End If
'Check if theres room for the item
If UserList(UserIndex).Bank(PutSlot).Amount + Amount > ObjData.Stacking(ObjIndex) Then
Data_Send ToIndex, UserIndex, cMessage(97).Data
Exit Function
End If
'Put the items
UserList(UserIndex).Bank(PutSlot).ObjIndex = ObjIndex
UserList(UserIndex).Bank(PutSlot).Amount = UserList(UserIndex).Bank(PutSlot).Amount + Amount
'Update the bank slot
User_UpdateBank UserIndex, PutSlot
'ItemAdded Successfully to Bank
AddItemToBank = True
End Function </vb>
Go to Data_User_Bank_PutItem and replace that sub with this:
<vb>
Sub Data_User_Bank_PutItem(ByRef rBuf As DataBuffer, ByVal UserIndex As Integer)
'*****************************************************************
'Client requests to put an item in bank
'<Slot(B)><Amount(I)>
'More info: http://www.vbgore.com/GameServer.TCP.Data_User_Bank_PutItem
'*****************************************************************
Dim Slot As Byte
Dim Amount As Integer
Dim SuccessfulAdd As Boolean
Slot = rBuf.Get_Byte
Amount = rBuf.Get_Integer
'Check for invalid values
If Slot <= 0 Then Exit Sub
If Slot > MAX_INVENTORY_SLOTS Then Exit Sub
If UserList(UserIndex).Object(Slot).ObjIndex = 0 Then Exit Sub
If Amount > UserList(UserIndex).Object(Slot).Amount Then Amount = UserList(UserIndex).Object(Slot).Amount
If Amount <= 0 Then Exit Sub
'Add Item to Bank
SuccessfulAdd = AddItemToBank(UserIndex, UserList(UserIndex).Object(Slot).ObjIndex, Amount)
If SuccessfulAdd Then
'Remove the items from the user
UserList(UserIndex).Object(Slot).Amount = UserList(UserIndex).Object(Slot).Amount - Amount
'Check if the user ran out of items
If UserList(UserIndex).Object(Slot).Amount <= 0 Then
'User depotted all the items, so remove it from the inventory
If UserList(UserIndex).Object(Slot).Equipped Then User_RemoveInvItem UserIndex, Slot
'Remove the item
UserList(UserIndex).Object(Slot).ObjIndex = 0
End If
'Update the inventory
User_UpdateInv False, UserIndex, Slot
End If
End Sub </vb>
Go to Users.bas and find:
<vb>'*** Check for NPC banker ***
If NPCList(TempIndex).AI = 6 Then
UserList(UserIndex).Flags.TradeWithNPC = TempIndex
ConBuf.PreAllocate 2
ConBuf.Put_Byte DataCode.User_Bank_Open
For LoopC = 1 To MAX_INVENTORY_SLOTS
If UserList(UserIndex).Bank(LoopC).ObjIndex > 0 Then
ConBuf.Put_Byte LoopC
ConBuf.Put_Long ObjData.GrhIndex(UserList(UserIndex).Bank(LoopC).ObjIndex)
ConBuf.Put_Integer UserList(UserIndex).Bank(LoopC).Amount
End If
Next LoopC
ConBuf.Put_Byte 255 'Terminator byte - tells the client the list has ended
Data_Send ToIndex, UserIndex, ConBuf.Get_Buffer, , PP_Banking</vb>
Below that add this:
<vb> '*** Check For Player-House Servant ***
ElseIf NPCList(TempIndex).AI = 8 Then
'Check if map is a property
If MapInfo(NPCList(TempIndex).Pos.Map).Property = 1 Then
Call NPC_House_Servant(UserIndex, TempIndex, Map)
End If
'*** Check For Furniture ***
ElseIf NPCList(TempIndex).AI = 9 Then
If MapInfo(NPCList(TempIndex).Pos.Map).Property = 1 Then
Call NPC_FurnitureClick(UserIndex, TempIndex, Map)
End If
Else
'*** Check for NPC vendor ***
If NPCList(TempIndex).NumVendItems > 0 Then
User_TradeWithNPC UserIndex, TempIndex
FoundSomething = 1
Else
'*** NPC not a vendor, give description ***
If Len(NPCList(TempIndex).Name) > 1 Then
ConBuf.PreAllocate 4 + Len(NPCList(TempIndex).Name) + Len(NPCList(TempIndex).Desc)
ConBuf.Put_Byte DataCode.Server_Message
ConBuf.Put_Byte 30
ConBuf.Put_String NPCList(TempIndex).Name
ConBuf.Put_String NPCList(TempIndex).Desc
Data_Send ToIndex, UserIndex, ConBuf.Get_Buffer
Else
ConBuf.PreAllocate 3 + Len(NPCList(TempIndex).Name)
ConBuf.Put_Byte DataCode.Server_Message
ConBuf.Put_Byte 31
ConBuf.Put_String NPCList(TempIndex).Name
Data_Send ToIndex, UserIndex, ConBuf.Get_Buffer
End If
'*** Quest NPC ***
If NPCList(TempIndex).Quest > 0 Then Quest_General UserIndex, TempIndex
End If
End If</vb>
Now go to User_NearBankNPC and find:
<vb>If NPCList(MapInfo(UserList(UserIndex).Pos.Map).Data(X, Y).NPCIndex).AI = 6</vb>
and change that section of code to:
<vb> 'NPC was found, check if it is a banker NPC AI or house servent AI
If NPCList(MapInfo(UserList(UserIndex).Pos.Map).Data(X, Y).NPCIndex).AI = 6 Or NPCList(MapInfo(UserList(UserIndex).Pos.Map).Data(X, Y).NPCIndex).AI = 8 Then</vb>
Go to User_UseInvItem
Find
<vb>Select Case ObjData.ObjType(ObjIndex)</vb>
and change that section of code to:
<vb>Select Case ObjData.ObjType(ObjIndex)
Case OBJTYPE_USEONCE, OBJTYPE_USEINFINITE, OBJTYPE_FURNITURE
Log "User_UseInvItem: ObjType = OBJTYPE_USEONCE", CodeTracker '//\\LOGLINE//\\
'Spawn Furniture NPC
If ObjData.ObjType(ObjIndex) = OBJTYPE_FURNITURE Then
'Only Spawn Furniture if Player is in their Property
If MapInfo(UserList(UserIndex).Pos.Map).Property = 1 Then
Dim Owner As String 'Owner of Property
Dim Furniture As String 'Furniture On Map
Dim Success As Boolean 'Was the furniture successfully added?
Dim NewFurniture As Integer 'NewFurniture is NPC index of newly spawned furniture
'User is on a Property type map. Check that it is theirs
DB_RS.Open "SELECT * FROM property WHERE `MapNumber`=" & UserList(UserIndex).Pos.Map, DB_Conn, adOpenStatic, adLockOptimistic
'Make sure property Info Exists
If DB_RS.EOF Then
DB_RS.Close
Exit Sub
End If
'Retrieve ownership and Furniture Info
With DB_RS
Owner = !Owner
Furniture = !Furniture
Success = True
If Owner = UserList(UserIndex).Name Then
NewFurniture = SpawnNewNPC(UserIndex, ObjData.NPC_Spawn_Index(ObjIndex), 0, -1, 0, 0, 9)
'Check for an invalid index (load failed)
If NewFurniture < 1 Then
'MESSAGE USER THAT THERE WAS NO VALID LOCATION TO PLACE FURNITURE
Data_Send ToIndex, UserIndex, cMessage(148).Data()
Success = False
End If
Else
'MESSAGE USER THAT THEY MUST BE ON PROPERTY TO SPAWN FURNITURE
Data_Send ToIndex, UserIndex, cMessage(147).Data()
Success = False
End If
'Update Furniture On Map
Furniture = !Furniture & ObjData.NPC_Spawn_Index(ObjIndex) & " " & NPCList(NewFurniture).Pos.X & " " & NPCList(NewFurniture).Pos.Y & vbNewLine
!Furniture = Furniture
'Update Changes
DB_RS.Update
DB_RS.Close
If Not Success Then
Exit Sub
End If
End With
Else
'MESSAGE USER THAT THEY MUST BE ON PROPERTY TO SPAWN FURNITURE
Data_Send ToIndex, UserIndex, cMessage(147).Data()
Exit Sub
End If
End If
'Remove from inventory
If ObjData.ObjType(ObjIndex) = OBJTYPE_USEONCE Or ObjData.ObjType(ObjIndex) = OBJTYPE_FURNITURE Then
UserList(UserIndex).Object(Slot).Amount = UserList(UserIndex).Object(Slot).Amount - 1
If UserList(UserIndex).Object(Slot).Amount <= 0 Then UserList(UserIndex).Object(Slot).ObjIndex = 0
End If
'Set the paper-doll
User_ChangeChar ToMap, UserIndex, UserIndex, ObjData.SpriteBody(ObjIndex), ObjData.SpriteHead(ObjIndex), ObjData.SpriteWeapon(ObjIndex), ObjData.SpriteHair(ObjIndex), ObjData.SpriteWings(ObjIndex), ObjData.SpriteMount(ObjIndex), ObjData.SpriteShield(ObjIndex)
'Create the graphic effect
If ObjData.UseGrh(ObjIndex) > 0 Then
ConBuf.PreAllocate 7
ConBuf.Put_Byte DataCode.Server_MakeEffect
ConBuf.Put_Byte UserList(UserIndex).Pos.X
ConBuf.Put_Byte UserList(UserIndex).Pos.Y
ConBuf.Put_Long ObjData.UseGrh(ObjIndex)
Data_Send ToPCArea, UserIndex, ConBuf.Get_Buffer
End If
'Create the sound effect
If ObjData.UseSfx(ObjIndex) > 0 Then
ConBuf.PreAllocate 4
ConBuf.Put_Byte DataCode.Server_PlaySound3D
ConBuf.Put_Byte UserList(UserIndex).Pos.X
ConBuf.Put_Byte UserList(UserIndex).Pos.Y
ConBuf.Put_Byte ObjData.UseSfx(ObjIndex)
Data_Send ToPCArea, UserIndex, ConBuf.Get_Buffer, , PP_Sound
End If
Case OBJTYPE_WEAPON
... </vb>
Now open ObjData.cls and add this to it:
<vb>Public Property Get NPC_Spawn_Index(ByVal Index As Integer) As Integer
If Index > 0 Then
If Index <= MaxDatas Then
ReadyObj Index
NPC_Spawn_Index = cData(ObjIndexToDataIndex(Index)).NPC_Spawn
End If
End If
End Property</vb>
Editions ----
Go to Data_User_House_Store Find this line: <vb> NPCList(ServantID).VendItems(i + 1).Amount = Val(ItemSplit(1)) </vb> and below it add this: <vb> NPCList(ServantID).VendItems(i + 1).Premium = Val(!Premium) </vb>
then find this line: <vb> NPCList(ServantID).VendItems(i + 1).Amount = 1 </vb> and below it add this: <vb> NPCList(ServantID).VendItems(i + 1).Premium = 0 </vb>
Go to Users.bas
Go to User_TradeWithNPC
Add this to the beginning of the sub: <vb> Dim Premium As Integer </vb>
Then find <vb> ConBuf.Put_Long ObjData.Value(NPCList(NPCIndex).VendItems(LoopC).ObjIndex) </vb>
and replace it with this: <vb>
ObjValue = ObjData.Value(NPCList(NPCIndex).VendItems(LoopC).ObjIndex)
Premium = NPCList(NPCIndex).VendItems(LoopC).Premium
ObjValue = ObjValue + (ObjValue * (Premium / 100))
ConBuf.Put_Long ObjValue
</vb>
Go to NPCs.bas Go to NPC_House_Servant
Add this to the beginning of the sub: <vb> Dim Premium As Integer </vb>
Find this: <vb> 'Get property Info
Value = Val(!Value)
ItemsInStore = !ItemsInStore
</vb>
and add this line of code after it: <vb> Premium = Val(!Premium) </vb>
Then find
<vb>
If Owner = UserList(UserIndex).Name Then
</vb>
and replace that section of code with this: <vb>
If Owner = UserList(UserIndex).Name Then
'---------------------------
'- Owner Actions Available:
' - Remove Items from store
' - Get Items from bank
' - Access Mail
' - Rest
' - Sell House
' - when selling property, you get a % of its value
' - Premium of House
'---------------------------
'Send Property Info To User
ConBuf.Put_Byte DataCode.User_House_Owner
ConBuf.Put_String ItemsInStore
ConBuf.Put_Integer Value
ConBuf.Put_Integer NPCIndex
ConBuf.Put_Integer Premium
Else
</vb>
Go to Declares.bas
Find this:
<vb>Public Type Obj 'Holds info about a object</vb>
and in that block of code add this: <vb> Premium As Integer 'Premium Charge Of Object </vb>
Go to frmMain.frm
Find this: <vb> Case .TeleportToHouse: Data_User_TeleportToHouse Index </vb>
and below it add this: <vb> Case .User_ChangePremium: Data_User_ChangePremium rBuf, Index </vb>
FIX ------
Go to TCP.bas
Find <vb> ObjectValue = ObjData.Value(PurchaseObj) + (ObjData.Value(PurchaseObj) * (Premium / 100)) </vb>
and below it put this: <vb>
If (ObjectValue < 1) Then
ObjectValue = 1
End If
</vb>
Youre done!
Adding a new house
Go to the Database
Go to the Property Table 1) Add a new record 2) In the MapNumber field, put the number of the map that is to be a property/house 3) Put the value of the property in the Value field
That's it for this table
In the previous posts, we already added a servant and a chair item/npc. Just do those steps again to add more. However, what I failed to mention before about the Chair NPC (and all furniture NPCs) is that you give them one and only one drop item. That item is what is added to the user's inventory when they "pick up" their furniture from the map.
The way it works is that the user clicks on the furniture in their inventory. That item is removed from their inventory and a new NPC (specified by the NPC_Spawn field of the object) is added to the map representing the furniture. When the user clicks on the furniture NPC, the NPC is removed and the item (specified in the drop field) is added to the user's inventory.
Now, go to the map editor, open the map representing the property/house. Go to the map info, and check "Is Property" and hit apply. This makes the property "ownable".
Only the owner can add/remove furniture to a property.
While in the map editor still, add a chosen servant to the map. When the property is not owned, and a visitor clicks on the servant, they are given a choice to Rest (like at an INN) and buy the property. When it is Owned, and a visitor clicks on the Servant, they are given a choice to Rest or buy items from the Owner's Store. If the owner clicks on the servant, they have the choice to Rest, Add/remove items from their Store, Access mail, and Access their bank, as well as to sell their property (for 75% of the purchase price. you can go to the code and change this. It is documented).
Players can only own one property.
Due to how the store script works, the Store Menu will not open unless there's an item in there. And due to some other inherit "features," I made it add a default worthless item to the store when it is empty (the tiny healing potion, which I gave a price of 1 in the database).
When someone buys from the store, the owner gets the money added to their bank!
When adding furniture, the furniture will face the same direction as the player.
So that's that!
I added a preview of everything.
Update
Some that I forgot: In the Client script, go to TCP.bas
Find Data_Server_Message
At the end, add this:
<vb> Case 146
Engine_AddToChatTextBuffer Message(146), FontColor_Group
Case 147
Engine_AddToChatTextBuffer Message(147), FontColor_Info
Case 148
Engine_AddToChatTextBuffer Message(148), FontColor_Info
Case 149
Engine_AddToChatTextBuffer Message(149), FontColor_Group
Case 150
Engine_AddToChatTextBuffer Message(150), FontColor_Info</vb>
Now for the new stuff For this, I updated the message files. So they're attached for you to download
Updated message files: http://www.vbgore.com/forums/download/file.php?id=263
Now for the code. For my "Pretty Menu" as I mentioned before, I have a house Icon on there that was previously unused until I could finish housing. So, here it is!
Gameclient
Go to frmMain.frm
Find:
<vb>Case .Refresh_House_Store: Data_User_Refresh_Store rBuf</vb>
and below it add this:
<vb>Case .TeleportToHouseEffect: Data_Server_HouseTeleportEffect rBuf</vb>
Go to DataIDs.bas
Find "User_HouseSell As Byte" and below it add:
<vb> TeleportToHouse As Byte
TeleportToHouseEffect As Byte</vb>
Then go to InitDataCommands and find
<vb>.User_HouseSell = 135 'Sell House</vb>
and below it add:
<vb> .TeleportToHouse = 136 'Teleport To House
.TeleportToHouseEffect = 137 'Teleport To House Particle Effect</vb>
Go to Particles.bas
Find
<vb>Public Const EffectNum_Summon As Byte = 10 'Summon effect</vb>
and below it add:
<vb>Public Const EffectNum_HouseTeleport As Byte = 11 'Teleport To House Effect</vb>
then go to Effect_UpdateAll and find
<vb>If Effect(LoopC).EffectNum = EffectNum_Bless Then Effect_Bless_Update LoopC</vb>
and below it add:
<vb>If Effect(LoopC).EffectNum = EffectNum_HouseTeleport Then Effect_HouseTeleport_Update LoopC</vb>
Then add these subs to the script:
<vb>Function Effect_HouseTeleport_Begin(ByVal X As Single, ByVal Y As Single, ByVal Gfx As Integer, ByVal Particles As Integer, Optional ByVal Size As Byte = 30, Optional ByVal Time As Single = 10) As Integer Dim EffectIndex As Integer Dim LoopC As Long
'Get the next open effect slot EffectIndex = Effect_NextOpenSlot If EffectIndex = -1 Then Exit Function
'Return the index of the used slot Effect_HouseTeleport_Begin = EffectIndex
'Set The Effect's Variables Effect(EffectIndex).EffectNum = EffectNum_HouseTeleport 'Set the effect number Effect(EffectIndex).ParticleCount = Particles 'Set the number of particles Effect(EffectIndex).Used = True 'Enabled the effect Effect(EffectIndex).X = X 'Set the effect's X coordinate Effect(EffectIndex).Y = Y 'Set the effect's Y coordinate Effect(EffectIndex).Gfx = Gfx 'Set the graphic Effect(EffectIndex).Modifier = Size 'How large the circle is Effect(EffectIndex).Progression = Time 'How long the effect will last
'Set the number of particles left to the total avaliable Effect(EffectIndex).ParticlesLeft = Effect(EffectIndex).ParticleCount
'Set the float variables Effect(EffectIndex).FloatSize = Effect_FToDW(20) 'Size of the particles
'Redim the number of particles ReDim Effect(EffectIndex).Particles(0 To Effect(EffectIndex).ParticleCount) ReDim Effect(EffectIndex).PartVertex(0 To Effect(EffectIndex).ParticleCount)
'Create the particles
For LoopC = 0 To Effect(EffectIndex).ParticleCount
Set Effect(EffectIndex).Particles(LoopC) = New Particle
Effect(EffectIndex).Particles(LoopC).Used = True
Effect(EffectIndex).PartVertex(LoopC).Rhw = 1
Effect_HouseTeleport_Reset EffectIndex, LoopC
Next LoopC
'Set The Initial Time Effect(EffectIndex).PreviousFrame = timeGetTime
End Function
Private Sub Effect_HouseTeleport_Reset(ByVal EffectIndex As Integer, ByVal Index As Long) '***************************************************************** 'More info: http://www.vbgore.com/CommonCode.Particles.Effect_HouseTeleport_Reset '***************************************************************** Dim a As Single Dim X As Single Dim Y As Single Dim r As Single
r = Sin(20 / (Index + 1)) * 100 X = r * Cos((Index)) Y = r * Sin((Index))
'Reset the particle Effect(EffectIndex).Particles(Index).ResetIt Effect(EffectIndex).X + X, Effect(EffectIndex).Y + Y, 0, 0, 0, 0 Effect(EffectIndex).Particles(Index).ResetColor Rnd, Rnd, 1, Rnd, 0.2 + (Rnd * 0.5)
End Sub
Private Sub Effect_HouseTeleport_Update(ByVal EffectIndex As Integer) Dim ElapsedTime As Single Dim LoopC As Long
'Calculate The Time Difference ElapsedTime = (timeGetTime - Effect(EffectIndex).PreviousFrame) * 0.01 Effect(EffectIndex).PreviousFrame = timeGetTime
'Update the life span If Effect(EffectIndex).Progression > 0 Then Effect(EffectIndex).Progression = Effect(EffectIndex).Progression - ElapsedTime
'Go Through The Particle Loop For LoopC = 0 To Effect(EffectIndex).ParticleCount
'Check If Particle Is In Use
If Effect(EffectIndex).Particles(LoopC).Used Then
'Update The Particle
Effect(EffectIndex).Particles(LoopC).UpdateParticle ElapsedTime
'Check if the particle is ready to die
If Effect(EffectIndex).Particles(LoopC).sngA <= 0 Then
'Check if the effect is ending
If Effect(EffectIndex).Progression > 0 Then
'Reset the particle
Effect_HouseTeleport_Reset EffectIndex, LoopC
Else
'Disable the particle
Effect(EffectIndex).Particles(LoopC).Used = False
'Subtract from the total particle count
Effect(EffectIndex).ParticlesLeft = Effect(EffectIndex).ParticlesLeft - 1
'Check if the effect is out of particles
If Effect(EffectIndex).ParticlesLeft = 0 Then Effect(EffectIndex).Used = False
'Clear the color (dont leave behind any artifacts)
Effect(EffectIndex).PartVertex(LoopC).Color = 0
End If
Else
'Set the particle information on the particle vertex
Effect(EffectIndex).PartVertex(LoopC).Color = D3DColorMake(Effect(EffectIndex).Particles(LoopC).sngR, Effect(EffectIndex).Particles(LoopC).sngG, Effect(EffectIndex).Particles(LoopC).sngB, Effect(EffectIndex).Particles(LoopC).sngA)
Effect(EffectIndex).PartVertex(LoopC).X = Effect(EffectIndex).Particles(LoopC).sngX
Effect(EffectIndex).PartVertex(LoopC).Y = Effect(EffectIndex).Particles(LoopC).sngY
End If
End If
Next LoopC
End Sub</vb>
Now you got yourself a new house teleport particle effect.
Then Find:
<vb>'House button
If Engine_Collision_Rect(MousePos.X, MousePos.Y, 1, 1, .Screen.X + .HouseLbl.X, .Screen.Y + .HouseLbl.Y, .HouseLbl.Width, .HouseLbl.Height) Then
HideShowWindow (MenuWindow)
Exit Function
End If</vb>
Again, the above is in my "Pretty Menu". So, change it to this:
<vb>'House button
If Engine_Collision_Rect(MousePos.X, MousePos.Y, 1, 1, .Screen.X + .HouseLbl.X, .Screen.Y + .HouseLbl.Y, .HouseLbl.Width, .HouseLbl.Height) Then
sndBuf.Put_Byte DataCode.TeleportToHouse
HideShowWindow (MenuWindow)
Exit Function
End If</vb>
Go to TCP.bas
Add this sub:
<vb></vb>
GameServer
go to frmMain.frm
<vb>Sub Data_Server_HouseTeleportEffect(ByRef rBuf As DataBuffer) '************************************************************ 'Create House Teleport Effect '************************************************************ Dim CharIndex As Integer Dim X As Single Dim Y As Single Dim TempIndex As Integer
CharIndex = rBuf.Get_Integer
If Not Engine_ValidChar(CharIndex) Then Exit Sub 'Create the effect X = Engine_TPtoSPX(CharList(CharIndex).Pos.X) + 16 Y = Engine_TPtoSPY(CharList(CharIndex).Pos.Y) TempIndex = Effect_HouseTeleport_Begin(X, Y, 9, 120, 90, 25) Effect(TempIndex).BindToChar = CharIndex Effect(TempIndex).BindSpeed = 25
End Sub</vb>
Find:
<vb>Case .User_HouseSell: Data_User_House_Sell Index</vb>
and below it add:
<vb>Case .TeleportToHouse: Data_User_TeleportToHouse Index</vb>
Go to TCP.bas and add this sub:
<vb>Sub Data_User_TeleportToHouse(ByVal UserIndex As Integer) '***************************************************************** 'Teleport User to their House '***************************************************************** Dim WarpMap As Integer Dim WarpX As Integer Dim WarpY As Integer
'Check that User Owns Property
DB_RS.Open "SELECT * FROM property WHERE `Owner`='" & UserList(UserIndex).Name & "'", DB_Conn, adOpenStatic, adLockOptimistic
If DB_RS.EOF Then
'MESSAGE USER THAT THEY MOST FIRST OWN PROPERTY TO TELEPORT TO IT
Data_Send ToIndex, UserIndex, cMessage(150).Data
DB_RS.Close
Exit Sub
Else
WarpMap = Val(DB_RS!MapNumber)
WarpX = Val(DB_RS!WarpX)
WarpY = Val(DB_RS!WarpY)
DB_RS.Close
'Teleport!
User_WarpChar UserIndex, WarpMap, WarpX, WarpY, False
'Create Teleport Effect
ConBuf.Put_Byte DataCode.TeleportToHouseEffect
ConBuf.Put_Integer UserList(UserIndex).Char.CharIndex
Data_Send ToMap, UserIndex, ConBuf.Get_Buffer, UserList(UserIndex).Pos.Map, PP_DisplaySpell
End If
End Sub</vb>
Database
Now open up the database
Open the Property table to add new columns: 1) New Column 1: - Field Name: WarpX - DataType: smallint - Len: 3 - Default: 1 - Comment: X coordinate of where user warps to when teleporting to house 1) New Column 2: - Field Name: WarpY - DataType: smallint - Len: 3 - Default: 1 - Comment: Y coordinate of where user warps to when teleporting to house
There you go, now you can teleport to your house/property!
Preview: http://www.vbgore.com/forums/download/file.php?id=264
This tutorial is made by: GoreMania