vbAccelerator - Contents of code file: cListBoxStorageIUnknown.cls

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "cListBoxStorageIUnknown"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

' ==========================================================
' Storing Objects against a controls ItemData or Tag
' property.
'
' This class shows how to store objects against a ListBox
' itemdata by storing an object pointer to the object.
' Since an object pointer does not keep a class "alive",
' normally as soon as the object went out of scope it
' would terminate.  Here, however, we use a type library
' implementation of IUnknown, allowing us to call the
' (normally restricted) AddRef and Release methods.
' By calling AddRef when we add the item, the object will
' not terminate until this class calls Release on it
' again.
'
'
' Copyright  1999 Steve McMahon
' steve@vbaccelerator.com
'
' Uses the ISHF_Ex.tlb from Brad Martinez excellent
' EnumDeskVB sample (version 2). Visit his site at:
' http://www.mvps.org/btmtz/
' An alternative Type Library to do the same thing
' is available along with Bruce McKinney's Hardcore
' Visual Basic (win.tlb and winu.tlb).  The IUnknown
' interface there is call IVBUnknown.
'
' ----------------------------------------------------------
' vbAccelerator - advanced, free source code:
' http://vbAccelerator.com/
' ==========================================================

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
    lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)

Private m_lstThis As ListBox
Private m_lID As Long

Public Sub Clear()
Dim lItem As Long
Dim lID As Long
Dim i As IShellFolderEx_TLB.IUnknown

   ' When clearing, we must ensure we call Release
   ' on any objects attached to the ListBox, otherwise
   ' these objects will not Terminate until the app
   ' does:
   For lItem = m_lstThis.ListCount - 1 To 0 Step -1
      lID = m_lstThis.ItemData(lItem)
      If Not (lID = 0) Then
         ' Call the object's IUnknown_Release method
         ' using the TLB
         Set i = ObjectFromPtr(lID)
         i.Release
         Set i = Nothing
      End If
   Next lItem
   m_lstThis.Clear
   
End Sub

Public Sub Initialise(lstThis As ListBox)
   Set m_lstThis = lstThis
End Sub

Private Property Get ObjectFromPtr(ByVal lPtr As Long) As cListBoxItem
Dim objT As cListBoxItem
   ' Bruce McKinney's code for getting an Object from the
   ' object pointer:
   CopyMemory objT, lPtr, 4
   Set ObjectFromPtr = objT
   CopyMemory objT, 0&, 4
End Property

Public Sub RemoveItem(ByVal lItemIndex As Long)
Dim lID As Long
Dim i As IShellFolderEx_TLB.IUnknown

   ' When removing an item, we must ensure we call Release
   ' on the object attached to the item, otherwise
   ' this object will not Terminate until the app
   ' does!
   lID = m_lstThis.ItemData(lItemIndex)
   If Not (lID = 0) Then
      ' Call the object's IUnknown_Release method
      ' using the TLB
      Set i = ObjectFromPtr(lID)
      i.Release
      Set i = Nothing
   End If
   m_lstThis.RemoveItem lItemIndex
   
End Sub

Public Property Let ItemData(ByVal lItemIndex As Long, ByRef cData As
 cListBoxItem)
Dim lID As Long
Dim i As IShellFolderEx_TLB.IUnknown

   lID = m_lstThis.ItemData(lItemIndex)
   If Not (lID = 0) Then
      ' free reference to previously held object:
      Set i = ObjectFromPtr(lID)
      i.Release
      Set i = Nothing
   End If
   ' Add a reference to the cData object so it
   ' won't be freed until the list item
   ' is removed:
   Set i = cData
   i.AddRef
   Set i = Nothing
   m_lstThis.ItemData(lItemIndex) = ObjPtr(cData)
   
End Property
Public Property Get ItemData(ByVal lItemIndex As Long) As cListBoxItem
Dim lID As Long

   lID = m_lstThis.ItemData(lItemIndex)
   If lID <> 0 Then
      Set ItemData = ObjectFromPtr(lID)
   End If
End Property

Private Sub Class_Terminate()
   Clear
End Sub