Jump to content
Search In
  • More options...
Find results that contain...
Find results in...

[EO] Shop Improvements

Matt

By Matt,
in Source

 Share

Recommended Posts

Matt Newbie

Matt

Posted
  • Author
Posted
This tutorial touches up on the shop system. It adds a multiple shop item cost system, makes it possible to have items that are for free, and adds a nice development feature for editing shops. I'll be adding just one extra one shop item cost, but adding more will be very easy to do after this tutorial.

Let's start out on the server!

Go to modConstants and look for "Public Const MAX_SHOPS As Long = 50"

Underneath it, put there "Public Const MAX_SHOP_ITEM_COSTS as Long = 2"

Go to modTypes, and look for "Private Type TradeItemRec"

You should see something like this

```

costitem As Long
costvalue As Long

```
Replace it with this.

```

costitem(1 To MAX_SHOP_ITEM_COSTS) As Long
costvalue(1 To MAX_SHOP_ITEM_COSTS) As Long

```
Now go to the sub "Sub HandleBuyItem"

Replace "Dim itemamount As Long" with "Dim itemamount(1 to MAX_SHOP_ITEM_COSTS) As Long"

and add "Dim i as long" underneath it.

Replace

```

' check has the cost item
itemamount = HasItem(index, .costitem)
If itemamount = 0 Or itemamount < .costvalue Then
PlayerMsg index, "You do not have enough to buy this item.", BrightRed
ResetShopAction index
Exit Sub
End If

```
with

```

' check has the cost item
For i = 1 To MAX_SHOP_ITEM_COSTS
' Check if the cost item is bigger than 0
If .costitem(i) > 0 Then
itemamount(i) = HasItem(index, .costitem(i))
If itemamount(i) = 0 Or itemamount(i) < .costvalue(i) Then
PlayerMsg index, "You do not have enough to buy this item.", BrightRed
ResetShopAction index
Exit Sub
End If
End If
Next

```
and replace

```

TakeInvItem index, .costitem, .costvalue
GiveInvItem index, .Item, .ItemValue

```
with

```

' Take all the items!
For i = 1 To MAX_SHOP_ITEM_COSTS
' Check if the cost item is bigger than 0
If .costitem(i) > 0 Then
TakeInvItem index, .costitem(i), .costvalue(i)
End If
Next

' Give the item
GiveInvItem index, .Item, .ItemValue

```
On to the client!

Go to modConstants and look for "Public Const MAX_SHOPS As Long = 50"

Underneath it, put there "Public Const MAX_SHOP_ITEM_COSTS as Long = 2"

Go to modTypes, and look for "Private Type TradeItemRec"

You should see something like this

```

CostItem As Long
CostValue As Long
```
Replace it with this.

```

CostItem(1 To MAX_SHOP_ITEM_COSTS) As Long
CostValue(1 To MAX_SHOP_ITEM_COSTS) As Long
```
Now go to frmEditor_Shop and copy these form objects

