This Visual Inventory uses BltToDc to draw your inventory instead of picture boxes.
All Client Side
frmMirageAdd a Picture Box
Name it picVisInv
Set AutoRedraw to True
modConstantsAdd the following:
Code:
' Visual Inventory
Public Const InvX As Byte = 30
Public Const InvY As Byte = 11
Public Const InvOffsetX As Byte = 17
Public Const InvOffsetY As Byte = 16
InvX and InvY are where the first item will be drawn within the picVisInv
InvOffsetX and InvOffsetY are the offsets in between the items
modDirectDraw7Add the following sub:
Code:
Public Sub BltInventory()
Dim i As Long
Dim rec As DxVBLib.RECT
Dim rec_pos As DxVBLib.RECT
If frmMirage.picVisInv.Visible Then
frmMirage.picVisInv.Cls
For i = 1 To MAX_INV
If GetPlayerInvItemNum(MyIndex, i) > 0 And GetPlayerInvItemNum(MyIndex, i) <= MAX_ITEMS Then
With rec
.top = Item(GetPlayerInvItemNum(MyIndex, i)).Pic * PIC_Y
.Bottom = .top + PIC_Y
.Left = 0
.Right = .Left + PIC_X
End With
With rec_pos
.top = InvY + ((InvOffsetY + 32) * ((i - 1) \ 4))
.Bottom = .top + PIC_Y
.Left = InvX + ((InvOffsetX + 32) * (((i - 1) Mod 4)))
.Right = .Left + PIC_X
End With
Call DD_ItemSurf.BltToDC(frmMirage.picVisInv.hdc, rec, rec_pos)
End If
Next i
frmMirage.picVisInv.Refresh
End If
End Sub
I would have used Engine_BltToDc but since it clears on every call it would clear out every item except the last one being draw.
in Sub UpdateInventory
add the following:
Code:
Call BltInventory
For Interaction:
frmMirageAdd another picture box and name it picItemDesc
Add a label in the picItemDesc and name it lblItemName
Make picItemDesc visible = false
still in frmMirage
Under "Option Explicit" add:
Code:
Private InvPosX As Single
Private InvPosY As Single
Add the following Subs + Function:
Code:
Private Sub picVisInv_DblClick()
Dim InvNum As Long
InvNum = IsItem(InvPosX, InvPosY)
If InvNum <> 0 Then
If GetPlayerInvItemNum(MyIndex, InvNum) = ITEM_TYPE_NONE Then Exit Sub
Call SendUseItem(InvNum)
Exit Sub
End If
End Sub
Code:
Private Sub picVisInv_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim InvNum As Long
If Button = 2 Then
InvNum = IsItem(X, Y)
If InvNum <> 0 Then
If Item(GetPlayerInvItemNum(MyIndex, InvNum)).Type = ITEM_TYPE_CURRENCY Then
frmDrop.Show vbModal
Else
Call SendDropItem(InvNum, 0)
End If
End If
End If
End Sub
Code:
Private Sub picVisInv_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim InvNum As Long
Dim ItemNum As Long
InvPosX = X
InvPosY = Y
InvNum = IsItem(X, Y)
If InvNum <> 0 Then
ItemNum = GetPlayerInvItemNum(MyIndex, InvNum)
lblItemName.Caption = Trim$(Item(ItemNum).Name)
picItemDesc.Top = (Y + (picItemDesc.Height * 0.5)) + picVisInv.Top + 5
picItemDesc.Left = (X - picItemDesc.Width) + picVisInv.Left
picItemDesc.Visible = True
Exit Sub
End If
picItemDesc.Visible = False
End Sub
Code:
Private Function IsItem(ByVal X As Single, ByVal Y As Single) As Long
Dim tempRec As RECT
Dim i As Long
For i = 1 To MAX_INV
If GetPlayerInvItemNum(MyIndex, i) > 0 And GetPlayerInvItemNum(MyIndex, i) <= MAX_ITEMS Then
With tempRec
.Top = InvY + ((InvOffsetY + 32) * ((i - 1) \ 4))
.Bottom = .Top + PIC_Y
.Left = InvX + ((InvOffsetX + 32) * (((i - 1) Mod 4)))
.Right = .Left + PIC_X
End With
If X >= tempRec.Left And X <= tempRec.Right Then
If Y >= tempRec.Top And Y <= tempRec.Bottom Then
IsItem = i
Exit Function
End If
End If
End If
Next i
IsItem = 0
End Function
If something doesn't work please let me know.