Kinjiru Posted July 27, 2011 Author Share Posted July 27, 2011 Ok so I followed this tutorial here http://www.touchofdeathforums.com/smf/index.php/topic,67261.0.htmlAnd things went well for the first few menus i tryed, but when I moved on to the spells and inventory I get a compile error because the procedures already exist. Link to comment Share on other sites More sharing options...
Kinjiru Posted July 28, 2011 Author Share Posted July 28, 2011 I did some digging on the forum and found this quote@Robin:> It'll only drag the items/skills if your mouse is hovering over one. If the 'IsInvItem' check is returned negative, simply call the drag system instead.So i need to insert the drag codes in the following Subs where the IsInvItem is returned negative, but im not sure where that is```Private Sub picInventory_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) Dim InvNum As Long ' If debug mode, handle error then exit out If Options.Debug = 1 Then On Error GoTo errorhandler InvNum = IsInvItem(X, Y) If Button = 1 Then If InvNum <> 0 Then If InTrade > 0 Then Exit Sub If InBank Or InShop Then Exit Sub DragInvSlotNum = InvNum End If ElseIf Button = 2 Then If Not InBank And Not InShop And Not InTrade > 0 Then If InvNum <> 0 Then If Item(GetPlayerInvItemNum(MyIndex, InvNum)).Type = ITEM_TYPE_CURRENCY Then If GetPlayerInvItemValue(MyIndex, InvNum) > 0 Then CurrencyMenu = 1 ' drop lblCurrency.Caption = "How many do you want to drop?" tmpCurrencyItem = InvNum txtCurrency.text = vbNullString picCurrency.Visible = True txtCurrency.SetFocus End If Else Call SendDropItem(InvNum, 0) End If End If End If End If SetFocusOnChat ' Error handler Exit Suberrorhandler: HandleError "picInventory_MouseDown", "frmMain", Err.Number, Err.Description, Err.Source, Err.HelpContext Err.Clear Exit SubEnd Sub``````Private Sub picInventory_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) Dim InvNum As Long Dim i As Long ' If debug mode, handle error then exit out If Options.Debug = 1 Then On Error GoTo errorhandler InvX = X InvY = Y If DragInvSlotNum > 0 Then If InTrade > 0 Then Exit Sub If InBank Or InShop Then Exit Sub Call BltInventoryItem(X + picInventory.Left, Y + picInventory.top) Else InvNum = IsInvItem(X, Y) If InvNum <> 0 Then ' exit out if we're offering that item If InTrade Then For i = 1 To MAX_INV If TradeYourOffer(i).num = InvNum Then ' is currency? If Item(GetPlayerInvItemNum(MyIndex, TradeYourOffer(i).num)).Type = ITEM_TYPE_CURRENCY Then ' only exit out if we're offering all of it If TradeYourOffer(i).Value = GetPlayerInvItemValue(MyIndex, TradeYourOffer(i).num) Then Exit Sub End If Else Exit Sub End If End If Next End If X = X + picInventory.Left - picItemDesc.width - 1 Y = Y + picInventory.top - picItemDesc.height - 1 UpdateDescWindow GetPlayerInvItemNum(MyIndex, InvNum), X, Y LastItemDesc = GetPlayerInvItemNum(MyIndex, InvNum) ' set it so you don't re-set values Exit Sub End If End If picItemDesc.Visible = False LastItemDesc = 0 ' no item was last loaded ' Error handler Exit Suberrorhandler: HandleError "picInventory_MouseMove", "frmMain", Err.Number, Err.Description, Err.Source, Err.HelpContext Err.Clear Exit SubEnd Sub``` Link to comment Share on other sites More sharing options...
Robin Posted July 29, 2011 Share Posted July 29, 2011 ```If InvNum <> 0 Then```>_> Link to comment Share on other sites More sharing options...
Kinjiru Posted July 29, 2011 Author Share Posted July 29, 2011 Ok so I got the code added in but its not working, the inventory is still not moving```Private Sub picInventory_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single) Dim InvNum As Long ' If debug mode, handle error then exit out If Options.Debug = 1 Then On Error GoTo errorhandler InvNum = IsInvItem(x, y) If Button = 1 Then If InvNum <> 0 Then XM2 = x XM2 = y If InTrade > 0 Then Exit Sub If InBank Or InShop Then Exit Sub DragInvSlotNum = InvNum End If ElseIf Button = 2 Then If Not InBank And Not InShop And Not InTrade > 0 Then If InvNum <> 0 Then If Item(GetPlayerInvItemNum(MyIndex, InvNum)).Type = ITEM_TYPE_CURRENCY Then If GetPlayerInvItemValue(MyIndex, InvNum) > 0 Then CurrencyMenu = 1 ' drop lblCurrency.Caption = "How many do you want to drop?" tmpCurrencyItem = InvNum txtCurrency.text = vbNullString picCurrency.Visible = True txtCurrency.SetFocus End If Else Call SendDropItem(InvNum, 0) End If End If End If End If SetFocusOnChat ' Error handler Exit Suberrorhandler: HandleError "picInventory_MouseDown", "frmMain", Err.Number, Err.Description, Err.Source, Err.HelpContext Err.Clear Exit SubEnd Sub``````Private Sub picInventory_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single) Dim InvNum As Long Dim i As Long ' If debug mode, handle error then exit out If Options.Debug = 1 Then On Error GoTo errorhandler InvX = x InvY = y If DragInvSlotNum > 0 Then If InTrade > 0 Then Exit Sub If InBank Or InShop Then Exit Sub Call BltInventoryItem(x + picInventory.Left, y + picInventory.top) Else InvNum = IsInvItem(x, y) If InvNum <> 0 Then If Button = 1 Then picInventory.Left = picInventory.Left + x - XM2 picInventory.top = picInventory.top + y - YM2 End If 'exit out if we're offering that item If InTrade Then For i = 1 To MAX_INV If TradeYourOffer(i).num = InvNum Then 'is currency? If Item(GetPlayerInvItemNum(MyIndex, TradeYourOffer(i).num)).Type = ITEM_TYPE_CURRENCY Then ' only exit out if we're offering all of it If TradeYourOffer(i).Value = GetPlayerInvItemValue(MyIndex, TradeYourOffer(i).num) Then Exit Sub End If Else Exit Sub End If End If Next End If x = x + picInventory.Left - picItemDesc.width - 1 y = y + picInventory.top - picItemDesc.height - 1 UpdateDescWindow GetPlayerInvItemNum(MyIndex, InvNum), x, y LastItemDesc = GetPlayerInvItemNum(MyIndex, InvNum) ' set it so you don't re-set values Exit Sub End If End If 'End If picItemDesc.Visible = False LastItemDesc = 0 ' no item was last loaded ' Error handler Exit Suberrorhandler: HandleError "picInventory_MouseMove", "frmMain", Err.Number, Err.Description, Err.Source, Err.HelpContext Err.Clear Exit SubEnd Sub``` Link to comment Share on other sites More sharing options...
Recommended Posts
Create an account or sign in to comment
You need to be a member in order to leave a comment
Create an account
Sign up for a new account in our community. It's easy!
Register a new accountSign in
Already have an account? Sign in here.
Sign In Now