![](http://i.imgur.com/5UKQrn2.png)

and paste them right underneath the originals. When it asks if you want to add a control array, hit yes.

Now go to "ShopEditorInit" and add "Dim x As Long" just underneath "Dim i As Long"

replace

```

frmEditor_Shop.cmbCostItem.Clear
frmEditor_Shop.cmbCostItem.AddItem "None"

```
with

```

For x = 0 To MAX_SHOP_ITEM_COSTS - 1
frmEditor_Shop.cmbCostItem(x).Clear
frmEditor_Shop.cmbCostItem(x).AddItem "None"
Next

```
replace

```

For i = 1 To MAX_ITEMS
frmEditor_Shop.cmbItem.AddItem i & ": " & Trim$(Item(i).Name)
frmEditor_Shop.cmbCostItem.AddItem i & ": " & Trim$(Item(i).Name)
Next

```
with

```

For i = 1 To MAX_ITEMS
frmEditor_Shop.cmbItem.AddItem i & ": " & Trim$(Item(i).Name)
For x = 0 To MAX_SHOP_ITEM_COSTS - 1
frmEditor_Shop.cmbCostItem(x).AddItem i & ": " & Trim$(Item(i).Name)
Next
Next

```
and replace

```

frmEditor_Shop.cmbItem.ListIndex = 0
frmEditor_Shop.cmbCostItem.ListIndex = 0

```
with

```

frmEditor_Shop.cmbItem.ListIndex = 0
For x = 0 To MAX_SHOP_ITEM_COSTS - 1
frmEditor_Shop.cmbCostItem(x).ListIndex = 0
Next

```
Now go to "cmdUpdate_Click" and under "Dim Index As Long" put there "Dim i As Long"

replace

```

With Shop(EditorIndex).TradeItem(Index)
.Item = cmbItem.ListIndex
.ItemValue = Val(txtItemValue.text)
.CostItem = cmbCostItem.ListIndex
.CostValue = Val(txtCostValue.text)
End With

```
with

```

With Shop(EditorIndex).TradeItem(Index)
.Item = cmbItem.ListIndex
.ItemValue = Val(txtItemValue.text)
For i = 1 To MAX_SHOP_ITEM_COSTS
.CostItem(i) = cmbCostItem(i - 1).ListIndex
.CostValue(i) = Val(txtCostValue(i - 1).text)
Next
End With

```
go to "cmdDeleteTrade_Click" and under "Dim Index As Long" put there "Dim i As Long"

replace

```

With Shop(EditorIndex).TradeItem(Index)
.Item = 0
.ItemValue = 0
.CostItem = 0
.CostValue = 0
End With

```
with

```

    With Shop(EditorIndex).TradeItem(Index)
        .Item = 0
        .ItemValue = 0
        For i = 1 To MAX_SHOP_ITEM_COSTS
            .CostItem(i) = 0
            .CostValue(i) = 0
        Next
    End With

```
now go to "UpdateShopTrade" and under "Dim i As Long" put there "Dim x As Long", "Dim Text As String", and "Dim CostText As String"

replace

```

For i = 1 To MAX_TRADES
With Shop(EditorIndex).TradeItem(i)
' if none, show as none
If .Item = 0 And .CostItem = 0 Then
frmEditor_Shop.lstTradeItem.AddItem "Empty Trade Slot"
Else
frmEditor_Shop.lstTradeItem.AddItem i & ": " & .ItemValue & "x " & Trim$(Item(.Item).Name) & " for " & .CostValue & "x " & Trim$(Item(.CostItem).Name)
End If
End With
Next

```
with

```

For i = 1 To MAX_TRADES
CostText = vbNullString
With Shop(EditorIndex).TradeItem(i)
' if none, show as none
If .Item = 0 Then
Text = "Empty Trade Slot"
Else
Text = i & ": " & .ItemValue & "x " & Trim$(Item(.Item).Name) & " for "
For x = 1 To MAX_SHOP_ITEM_COSTS
If .CostItem(x) > 0 Then
CostText = CostText & .CostValue(x) & "x " & Trim$(Item(.CostItem(x)).Name)
End If
Next
if CostText = vbNullString Then CostText = " free"
End If
End With
frmEditor_Shop.lstTradeItem.AddItem Text & CostText
Next

```
now go to "picShopItems_MouseDown" and under "Dim shopItem As Long" put there "Dim i As Long" and "Dim CostText As String"

replace

```

Case 0 ' no action, give cost
With Shop(InShop).TradeItem(shopItem)
AddText "You can buy this item for " & .CostValue & " " & Trim$(Item(.CostItem).Name) & ".", White
End With

```
with

```

            Case 0 ' no action, give cost
                With Shop(InShop).TradeItem(shopItem)
                    For i = 1 To MAX_SHOP_ITEM_COSTS
                        If .CostItem(i) > 0 Then
                            CostText = CostText & " " & .CostValue(i) & " " & Trim$(Item(.CostItem(i)).Name)
                        End If
                    Next
                    If CostText = vbNullString Then CostText = " free"
                    CostText = CostText & "."
                    AddText "You can buy this item for" & CostText, White
                End With

```
And lastly, we're going to be adding in a handy tool for editing shops. On frmEditor_Shop, double click on lstTradeItem and paste this code there.

```

Private Sub lstTradeItem_Click()
Dim i As Long

With Me
.cmbItem.ListIndex = Shop(EditorIndex).TradeItem(lstTradeItem.ListIndex + 1).Item
.txtItemValue.Text = Shop(EditorIndex).TradeItem(lstTradeItem.ListIndex + 1).ItemValue
For i = 1 To MAX_SHOP_ITEM_COSTS
.cmbCostItem(i - 1).ListIndex = Shop(EditorIndex).TradeItem(lstTradeItem.ListIndex + 1).CostItem(i)
.txtCostValue(i - 1).Text = Shop(EditorIndex).TradeItem(lstTradeItem.ListIndex + 1).CostValue(i)
Next
End With
End Sub

```
Compile your server and client, and enjoy!
Link to comment
Share on other sites
Ganjika Newbie

Ganjika

Posted
Posted
Could it be modGameEditors?

I also keep getting a subscript out of range error when trying to sign in after launch with a highlighted (in modhandledata)

```

CopyMemory ByVal VarPtr(Shop(shopnum)), ByVal VarPtr(ShopData(0)), ShopSize

```

modGameEditors

```

Public Sub UpdateShopTrade(Optional ByVal tmpPos As Long = 0)

Dim i As Long

' If debug mode, handle error then exit out

If Options.Debug = 1 Then On Error GoTo errorhandler

frmEditor_Shop.lstTradeItem.Clear

For i = 1 To MAX_TRADES

With Shop(EditorIndex).TradeItem(i)

' if none, show as none

If .Item = 0 And .CostItem = 0 Then

frmEditor_Shop.lstTradeItem.AddItem "Empty Trade Slot"

Else

frmEditor_Shop.lstTradeItem.AddItem i & ": " & .ItemValue & "x " & Trim$(Item(.Item).Name) & " for " & .CostValue & "x " & Trim$(Item(.CostItem).Name) & " and " & .CostValue2 & "x " & Trim$(Item(.CostItem2).Name)

End If

End With

Next

frmEditor_Shop.lstTradeItem.ListIndex = tmpPos

' Error handler

Exit Sub

errorhandler:

HandleError "UpdateShopTrade", "modGameEditors", Err.Number, Err.Description, Err.Source, Err.HelpContext

Err.Clear

Exit Sub

End Sub

```

CopyMemory ByVal VarPtr(Shop(shopnum)), ByVal VarPtr(ShopData(0)), ShopSize
Link to comment
Share on other sites
  • 4 weeks later...
Matt Newbie

Matt

Posted
  • Author
Posted
When I wasn't so experienced in VB6, I used your tutorial and it didn't work for me. I saw other people complain about it not working as well and that's why I mentioned it.

> Hey this is the tutorial that I made some months ago.

I assure you I did not copy your code, only the goal.
Link to comment
Share on other sites
  • 2 weeks later...
Matt Newbie

Matt

Posted
  • Author
Posted
> Method or data member not found. I'm sure that i added everything, and re-added, what could be the problem? using ER
>
> Highlights this PublicSubShopEditorInit()

Hi! Sorry I didn't respond so quickly. I've been focusing more on my studies. What bit in that sub does it highlight?
Link to comment
Share on other sites
  • 2 weeks later...
Matt Newbie

Matt

Posted
  • Author
Posted
> Aha, nice. I was going to make something similar to this to emulate "Crafting" ![:)](http://www.touchofdeathforums.com/community/public/style_emoticons/<#EMO_DIR#>/smile.png) Now I can be lazy <3 You're the best

No problem! Tell me if you run into any problems. Keep in mind that this edit assumes there are always two costs!
Link to comment
Share on other sites
DeathKnight Newbie

DeathKnight

Posted
Posted
Just looking over this code I caught one small thing this line

```

If itemamount = 0 Or itemamount < .costvalue Or itemamount2 = 0 Or itemamount < .CostValue2 Then

```

should be this```

If itemamount = 0 Or itemamount < .costvalue Or itemamount2 = 0 Or itemamount2 < .CostValue2 Then

```

otherwise it's compairing item amount 1 to item cost 2
Link to comment
Share on other sites
Matt Newbie

Matt

Posted
  • Author
Posted
> You didn't answer my question yet…
>
> What is Wrong here? I can't find any other Highlighted just this !

What is the error its bringing up?

> Just looking over this code I caught one small thing this line
>
> ```
>
> If itemamount = 0 Or itemamount < .costvalue Or itemamount2 = 0 Or itemamount < .CostValue2 Then
>
> ```
>
> should be this```
>
> If itemamount = 0 Or itemamount < .costvalue Or itemamount2 = 0 Or itemamount2 < .CostValue2 Then
>
> ```
>
> otherwise it's compairing item amount 1 to item cost 2

Ah! A mistake on my part. Thank you for pointing it out! I fixed the tutorial.
Link to comment
Share on other sites
  • 2 weeks later...

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now
 Share
Go to topic listing
×
×
  • Create New...