home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 3_2004-2005.ISO / Data / Zips / API-ucTree1887955132005.psc / mIOIPAOTreeView.bas < prev    next >
Encoding:
BASIC Source File  |  2004-10-22  |  7.1 KB  |  173 lines
  1. Attribute VB_Name = "mIOIPAOTreeView"
  2. '========================================================================================
  3. ' Filename:    mIOleInPlaceActivate.bas
  4. ' Author:      Mike Gainer, Matt Curland and Bill Storage
  5. ' Date:        09 January 1999
  6. '
  7. ' Requires:    OleGuids.tlb (in IDE only)
  8. '
  9. ' Description:
  10. ' Allows you to replace the standard IOLEInPlaceActiveObject interface for a
  11. ' UserControl with a customisable one.  This allows you to take control
  12. ' of focus in VB controls.
  13. '
  14. ' The code could be adapted to replace other UserControl OLE interfaces.
  15. '
  16. ' ---------------------------------------------------------------------------------------
  17. ' Visit vbAccelerator, advanced, free source for VB programmers
  18. ' http://vbaccelerator.com
  19. '========================================================================================
  20.  
  21. Option Explicit
  22.  
  23. '========================================================================================
  24. ' Lightweight object definition
  25. '========================================================================================
  26.  
  27. Public Type IPAOHookStructTreeView
  28.     lpVTable    As Long                    'VTable pointer
  29.     IPAOReal    As IOleInPlaceActiveObject 'Un-AddRefed pointer for forwarding calls
  30.     Ctl         As ucTreeView              'Un-AddRefed native class pointer for making Friend calls
  31.     ThisPointer As Long
  32. End Type
  33.  
  34. '========================================================================================
  35. ' API
  36. '========================================================================================
  37.  
  38. Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
  39. Private Declare Function IsEqualGUID Lib "ole32" (iid1 As GUID, iid2 As GUID) As Long
  40.  
  41. Private Type GUID
  42.     Data1           As Long
  43.     Data2           As Integer
  44.     Data3           As Integer
  45.     Data4(0 To 7)   As Byte
  46. End Type
  47.  
  48. '========================================================================================
  49. ' Constants and member variables
  50. '========================================================================================
  51.  
  52. Private Const S_FALSE               As Long = 1
  53. Private Const S_OK                  As Long = 0
  54.  
  55. Private IID_IOleInPlaceActiveObject As GUID
  56. Private m_IPAOVTable(9)             As Long
  57.  
  58. '========================================================================================
  59. ' Functions
  60. '========================================================================================
  61.  
  62. Public Sub InitIPAO(IPAOHookStruct As IPAOHookStructTreeView, Ctl As ucTreeView)
  63.     
  64.   Dim IPAO As IOleInPlaceActiveObject
  65.     
  66.     With IPAOHookStruct
  67.         Set IPAO = Ctl
  68.         Call CopyMemory(.IPAOReal, IPAO, 4)
  69.         Call CopyMemory(.Ctl, Ctl, 4)
  70.         .lpVTable = GetVTable
  71.         .ThisPointer = VarPtr(IPAOHookStruct)
  72.     End With
  73. End Sub
  74.  
  75. Public Sub TerminateIPAO(IPAOHookStruct As IPAOHookStructTreeView)
  76.     With IPAOHookStruct
  77.         Call CopyMemory(.IPAOReal, 0&, 4)
  78.         Call CopyMemory(.Ctl, 0&, 4)
  79.     End With
  80. End Sub
  81.  
  82. '========================================================================================
  83. ' Private
  84. '========================================================================================
  85.  
  86. Private Function GetVTable() As Long
  87.  
  88.     ' Set up the vTable for the interface and return a pointer to it
  89.     If (m_IPAOVTable(0) = 0) Then
  90.         m_IPAOVTable(0) = AddressOfFunction(AddressOf QueryInterface)
  91.         m_IPAOVTable(1) = AddressOfFunction(AddressOf AddRef)
  92.         m_IPAOVTable(2) = AddressOfFunction(AddressOf Release)
  93.         m_IPAOVTable(3) = AddressOfFunction(AddressOf GetWindow)
  94.         m_IPAOVTable(4) = AddressOfFunction(AddressOf ContextSensitiveHelp)
  95.         m_IPAOVTable(5) = AddressOfFunction(AddressOf TranslateAccelerator)
  96.         m_IPAOVTable(6) = AddressOfFunction(AddressOf OnFrameWindowActivate)
  97.         m_IPAOVTable(7) = AddressOfFunction(AddressOf OnDocWindowActivate)
  98.         m_IPAOVTable(8) = AddressOfFunction(AddressOf ResizeBorder)
  99.         m_IPAOVTable(9) = AddressOfFunction(AddressOf EnableModeless)
  100.         '--- init guid
  101.         With IID_IOleInPlaceActiveObject
  102.             .Data1 = &H117&
  103.             .Data4(0) = &HC0
  104.             .Data4(7) = &H46
  105.         End With
  106.     End If
  107.     GetVTable = VarPtr(m_IPAOVTable(0))
  108. End Function
  109.  
  110. Private Function AddressOfFunction(lpfn As Long) As Long
  111.     ' Work around, VB thinks lPtr = AddressOf Method is an error
  112.     AddressOfFunction = lpfn
  113. End Function
  114.  
  115. '========================================================================================
  116. ' Interface implemenattion
  117. '========================================================================================
  118.  
  119. Private Function AddRef(This As IPAOHookStructTreeView) As Long
  120.     AddRef = This.IPAOReal.AddRef
  121. End Function
  122.  
  123. Private Function Release(This As IPAOHookStructTreeView) As Long
  124.     Release = This.IPAOReal.Release
  125. End Function
  126.  
  127. Private Function QueryInterface(This As IPAOHookStructTreeView, riid As GUID, pvObj As Long) As Long
  128.     ' Install the interface if required
  129.     If (IsEqualGUID(riid, IID_IOleInPlaceActiveObject)) Then
  130.         ' Install alternative IOleInPlaceActiveObject interface implemented here
  131.         pvObj = This.ThisPointer
  132.         AddRef This
  133.         QueryInterface = 0
  134.       Else
  135.         ' Use the default support for the interface:
  136.         QueryInterface = This.IPAOReal.QueryInterface(ByVal VarPtr(riid), pvObj)
  137.     End If
  138. End Function
  139.  
  140. Private Function GetWindow(This As IPAOHookStructTreeView, phwnd As Long) As Long
  141.     GetWindow = This.IPAOReal.GetWindow(phwnd)
  142. End Function
  143.  
  144. Private Function ContextSensitiveHelp(This As IPAOHookStructTreeView, ByVal fEnterMode As Long) As Long
  145.     ContextSensitiveHelp = This.IPAOReal.ContextSensitiveHelp(fEnterMode)
  146. End Function
  147.  
  148. Private Function TranslateAccelerator(This As IPAOHookStructTreeView, lpMsg As MSG) As Long
  149.     ' Check if we want to override the handling of this key code:
  150.     If (This.Ctl.frTranslateAccel(lpMsg)) Then
  151.         TranslateAccelerator = S_OK
  152.       Else
  153.         ' If not pass it on to the standard UserControl TranslateAccelerator method:
  154.         TranslateAccelerator = This.IPAOReal.TranslateAccelerator(ByVal VarPtr(lpMsg))
  155.     End If
  156. End Function
  157.  
  158. Private Function OnFrameWindowActivate(This As IPAOHookStructTreeView, ByVal fActivate As Long) As Long
  159.     OnFrameWindowActivate = This.IPAOReal.OnFrameWindowActivate(fActivate)
  160. End Function
  161.  
  162. Private Function OnDocWindowActivate(This As IPAOHookStructTreeView, ByVal fActivate As Long) As Long
  163.     OnDocWindowActivate = This.IPAOReal.OnDocWindowActivate(fActivate)
  164. End Function
  165.  
  166. Private Function ResizeBorder(This As IPAOHookStructTreeView, prcBorder As RECT, ByVal puiWindow As IOleInPlaceUIWindow, ByVal fFrameWindow As Long) As Long
  167.     ResizeBorder = This.IPAOReal.ResizeBorder(VarPtr(prcBorder), puiWindow, fFrameWindow)
  168. End Function
  169.  
  170. Private Function EnableModeless(This As IPAOHookStructTreeView, ByVal fEnable As Long) As Long
  171.     EnableModeless = This.IPAOReal.EnableModeless(fEnable)
  172. End Function
  173.