home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 6_2008-2009.ISO / data / zips / FYI__UserC21374812182008.psc / cCustomPropertyDisplay.cls < prev   
Text File  |  2008-12-18  |  76KB  |  1,078 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4.   Persistable = 0  'NotPersistable
  5.   DataBindingBehavior = 0  'vbNone
  6.   DataSourceBehavior  = 0  'vbNone
  7.   MTSTransactionMode  = 0  'NotAnMTSObject
  8. END
  9. Attribute VB_Name = "cCustomPropertyDisplay"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = True
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = False
  14. Option Explicit
  15.  
  16. ' Please take about 2 minutes and read the comments below. It will help you understand
  17. ' what this class does and cannot do, the basics of how it works. The interface
  18. ' manipulation is pretty advanced stuff, so I have added a ton of remarks in almost
  19. ' every function/sub within this class, and also the IPropertyBrowserEvents class.
  20.  
  21.  
  22.  
  23. ' This class uses some VTable hacks to achieve its purpose. Also, since this class' only
  24. ' purpose is to "pretty up" the property sheet during design time, it should not be
  25. ' invoked during runtime.  The Attach function has a parameter that you pass to tell the
  26. ' class whether or not the usercontrol's parent is in design time or runtime.
  27.  
  28. ' ========== WARNINGS  WARNINGS  WARNINGS  WARNINGS  WARNINGS  WARNINGS ============
  29. ' You should NOT walk through this class or its events within your usercontrol. The class
  30. ' basically subclasses an interface class called IPerPropertyBrowsing. This requires
  31. ' subclassing that interface during design time and, with any subclassing, it is not
  32. ' safe to step thru the code while subclassing is in play. You can step thru and debug
  33. ' the rest of your project without any problems.
  34.  
  35. ' If this class is running in a usercontrol that is not compiled and you make changes to
  36. ' that usercontrol while it is also displayed on a form, you may crash. This is because
  37. ' the Terminate events are not fired when VB destroys this class and/or usercontrol. The
  38. ' Terminate events allow unsubclassing to occur. I have coded around this problem the best
  39. ' I can, but potential of crash still exists. Therefore, there is a protection property
  40. ' that you must set to true to allow this to run on uncompiled usercontrols.
  41. ' That property is IgnoreIDESafety.
  42.  
  43. ' You have been warned. This class should be completely safe in compiled OCXs.
  44. ' ===============================================================================
  45.  
  46. ' ----------- KNOWN ISSUES  KNOWN ISSUES  KNOWN ISSUES  KNOWN ISSUES ------------
  47. ' 1. With VB, when multiple controls are selected, the property sheet will show
  48. '    most, if not all, of the usercontrol's properties. This allows the user to
  49. '    change a property and it affects all controls selected.  This behavior
  50. '    is not performed when a property is implemented via the IPerPropertyBrowser.
  51. '    All properties that are not implemented are shown as expected
  52. '
  53. ' 2. With VB, when a dropdown list is provided containing a list to select from
  54. '    and user double clicks the property name, VB will automatically select the
  55. '    next item in the list in a circular fashion. Using this class can fail to
  56. '    allow that behavior unless the following is enforced by you. Whenever, you
  57. '    implemenet a property within this class... You provide the class with the
  58. '    dropdown listing, and when prompted to set the display text for the property,
  59. '    you MUST use the exact same text in the dropdown listing you provided for
  60. '    the item that was selected.  Only if it matches exactly does this behavior
  61. '    continue as expected.
  62. '
  63. ' 3. When wanting to display a dialog box, custom modal form, etc, for a property,
  64. '    some minor issues are noted: a) You may get a quick "flash" of a subclassed
  65. '    property page closing after your dialog box is closed b) Cannot override
  66. '    properties that are set as stdPicture, stdFont or OLE_COLOR. VB will display
  67. '    what it wants to for these, no matter what we tell it. If you absolutely want
  68. '    your own dialog, declare such properties as Variant or Long.
  69. '
  70. ' 4. There is a noticable delay when clicking on an uncompiled usercontrol and
  71. '    when the property sheet is updated with that control's properties. There is
  72. '    no delay when the usercontrol is compiled to an ocx.
  73. ' ------------------------------------------------------------------------------
  74.  
  75. ' This class can add a bit more professionalism to finished usercontrols.
  76. ' With the class, you can completely control what text is displayed in the property sheet
  77. ' for properties that get their values from dropdown lists (i.e., enumerations)
  78. ' Though one could supply unicode text, the property sheet in VB does not support unicode.
  79. ' You can also make your properties expose ellipse (...) buttons so you can display
  80. ' your own dialog or modal form intead of a property sheet.
  81.  
  82. ' Here are some generalized examples. More exist in IPropertyBrowserEvents class.
  83.  
  84. ' The text displayed in a dropdown box containing an enumeration
  85. '   Example: Your Enum is 0 - vbLeftJustify, 1 - vbRightJustify, 2 - vbCenter
  86. '       You could display this instead: 0 - Left Aligned, 1 - Right Aligned, 2 - Centered
  87. '       Or possibly this:  0 - Left, 1 - Right, 2 - Center
  88. ' On the fly, dynamic, "enumerations".
  89. ' For example, you can provide a list of available drives or a list of controls on the parent
  90. ' Without similar implementations, this was only possible with the use of property pages
  91. ' See the IPropertyBrowserEvents class for coded examples
  92.  
  93. ' So how do you use this class?
  94. ' 1. Declare in your usercontrol's (UC) declarations section:
  95. '       Dim WithEvents myCustomProps As cCustomPropertyDisplay
  96. ' 2. Add this to your declarations section
  97. '       Implements IPropertyBrowserEvents
  98. ' 3. Add this somewhere in your UC
  99. '        Private Sub ImplementProperties()
  100. '            Set myCustomProps = New cCustomPropertyDisplay
  101. '            If myCustomProps.Attach(Me, Ambient.UserMode) Then
  102. '                ' for each custom property, add it to the class collection
  103. '                myCustomProps.AddProperty Me, "Drives"
  104. '                myCustomProps.AddProperty Me, "Alignment"
  105. '            Else
  106. '                Set myCustomProps = Nothing
  107. '            End If
  108. '        End Sub
  109. ' 4. In your UC's InitProperties event, add this line of code
  110. '       Call ImplementProperties
  111. ' 5. In your UC's ReadProperties event, add this line of code
  112. '       Call ImplementProperties
  113. ' 6. In you UC's Terminate event, add this line of code
  114. '       If Not myCustomProps Is Nothing Then myCustomProps.Detach
  115. ' 7. Respond to the following new events contained in your UC
  116. '       IPropertyBrowserEvents_FormatPropertyDisplay
  117. '       IPropertyBrowserEvents_FormatPropertyEnum
  118. '       IPropertyBrowserEvents_SetEnumPropertyValue
  119. '       IPropertyBrowserEvents_ShowCustomPropertyPage
  120. ' see IPropertyBrowserEvents class for more info & examples
  121.  
  122. ' There is one addiitonal function provided that is not associated directly with the usercontrol
  123. ' and is provided for convenience only. PropertyPageClose (see that function for comments)
  124. ' That function allows you to close a property page, via code, from within the property page
  125.  
  126.  
  127. ' PROGRAMMING NOTES
  128. ' A vast portion of this class is simply to track & maintain arrays used for the thunk. Why use a thunk & why
  129. ' manage memory arrays in memory vs in a module or in the class itself?  The reason is kinda simple.
  130. ' VB will use the same interface for multiple controls of the same type.  If your usercontrol hacks the vTable
  131. ' so it can receive events, what happens when the next usercontrol is loaded?  It hacks the same vTable and
  132. ' all of the previous usercontrol's events are fired to last usercontrol that hacked the vTable.  This means, that,
  133. ' in effect, all the properties of previous usercontrols can change when the last one's properties are changed.
  134. ' To make matters worse, compiled OCXs have their own vTable, though many copies of the control can use the
  135. ' same VTable.  But in IDE design, any uncompiled usercontrols, whether the same usercontrol or different,
  136. ' can use the same VTable.
  137.  
  138. ' Therefore, a memory thunk is used that exists in project memory and that can call any usercontrol in the project
  139. ' and all usercontrols know about it and have access to it. And since we can't allow the usercontrol references
  140. ' and pointers to exist in a single class (should that class be destroyed), we have to have them float in memory.
  141. ' Managing memory arrays was fun, but is a bit code intensive. Note: regarding the thunks. The thunks call
  142. ' functions within this class via Paul Caton's great zAddressOf routines. To prevent having to store the address
  143. ' of up to 6 functions per class instance, the thunks use offsets from a known address. When uncompiled, this
  144. ' offset, within class objects, appears to be 32 bytes between functions. When compiled, it drops to 13 bytes.
  145. ' Keep this in mind should you want to tweak the asm thunks.
  146.  
  147. ' http://www.vbaccelerator.com/home/vb/Code/Controls/UserControl_OLE_Extensions/IPerPropertyBrowse/article.asp
  148. ' The example on vbAccelerator uses a DLL to prevent these problems that I overcame via thunks & managing memory
  149. ' arrays. The vbAccelerator post is a good bit of coding. I wanted to try and do this without using an Active-X
  150. ' DLL and TLBs. I have managed to replicate vbAccelerator's code exactly and also improved/fixed some issues
  151. ' their DLL experiences.
  152.  
  153. ' This class makes heavy use of the DispCallFunc API which enables coders low-level interface manipulation. It isn't
  154. ' exactly easy to use and there is very little documentation on it, but if you have an interface pointer, you have
  155. ' full control over it with minimal effort. Researching the Intefaces on MSDN is a must though, crashing is easy :)
  156.  
  157. ' Is this a better solution than vbAccelerator's version?  Nope, just a different one that uses no additional dependencies
  158. ' If you do decide to use this code, you must add the 2 classes to your usercontrol project.
  159. ' Obviously the form & usercontrol provided in this project are soley to enable experimenting.
  160.  
  161.  
  162. ' APIs primarily for setting up memory arrays and communicating via interface pointers
  163. Private Declare Function DispCallFunc Lib "oleaut32" (ByVal ppv As Long, ByVal oVft As Long, ByVal cc As Long, ByVal rtTYP As VbVarType, ByVal paCNT As Long, ByVal paTypes As Long, ByVal paValues As Long, ByRef fuReturn As Variant) As Long
  164. Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)
  165. Private Declare Function VirtualProtect Lib "kernel32" (ByVal lpAddress As Long, ByVal dwSize As Long, ByVal flNewProtect As Long, lpflOldProtect As Long) As Long
  166. Private Declare Function CoTaskMemAlloc Lib "ole32.dll" (ByVal cb As Long) As Long
  167. Private Declare Function CoTaskMemRealloc Lib "ole32.dll" (ByVal pv As Any, ByVal cb As Long) As Long
  168. Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal pv As Long)
  169. Private Declare Function SysAllocString Lib "oleaut32.dll" (ByVal pOlechar As Long) As Long
  170. Private Declare Function VarPtrArray Lib "msvbvm60.dll" Alias "VarPtr" (ByRef Ptr() As Any) As Long
  171. Private Type SAFEARRAYBOUND
  172.     cElements As Long
  173.     lLbound As Long
  174. End Type
  175. Private Type SafeArray
  176.     cDims As Integer
  177.     fFeatures As Integer
  178.     cbElements As Long
  179.     cLocks As Long
  180.     pvData As Long
  181.     rgSABound As SAFEARRAYBOUND
  182. End Type
  183. Private Type CAWORDOLESTR
  184.     Count As Long
  185.     DataPtr As Long
  186. End Type
  187. Private Const E_POINTER As Long = &H80004003
  188. Private Const E_NOTIMPL As Long = &H80004001
  189. Private Const E_OUTOFMEMORY As Long = &H8007000E
  190. Private Const E_NOINTERFACE As Long = &H80004002
  191.  
  192. ' APIs used to create & maintain mapped file
  193. Private Declare Function CreateFileMapping Lib "kernel32.dll" Alias "CreateFileMappingA" (ByVal hFile As Long, ByRef lpFileMappigAttributes As Any, ByVal flProtect As Long, ByVal dwMaximumSizeHigh As Long, ByVal dwMaximumSizeLow As Long, ByVal lpName As String) As Long
  194. Private Declare Function CloseHandle Lib "kernel32.dll" (ByVal hObject As Long) As Long
  195. Private Declare Function MapViewOfFile Lib "kernel32.dll" (ByVal hFileMappingObject As Long, ByVal dwDesiredAccess As Long, ByVal dwFileOffsetHigh As Long, ByVal dwFileOffsetLow As Long, ByVal dwNumberOfBytesToMap As Long) As Long
  196. Private Declare Function UnmapViewOfFile Lib "kernel32.dll" (ByRef lpBaseAddress As Any) As Long
  197. Private Const PAGE_READWRITE As Long = &H4
  198. Private Const PAGE_EXECUTE_READWRITE& = &H40&
  199. Private Const ERROR_ALREADY_EXISTS As Long = 183&
  200. Private Const SECTION_MAP_WRITE As Long = &H2
  201. Private Const SECTION_MAP_READ As Long = &H4
  202. Private Const CC_STDCALL As Long = 4&
  203.  
  204. ' APIs used to control display of a property page
  205. Private Declare Function SetWindowLongA Lib "user32.dll" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
  206. Private Declare Function GetParent Lib "user32.dll" (ByVal hWnd As Long) As Long
  207. Private Declare Function CoCreateInstance Lib "ole32" (rclsid As Any, ByVal pUnkOuter As Long, ByVal dwClsContext As Long, riid As Any, pvarResult As Long) As Long
  208. Private Const CLSCTX_INPROC_SERVER As Long = 1
  209. Private Declare Function GetDesktopWindow Lib "user32.dll" () As Long
  210. Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByRef lParam As Any) As Long
  211. Private Const WM_SETREDRAW As Long = &HB
  212.  
  213. '-Callback declarations for Paul Caton thunking magic----------------------------------------------
  214. Private Declare Function GetModuleHandleA Lib "kernel32" (ByVal lpModuleName As String) As Long
  215. Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long
  216. Private Declare Function VirtualAlloc Lib "kernel32" (ByVal lpAddress As Long, ByVal dwSize As Long, ByVal flAllocationType As Long, ByVal flProtect As Long) As Long
  217. Private Declare Function VirtualFree Lib "kernel32" (ByVal lpAddress As Long, ByVal dwSize As Long, ByVal dwFreeType As Long) As Long
  218. Private Declare Function IsBadCodePtr Lib "kernel32" (ByVal lpfn As Long) As Long
  219. '-------------------------------------------------------------------------------------------------
  220.  
  221. ' -------- Following used in PropertyPageClose function
  222. Private Type POINTAPI
  223.     x As Long
  224.     Y As Long
  225. End Type
  226. Private Type Msg
  227.     hWnd As Long
  228.     Message As Long
  229.     wParam As Long
  230.     lParam As Long
  231.     Time As Long
  232.     pt As POINTAPI
  233. End Type
  234. Private Const VK_RETURN As Long = &HD
  235. Private Const WM_KEYDOWN As Long = &H100
  236. Private Const WM_KEYUP As Long = &H101
  237. Private Const VK_ESCAPE As Long = &H1B
  238.  
  239. ' -------- Local constants, structures and class variables
  240. Private Const IUnknownQueryInterface As Long = 0&   ' IUnknown vTable offset to Query implemented interfaces
  241. Private Const IUnknownAddRef As Long = 4&           ' IUnknown vTable offset to increment reference count
  242. Private Const IUnknownRelease As Long = 8&          ' IUnkownn vTable offset to decrement reference count
  243.  
  244. Private Const ThunkVTableOffset As Long = &HCC      ' offset in thunk to store client array pointer (See CreateThunk)
  245. Private Const ThunkVTableOffsetPPG As Long = &H9C   ' offset in thunk to store client array pointer (See CreateThunk)
  246. Private Const ThunkGDSOffset As Long = &H0&         ' offset in thunk where GetDisplayString is handled
  247. Private Const ThunkGPDSOffset As Long = &H34        ' offset in thunk where GetPredefinedStrings is handled
  248. Private Const ThunkGPDVOffset As Long = &H64        ' offset in thunk where GetPredefinedValue is handled
  249. Private Const ThunkMPTPOffset As Long = &H9C        ' offset in thunk where MapPropertyToPage is handled
  250. Private Const ThunkActivateOffset As Long = &H64    ' offset in thunk where IPropertyPage:Activate is handled
  251.  
  252. Private Enum PropType                               ' property type with regards to this class
  253.     ptype_Enum = 0&
  254.     ptype_Dialog = 1&
  255.     ptype_LockedDialog = 3&
  256. End Enum
  257. Private Type UserDispActionStruct                   ' used to store implemented property info
  258.     DispID As Long                                  ' IDispatch ID of the property
  259.     Name As String                                  ' Actual property name
  260.     pType As PropType                               ' 0=enumeration-type, 1=custom dialog, 2=custom dialog w/locking display
  261. End Type
  262. Private Type DispIDStruct                           ' Collection of property info
  263.     Count As Long
  264.     Params() As UserDispActionStruct
  265. End Type
  266.  
  267. ' IPPB=IPerPropertyBrowsing, IPPG=IPropertyPage
  268. Private Type VTableArrayStruct      ' (one structure per unique VTable that is subclassed) :: 28 bytes, and may have an additonal 4 byte counter.
  269.     VTable As Long                  ' the subclassed interface's VTable address
  270.     ClientPtr As Long               ' pointer to the VTableArrayClientStruct array
  271.     ThunkPtr As Long                ' address where thunk resides
  272.     origFunction1 As Long           ' original VTable function address: for IPPB; IPerPropertyBrowsing_GetDisplayString, for IPPG; IPropertyPage_Activate
  273.     origFunction2 As Long           ' original VTable function address: for IPPB; IPerPropertyBrowsing_GetPredefinedStrings, for IPPG; IPPG reference
  274.     origFunction3 As Long           ' original VTable function address: for IPPB; IPerPropertyBrowsing_GetPredefinedValue, for IPPG; not used
  275.     origFunction4 As Long           ' original VTable function address: for IPPB; IPerPropertyBrowsing_MapToPropertyPage, for IPPG; not used
  276. End Type
  277. Private Type VTableArrayClientStruct ' (one structure per class instance) :: 12 bytes and may have an additional 4-24 bytes as shown below
  278.     MePointer As Long               ' this class' object pointer
  279.     LocalVTableOffset As Long       ' this class' IPropertyPage:Activate pointer; additional functions are offset by +/- 32-13 bytes each
  280.     InterfacePtr As Long            ' IPPB: reference to the IPerPropertyBrowsing interface, IPPG: not used
  281. End Type
  282. ' Client array structure.
  283. ' IPPB : 4 bytes       12 bytes     12 bytes
  284. '        ArrayCount    1st client   2nd client  etc
  285. '                      ^^ ptr stored in thunk
  286. ' IPPG : 4 bytes       4 bytes      4 bytes          4 bytes      4 Bytes          4 bytes              12 bytes    12 bytes
  287. '        SetWinLongPtr PrevWndProc  CallWndProcPtr   ArrayCount   ActiveClientObj  ActiveClientFuncPtr  1st client  2nd client  etc
  288. '        ^^ set by IPropertyPage:Activate ^^                       ^^ Set by MapPropertyToPage ^^       ^^ ptr stored in thunk
  289.  
  290. ' cached pointer references
  291. Private c_UCIPEPointer As Long          ' pointer to calling usercontrol's IPropertyBrowserEvents object
  292. Private c_InterfaceIPPB As Long         ' pointer to calling usercontrol's IPerPropertyBrowser interface
  293. Private c_localVTableOffset As Long     ' function pointer to this class' IPropertyPage:Activate
  294. Private c_FileHandle As Long            ' pointer to shared mapped memory file (all implemented usercontrols share this file)
  295. ' the mapped file structure follows :: 12 bytes total, each are pointers to a VTableArrayStruct
  296. ' 4 bytes                            4 bytes                              4 bytes
  297. ' vTables() array for compiled ocx   vTables() array for uncompiled ocx   vTable for hacked property page
  298.  
  299. ' configuration variables
  300. Private c_UncompiledOCX As Long         ' flag indicating compiled class or not & also c_FileHandle offset: 0=compiled, 4=uncompiled
  301. Private c_RunUnsafeInIDE As Boolean     ' IDE safety override flag: See IgnoreIDESafety property
  302. ' collection
  303. Private c_DispIDCol As DispIDStruct     ' collection of implemented dispatch IDs and related information
  304. Private c_MappedDispID As Long          ' disposition ID of last mapped property (See IPerPropertyBrowsing_MapToPropertyPage)
  305.  
  306. Public Property Let IgnoreIDESafety(bIgnore As Boolean)
  307.     ' as mentioned in the lead remarks at very top, this class
  308.     ' has potential of crashing your project when running it with
  309.     ' an uncompiled usercontrol. By default it is not allowed
  310.     ' to run unless 1) the usercontrol is compiled, or 2) this
  311.     ' property is set to true before Attach is called
  312.     c_RunUnsafeInIDE = bIgnore
  313. End Property
  314.  
  315. Public Function Attach(theUsercontrol As Object, ByVal AmbientUserMode As Boolean) As Boolean
  316.  
  317.     ' Must be called before AddProperty function is called.
  318.     ' This function associates a IPerPropertyBrowsing Interface with the usercontrol and then
  319.     ' tweaks the interface's VTable to send 3 of the interfaces's functions to this class vs VB
  320.     ' The Detach property must be called in the usercontrol's terminate event
  321.     
  322.     ' The AmbientUserMode must be passed as Ambient.UserMode
  323.     ' When UserMode=True, then usercontrol is in runtime & modifying the VTable is not performed
  324.     ' because this class is for container's design time only, not runtime
  325.     
  326.     ' Function fails on these conditions
  327.     ' 1) Attach already called
  328.     ' 2) AmbientUserMode=False and IgnoreIDESafety=False
  329.     ' 3) AmbientUserMode=True (should fail, you do not want to subclass at runtime)
  330.     ' 4) Failed to obtain an interface pointer for either IPropertyPage or IPerPropertyBrowsing (unlikely)
  331.     ' 5) Failed to create needed array memory (usually less than 1kb per project). Low memory issues
  332.     
  333.     If AmbientUserMode = False Then ' else no need to subclass the Interfaces if running in compiled mode
  334.         
  335.         If c_FileHandle Then Exit Function ' already attached
  336.         
  337.         Dim iUCevents As IPropertyBrowserEvents
  338.         Debug.Assert IsUnCompiled()                     ' running in IDE?
  339.         If c_RunUnsafeInIDE = False Then                ' IgnoreIDESafety set? If not...
  340.             If c_UncompiledOCX Then Exit Function       ' yes, abort because IgnoreIDESafety property not set
  341.         End If
  342.         
  343.         On Error Resume Next
  344.         Set iUCevents = theUsercontrol                  ' test if calling object Implements IPropertyBrowserEvents
  345.         If Err Then
  346.             Err.Clear                                   ' usercontrol failed to add Implements IPropertyBrowserEvents
  347.             Exit Function
  348.         End If
  349.         c_UCIPEPointer = ObjPtr(iUCevents)              ' cache pointer to calling object's IPropertyBrowserEvents object
  350.         
  351.         Dim varRtn As Variant, pUC As Long
  352.         Dim GUID(0 To 3) As Long
  353.         Dim pvTypes(0 To 1) As Integer, pvPtrs(0 To 1) As Long, pValues(0 To 1) As Variant
  354.         Const IID_IPerPropertyBrowsing As String = "{376BD3AA-3845-101B-84ED-08002B2EC713}" ' GUID for IPerPropertyBrowsing
  355.         
  356.         On Error GoTo CATCH_EXCEPTION
  357.         If ConvertGUIDtoArray(IID_IPerPropertyBrowsing, GUID) Then
  358.             pUC = ObjPtr(theUsercontrol)
  359.             pvTypes(0) = vbLong: pValues(0) = VarPtr(GUID(0)): pvPtrs(0) = VarPtr(pValues(0))
  360.             pvTypes(1) = vbLong: pValues(1) = VarPtr(c_InterfaceIPPB): pvPtrs(1) = VarPtr(pValues(1))
  361.             ' See if the usercontrol implements IPerPropertyBrowsing & it should if it has any public variables or methods
  362.             Call DispCallFunc(pUC, IUnknownQueryInterface, CC_STDCALL, vbLong, 2&, VarPtr(pvTypes(0)), VarPtr(pvPtrs(0)), varRtn)
  363.             If c_InterfaceIPPB Then ' we have IPerPropertyBrowsing interface
  364.                 ' QueryInterfaces ups the ref count, release the reference
  365.                 Call DispCallFunc(c_InterfaceIPPB, IUnknownRelease, CC_STDCALL, vbLong, 0&, 0&, 0&, varRtn)
  366.                 Attach = AddClient_IPerPropertyBrowsing()                    ' call workhorse for adding clients, thunks & managing memory arrays
  367.             End If
  368.         End If
  369.     End If
  370. CATCH_EXCEPTION:
  371.     If Err Then Err.Clear
  372. End Function
  373.  
  374. Public Function Detach() As Boolean
  375.  
  376.     ' This function removes a client from the thunks client list and optionally...
  377.     '   -- destroys/resizes the memory array
  378.     '   -- modifies the thunk's client pointer
  379.     '   -- restores the VTable's function pointers
  380.     '   -- destroys/updates the mapped memory file
  381.     
  382.     ' Function can fail for these conditions
  383.     ' 1) Attach was never called
  384.  
  385.     If c_InterfaceIPPB = 0& Then Exit Function
  386.     If c_FileHandle = 0& Then Exit Function
  387.  
  388.     Dim Clients() As VTableArrayClientStruct, vTables() As VTableArrayStruct
  389.     Dim tSA As SafeArray, vTablePtr As Long
  390.     Dim cSA As SafeArray, ClientPtr As Long
  391.     Dim VTable As Long, hView As Long, varRtn As Variant
  392.     Dim vCount As Long, cCount As Long, vIndex As Long, cIndex As Long, lRtn As Long
  393.     
  394.     Const MEM_RELEASE As Long = &H8000&                        'Release allocated memory flag
  395.  
  396.     hView = MapViewOfFile(c_FileHandle, SECTION_MAP_WRITE, 0&, 0&, 0&)  ' map the memory file
  397.     CopyMemory vTablePtr, ByVal hView + c_UncompiledOCX, 4&         ' get array ptr to VTable array
  398.     CopyMemory vCount, ByVal vTablePtr, 4&                          ' get the number of VTable array entries
  399.     CopyMemory VTable, ByVal c_InterfaceIPPB, 4&                        ' get the vTable pointer for this uc's IPPB interface
  400.     
  401.     OverlayArrayOnMemory tSA, VarPtrArray(vTables), vTablePtr + 4&, 28&, vCount
  402.     vIndex = FindVTable(vTables(), VTable)                          ' find the vTable for this interface
  403.     If vIndex < vCount Then                                          ' else not found, should never happen
  404.         ClientPtr = vTables(vIndex).ClientPtr                       ' cache the client pointer
  405.         CopyMemory cCount, ByVal ClientPtr, 4&                      ' get the client count & overlay array on memory address
  406.         OverlayArrayOnMemory cSA, VarPtrArray(Clients), ClientPtr + 4&, 12&, cCount
  407.         cIndex = FindClient(Clients(), c_InterfaceIPPB)                 ' search for this client
  408.         If cIndex < cCount Then                                     ' else client not found, should never happen
  409.             cCount = cCount - 1                                     ' decrement count
  410.             If cCount = 0& Then                                     ' removing last client
  411.                 CoTaskMemFree ClientPtr                                         ' free array memory
  412.                 SetVTableEntry VTable + 12&, vTables(vIndex).origFunction1  ' replace vTable pointers
  413.                 SetVTableEntry VTable + 20&, vTables(vIndex).origFunction2
  414.                 SetVTableEntry VTable + 24&, vTables(vIndex).origFunction3
  415.                 SetVTableEntry VTable + 16&, vTables(vIndex).origFunction4
  416.             Else                                                    ' shift client array left, deleting the detached client
  417.                 If cIndex < cCount Then CopyMemory Clients(cIndex), Clients(cIndex + 1), (cCount - cIndex) * 12&
  418.             End If
  419.             OverlayArrayOnMemory cSA, VarPtrArray(Clients), 0&, 0&, 0&  ' remove overlay, no longer needed
  420.             If cCount Then
  421.                 lRtn = CoTaskMemRealloc(ClientPtr, cCount * 12& + 4&)   ' redim preserve the clients array
  422.                 If lRtn Then                                            ' else error out of memory, we can't redim the array
  423.                     vTables(vIndex).ClientPtr = lRtn                    ' set vTable's pointer & thunk address client ref
  424.                     CopyMemory ByVal vTables(vIndex).ThunkPtr + ThunkVTableOffset, lRtn + 4&, 4&
  425.                     CopyMemory ByVal lRtn, cCount, 4&                   ' update client count
  426.                 End If
  427.             Else                                                        ' removed last client
  428.                 VirtualFree vTables(vIndex).ThunkPtr, 0&, MEM_RELEASE   ' release the thunk
  429.                 vCount = vCount - 1                                     ' decrement count
  430.                 If vCount = 0& Then                                     ' removing last vtable reference; free array memory
  431.                     CoTaskMemFree vTablePtr
  432.                     CopyMemory ByVal hView + c_UncompiledOCX, vCount, 4&
  433.                 Else                                                    ' shift array & then redim preserve it
  434.                     If vIndex < vCount Then CopyMemory vTables(vIndex), vTables(vIndex + 1), (vCount - vIndex) * 28&
  435.                     lRtn = CoTaskMemRealloc(vTablePtr, vCount * 28& + 4&)
  436.                     If lRtn Then CopyMemory ByVal hView + c_UncompiledOCX, lRtn, 4& ' resized, update the mapped memory file
  437.                 End If
  438.             End If
  439.             OverlayArrayOnMemory tSA, VarPtrArray(vTables), 0&, 0&, 0&  ' remove overlay, no longer needed
  440.             Detach = True                                               ' return success
  441.         Else
  442.             OverlayArrayOnMemory cSA, VarPtrArray(Clients), 0&, 0&, 0&  ' remove overlays, no longer needed
  443.             OverlayArrayOnMemory tSA, VarPtrArray(vTables), 0&, 0&, 0&
  444.         End If
  445.     Else
  446.         OverlayArrayOnMemory tSA, VarPtrArray(vTables), 0&, 0&, 0&      ' remove overlay, no longer needed
  447.     End If
  448.     
  449.     ' check to see if IPropertyPage was created...
  450.     CopyMemory vTablePtr, ByVal hView + 8&, 4&                          ' get hacked property page vTable() array pointer
  451.     If vTablePtr Then
  452.         ReDim vTables(0 To 0)                                       ' copy vTable array from memory
  453.         CopyMemory vTables(0), ByVal vTablePtr, 28&
  454.         CopyMemory cCount, ByVal vTables(0).ClientPtr + 12&, 4&     ' get client count & overlay local array on memory array
  455.         OverlayArrayOnMemory tSA, VarPtrArray(Clients), vTables(0).ClientPtr + 12&, 12&, cCount + 1
  456.         ' find us in the client array
  457.         lRtn = ObjPtr(Me)
  458.         For cIndex = 1 To cCount
  459.             If Clients(cIndex).MePointer = lRtn Then Exit For
  460.         Next
  461.         If cIndex <= cCount Then                                    ' we are a client, remove and reallocate array
  462.             cCount = cCount - 1                                     ' decrement client count
  463.             If cCount = 0& Then                                     ' we were last client
  464.                 VirtualFree vTables(0).ThunkPtr, 0&, MEM_RELEASE    ' release thunk
  465.                 CoTaskMemFree vTables(0).ClientPtr                  ' release client array
  466.                 CoTaskMemFree vTablePtr                             ' release vTable array
  467.                 CopyMemory ByVal hView + 8&, 0&, 4&                 ' remove reference from mapped file
  468.                 SetVTableEntry vTables(0).VTable + 16&, vTables(0).origFunction1
  469.                 ' unreference the PropertyPage we created in AddClient_IPropertyPage
  470.                 Call DispCallFunc(vTables(0).origFunction2, IUnknownRelease, CC_STDCALL, vbLong, 0&, 0&, 0&, varRtn)
  471.             Else                                                    ' shift clients left
  472.                 If cIndex < cCount Then CopyMemory Clients(cIndex), Clients(cIndex + 1), (cCount - cIndex) * 12&
  473.                 Clients(0).MePointer = cCount                       ' update client count & resize array
  474.                 lRtn = CoTaskMemRealloc(vTables(0).ClientPtr, cCount * 12& + 24&)
  475.                 If lRtn Then                                        ' couldn't shorten array? hmmm, memory issues
  476.                     CopyMemory ByVal vTablePtr + 4&, lRtn, 4&       ' otherwise, update pointers in thunk & vTable structure
  477.                     CopyMemory ByVal vTables(0).ThunkPtr + ThunkVTableOffsetPPG, lRtn + 24&, 4&
  478.                 End If
  479.             End If
  480.         End If
  481.         OverlayArrayOnMemory tSA, VarPtrArray(Clients), 0&, 0&, 0&
  482.         Erase vTables()
  483.     End If
  484.     If hView Then UnmapViewOfFile hView                                 ' unmap file, if not already done
  485.     CloseHandle c_FileHandle                                                ' unreference the shared memory file
  486.     c_InterfaceIPPB = 0&                                                    ' reset local variables
  487.     c_FileHandle = 0&
  488. End Function
  489.  
  490. Public Function AddProperty(theUsercontrol As Object, ByVal PropertyName As String, _
  491.                                                 Optional Enumeration As Boolean = True, _
  492.                                                 Optional LockIDEdisplay As Boolean = False) As Boolean
  493.     
  494.     ' Must call Attach function first.
  495.     ' Once the class is attached to a usercontrol, call this function to add all properties that
  496.     ' you want to display custom dropdown enumeration text
  497.     
  498.     ' Parmeters
  499.     ' theUserControl :: Always pass as Me
  500.     ' PropertyName :: the property to be implemented
  501.     ' Enumeration ::
  502.     '   If True, the property has values displayed in a dropdown combobox
  503.     '   If False, the property gets value from custom dialog or form you display
  504.     ' LockIDEDisplay :: applicable only if Enumeration=False
  505.     '   If True, a user cannot add property directly into the property sheet, must use ellipsis button (...)
  506.     '       If true, then you should also respond to the IPropertyBrowserEvents_FormatPropertyDisplay event
  507.     '       However, if you fail to respond to that event or set its Cancel parameter to True, the display is unlocked
  508.     '   If False, user can type/paste values into the property sheet, prevents unnecessary calls to your usercontrol
  509.     
  510.     ' Function fails on these conditions
  511.     ' 1) Attach not called yet
  512.     ' 2) Property already added or Property doesn't exist: PropertyName is invalid
  513.     ' 3) Failed to obtain an interface pointer for either IPropertyPage or IPerPropertyBrowsing (unlikely)
  514.     ' 4) Failed to create needed array memory (usually less than 1kb per project). Low memory issues
  515.     ' 5) Coding error on my part -- these can be fixed though
  516.     If c_FileHandle = 0& Then Exit Function ' must call Attach first
  517.     
  518.     Const IID_IDispatch As String = "{00020400-0000-0000-C000-000000000046}" ' GUID for IDispatch
  519.     Const IDispatchIDsOfNames As Long = 20& ' offset from IDispatch VTable
  520.     
  521.     Dim varRtn As Variant, DispID As Long
  522.     Dim ptrIInterface As Long, pUnk As Long
  523.     Dim GUID(0 To 3) As Long, CLSID(0 To 3) As Long
  524.     Dim pvTypes(0 To 4) As Integer, pvPtrs(0 To 4) As Long, pValues(0 To 4) As Variant
  525.         
  526.     On Error GoTo CATCH_ERROR
  527.     If ConvertGUIDtoArray(IID_IDispatch, GUID) Then
  528.         pUnk = ObjPtr(theUsercontrol)
  529.         ' Call UC's QueryInterface to get the IDispatch interface pointer
  530.         pvTypes(0) = vbLong: pValues(0) = VarPtr(GUID(0)): pvPtrs(0) = VarPtr(pValues(0))
  531.         pvTypes(1) = vbLong: pValues(1) = VarPtr(ptrIInterface): pvPtrs(1) = VarPtr(pValues(1))
  532.         ' HRESULT QueryInterface(REFIID iid, void ** ppvObject);
  533.         Call DispCallFunc(pUnk, IUnknownQueryInterface, CC_STDCALL, vbLong, 2&, VarPtr(pvTypes(0)), VarPtr(pvPtrs(0)), varRtn)
  534.         If ptrIInterface Then ' we have IDispatch interface, query the ID of the passed method
  535.             Erase GUID
  536.             pvTypes(0) = vbLong: pValues(0) = VarPtr(GUID(0)):        pvPtrs(0) = VarPtr(pValues(0))
  537.             pvTypes(1) = vbString: pValues(1) = VarPtr(PropertyName): pvPtrs(1) = VarPtr(pValues(1))
  538.             pvTypes(2) = vbLong: pValues(2) = 1&:                     pvPtrs(2) = VarPtr(pValues(2))
  539.             pvTypes(3) = vbLong: pValues(3) = 0&:                     pvPtrs(3) = VarPtr(pValues(3))
  540.             pvTypes(4) = vbLong: pValues(4) = VarPtr(DispID):         pvPtrs(4) = VarPtr(pValues(4))
  541.             ' HRESULT GetIDsOfNames(REFIID riid, OLECHAR FAR* FAR*  rgszNames, unsignedint cNames, LCID lcid, dispID FAR * rgDispId);
  542.             Call DispCallFunc(ptrIInterface, IDispatchIDsOfNames, CC_STDCALL, vbLong, 5&, VarPtr(pvTypes(0)), VarPtr(pvPtrs(0)), varRtn)
  543.             ' QueryInterfaces ups the ref count, release the reference
  544.             Call DispCallFunc(ptrIInterface, IUnknownRelease, CC_STDCALL, vbLong, 0&, 0&, 0&, varRtn)
  545.             If DispID <> -1& Then                               ' add the DispatchID to our local array
  546.                 If FindDispID(DispID, False) Then Exit Function ' abort; already added this property
  547.                 If Enumeration = False Then                     ' validate we can do this before we implement the property
  548.                     If AddClient_IPropertyPage() = False Then Exit Function
  549.                 End If
  550.                 DispID = FindDispID(DispID, True)               ' add property to our collection
  551.                 c_DispIDCol.Params(DispID).Name = PropertyName  ' cache property name for user callbacks
  552.                 If Enumeration Then                             ' set the property type used for interface callbacks
  553.                     c_DispIDCol.Params(DispID).pType = ptype_Enum
  554.                 Else
  555.                     If LockIDEdisplay Then c_DispIDCol.Params(DispID).pType = ptype_LockedDialog Else c_DispIDCol.Params(DispID).pType = ptype_Dialog
  556.                 End If
  557.                 AddProperty = True
  558.             End If
  559.         End If
  560.     End If
  561. CATCH_ERROR:
  562. If Err Then Err.Clear
  563. End Function
  564.  
  565. Public Function PropertyPageClose(thePropertyPage As Object, ByVal thePropertyPageHwnd As Long, Optional ByVal viaApplyButton As Boolean = True) As Boolean
  566.  
  567.     ' Should you ever need to close a property page from within the property page, via code...
  568.     ' thePropertyPage parameter is passed as:  Me
  569.     ' thePropertyPageHwnd is passed as:  PropertyPage.hWnd
  570.     ' viaApplyButton if True will call the property page's Apply event, regardless if the page's Changed/Dirty property is True
  571.     ' Sample Call:  PropertyPageClose Me, PropertyPage.hwnd, False
  572.     
  573.     ' The function will fail if viaApplyButton=True and the property page failed to apply the changes.
  574.     ' Note: This cannot be called in the propertypage's Initialize event, VB will override and display the page anyway
  575.     
  576.     Const IID_IPropertyPage As String = "{B196B28D-BAB4-101A-B69C-00AA00341D07}"
  577.     Const IPropPageApplyOffset As Long = 44& ' 12th VTable entry
  578.     Const IPropPageTranslateKeyOffset As Long = 52& ' 14th VTable entry
  579.     
  580.     Dim pMSG As Msg
  581.     Dim pUnk As Long
  582.     Dim GUID(0 To 3) As Long, varRtn As Variant, ptrIPropPage As Long
  583.     Dim pvTypes(0 To 1) As Integer, pvPtrs(0 To 2) As Long, pValues(0 To 1) As Variant
  584.     
  585.     On Error GoTo CATCH_EXCEPTION
  586.     If ConvertGUIDtoArray(IID_IPropertyPage, GUID) Then
  587.         ' Call QueryInterface to see if the IPropertyPage interface is used
  588.         ' Note: Per MSDN, IPropertyPage must be used if property page is displayed, using IPropertyPage2 is optional
  589.         pvTypes(0) = vbLong: pValues(0) = VarPtr(GUID(0)): pvPtrs(0) = VarPtr(pValues(0))
  590.         pvTypes(1) = vbLong: pValues(1) = VarPtr(ptrIPropPage): pvPtrs(1) = VarPtr(pValues(1))
  591.         pUnk = ObjPtr(thePropertyPage)
  592.         Call DispCallFunc(pUnk, IUnknownQueryInterface, CC_STDCALL, vbLong, 2&, VarPtr(pvTypes(0)), VarPtr(pvPtrs(0)), varRtn)
  593.         If ptrIPropPage Then
  594.             ' It is used, see if user wants the apply method called too?
  595.             Call DispCallFunc(ptrIPropPage, IUnknownAddRef, CC_STDCALL, vbLong, 0&, 0&, 0&, varRtn)
  596.             If viaApplyButton Then ' abort if Apply failed
  597.                 If DispCallFunc(ptrIPropPage, IPropPageApplyOffset, CC_STDCALL, vbLong, 0&, 0&, 0&, varRtn) <> 0& Then
  598.                     Call DispCallFunc(ptrIPropPage, IUnknownRelease, CC_STDCALL, vbLong, 0&, 0&, 0&, varRtn)
  599.                     Exit Function
  600.                 End If
  601.             End If
  602.             ' Send the property page an Escape Key to close
  603.             pMSG.hWnd = thePropertyPageHwnd
  604.             pMSG.Message = WM_KEYDOWN
  605.             pMSG.wParam = VK_ESCAPE
  606.             pMSG.lParam = -1
  607.             pvTypes(0) = vbLong: pValues(0) = VarPtr(pMSG): pvPtrs(0) = VarPtr(pValues(0))
  608.             Call DispCallFunc(ptrIPropPage, IPropPageTranslateKeyOffset, CC_STDCALL, vbLong, 1&, VarPtr(pvTypes(0)), VarPtr(pvPtrs(0)), varRtn)
  609.             ' QueryInterfaces ups the ref count, release the reference
  610.             Call DispCallFunc(ptrIPropPage, IUnknownRelease, CC_STDCALL, vbLong, 0&, 0&, 0&, varRtn)
  611.             PropertyPageClose = True
  612.         End If
  613.     End If
  614. CATCH_EXCEPTION:
  615.     If Err Then Err.Clear
  616.     If ptrIPropPage Then Call DispCallFunc(ptrIPropPage, IUnknownRelease, CC_STDCALL, vbLong, 0&, 0&, 0&, varRtn)
  617. End Function
  618.  
  619. Private Function AddClient_IPerPropertyBrowsing() As Boolean
  620.  
  621.     ' This function has multiple purposes and is the workhorse for Attach
  622.     ' 1) Creates a shared mapped memory file
  623.     ' 2) Creates a thunk for each new vTable that we may be subclassing
  624.     ' 3) Creates/resizes memory arrays used by the thunk
  625.     ' 4) Hacks the vTable, redirecting its functions to this class
  626.     
  627.     Dim hView As Long, bNew As Boolean, bError As Boolean
  628.     Dim theTables() As VTableArrayStruct, vCount As Long
  629.     Dim theClients() As VTableArrayClientStruct, cCount As Long
  630.     Dim arrayPtr As Long, tSA As SafeArray, cSA As SafeArray, Index As Long
  631.     Dim theClient As Long, VTable As Long
  632.     Dim vTableData As VTableArrayStruct
  633.     
  634.     CopyMemory VTable, ByVal c_InterfaceIPPB, 4&   ' VTable address
  635.     ' create an object we can use that will disappear when IDE closes & that can be shared by all usercontrols, compiled or not
  636.     ' ensure to make it unique to just our Thread or Process. Mapped memory files can be shared across other processes, and if
  637.     ' we have uc in VB while uc also in MSaccess, the vTable & Client array pointers will be invalid memory addresses in the
  638.     ' other processes.  Lesson learned.
  639.     c_FileHandle = CreateFileMapping(-1&, ByVal 0&, PAGE_READWRITE, 0&, 12&, "lvIPerPropBrowsingMemMap" & App.ThreadID)
  640.     If c_FileHandle = 0& Then ' can't create mapped file; abort
  641.         bError = True
  642.     Else
  643.         If (Err.LastDllError = ERROR_ALREADY_EXISTS) Then               ' already exists, see if new vTable is being hacked
  644.             hView = MapViewOfFile(c_FileHandle, SECTION_MAP_WRITE, 0&, 0&, 0&) ' access mapped file
  645.             CopyMemory arrayPtr, ByVal hView + c_UncompiledOCX, 4&      ' get array pointer from mapped file
  646.             If arrayPtr = 0& Then
  647.                 bNew = True
  648.             Else
  649.                 CopyMemory vCount, ByVal arrayPtr, 4&                       ' get the count
  650.                 ' get the VTableArrayStruct data & see if the vTable already subclassed
  651.                 OverlayArrayOnMemory tSA, VarPtrArray(theTables), arrayPtr + 4&, 28&, vCount ' overlay our array on memory array
  652.                 Index = FindVTable(theTables(), VTable)                     ' search for the vTable
  653.                 If Index = vCount Then                                      ' not found, need to increment our VTable array
  654.                     bNew = True
  655.                 Else                                        ' found and need to add new client
  656.                     theClient = theTables(Index).ClientPtr  ' get pointer to VTable's clientpe As Long, ByVal flProtect As     1eMapping(-1&,bles As Lonesses in the
  657.   0&, PAGEDCALb      Elsll fail if v      'rse(tyVal fl 0&, PAte Funct
  658.     wPa           array pour array oex).Cd vTable ,Clieearch for kkkkkkkkkkkvTable ,C
  659.       earst II   VirtualFiles c  1eMapping(-1&,bles Asssssssn, MEM_RyPagnunks & lrch for kkkkkkr2) = VarPtrFailtyVB    eaing
  660.   hen 1fage Files c  1eMapping(-oto tEM_RyPa     pMS): pvPtr                        sError GoTo CATCH_EXCEPTION
  661.     If ConvertGUIDtoArl flProarrayuL:: pvProwsing() As Boolean
  662.  
  663.   ccccccccMappired across s,ypes(0       ILong  s1HOtheCeil if v ?Ds, ss s,ypes(0     or Process. Cmory issuesdb      E& see ifyPage:AcBs OverlayArrayOnMem        hunk i2rucg =    or'   nditions
  664. Rntry theClie=n
  665.  
  666.   ccccc7e
  667.   ccccG
  668.   cccccn thill bal vTableeeeeeee + 16&, vTasafeInIDE As Bn      Pays  Lib "s, sstionsEOnMem        hunk i2rucg =  nsEOn       PopPageTransl       Iory isstsEOn      APE
  669.     S      l 0&, PAGEopPageAppled to add GoTo C.Para     'rse(has 
  670. Rntry  l 0&nrPageA Lesson lear                    ' ltyyyyyyll propertiesCol.ParConst IProledOCX,s(), V           ' 'i      sError GoTo CATo rbtr,  implemented
  671.  d
  672.  d
  673.  d
  674. ',ypes(0     or Process. wnt    1st clienpMapped memor)4s. wnt    PropertyCk i2rucg ================         ates a ttheCeilR0s origFuncompil, V          i theTables(Index).ClientPtr  ' get pointropertyayArrayOee B0nt=Sn the
  675.   (ax < cCct i2rucg)))))))))))))))ALbra     'rse(has 
  676. Rntry  l 0&nrPageA Lesson leS,+it))))b4et t cCouypes(0, PropertyPaALbt i2r/Names(REFIID addcsrntPtr, cE2&, 4&     'UR))b4et(hase, the property gets value from cd    t        sson l2&, 4&     'UR))b4et varble ,C
  677.       wntleHa7w4&     'UR))b4et(hase, the property ge ))b4et t cCouypes(0, Proper     ' Igno hViperty ge ))pes(0, PU If
  678.     Iables(Index).ClientPtr  'eeoailed to add Implemen0&, ntPtr  'eeoailed to add Imdd Iach new vTdex).C be subclass         If cIndex < cCount re, the propertyrlayArrayeoailed tU
  679.   ccccount re, the propLMappingpart -- these can be fixed tislemoving&aalse, usebr can type/paste valu add Implemen0&, ntPtr  'eeoailean       0&, =u add( wnt 'hat wlastet 'haSA As SafeArray, Index As ?ex).C be stetroperts the apply;
  680.               2d to ClientPtr    28wsinolemovingIach new        l u'eeoailean     .C be stetro1  t        l u'eeoaailean  2 ClientPtuyp5        Pping(-1&,bl hact&, 4E1opLMappingpart Pping(-1(rD <> -1& Then 3he vTab1ch new        &pin, 4E1opLMCMSaccess, the vT wnt    1stry vCoun hact&, N2   '  'eeoaileand  Pping(-1o hViperty ge )edOCX,s()l 0&nrPageA LAappdet CLS    ubcla/r  ' geArray(Clients), 0&, 0&, 0&  ' removalues into 'eeoail  0&, PAGED&  ' ' 3) CreatentM it unies if runan type/paste valu add Implemen0&, ntPtr  'eeoailean       0&, =u add( wnt 'hat wlastet 'haSA erty n 'haSA As Sahen
  681.         siyPage interfpart Ppnan type/paste valu aA As Sahen
  682. 7alu(o  sErr'e apply;
  683.            E(vI(haeAs Sahen
  684. 7alu(o  sErlts Sahenlay The  ' Nob4etinte))b4et t cCouypes(0, Plu(o  s=C_STE(-1&,by;
  685.   n       0&,    E(vI(haeAs80Plu(o  sErlts Saheefore AddC0part Ppn8 vbLonin AddC&'0& nan topLMappi6ean     tn      n                       sError GoTo CATCH_EXr
  686.   Appled to add41 new vTdex).C vbL3AGED&ryInt'4et(' Once the class   ni,                  ' cache the client pointer
  687.         CopyMemory cCount, ByVal ClientPtr0ahen ' abovbLonin AddC&'0ntPtr  ' get pointropertyayArrayOee ese canyayArraue, _
  688.         Ptr .ese caai + 16&tr0ahen ' abovbLonePageTransl     Else          vbLonePen
  689. 7axean  2 ClientPtuyp5        Pping(-1&,bl hact&, 4E1opLMappingpartele, redirectinCrelonePen
  690. 7axean  2WRlues(0) = VarPti ' property tyrayOee ese canyasson l2&, 4&     'UR)nt 'hat wlastet 'haSA erty n 'haSi=C_STEoaileaan  22222222rPtfsetPPG As Long = &H9C   ' offset s57  2WRlues(idate we, GUID2rucg =  nsEOn       PopPage    geA Lelemented
  691.  d
  692.  d
  693.  d
  694. ',ypes(0     or Pr       If En
  695. 7axe property is cg =  nsEOn       R7axeanles(vIny&,bryInt'4et(' Once the &
  696. ',ypes(0    Array, IBcs    ates a ttheng() bO     tthennst IIUID2ru9y;
  697.               .pType <   ' sex = FindVTable(th ' sex = Fin* 12kkkkkkrch le(thTvL   or Process. wnt    ClientsEOnue fromTable ,Clieearch for kkkkkkkkkkkvTable ,C
  698.       earst II       D2ru9y
  699. 7alu(o  sErr'e ap/      
  700.          A     emory tSs. wnt  es(0  ay The  3rst II       D2ru9yiaEmentPtr, 0xe prop           sEr) = VarPtr(p(&, 0&) Klieear)eD       1r4q8 vTable ' Once the ru9y7Croperty     _les c  1eMappe sError GoTo CAS) Then    4et(' OneL0rtyB4c'ent arrcess. wthe clire CreateTn ' abovbLontes
  701. P ccccc7e
  702.  d
  703.  ire CreateTnping(-1(rtyBrowsing interfaRlueent arrcesslCeateTn arrcess. w perty ge ))pes(0ntP      yyyyyyyyHandle Then Exit Function
  704.         PtMemory cCounPtr, 0xe prop  o) = VarPt t cCouypes(0, PropertyPaAL3re CreateTL abovbLontes
  705. P ccccc7e
  706.  d
  707.  ire *ndled
  708. Private ConFB
  709. P ccccchrchOCX, vs, compiled addreSCALLaAL3re0PtMemory cCo es(0  onsEOnMem        hunk i2rucc     caai +reSCALLaAL3re0PtMemory cCo es(0  onsEOnMem        hunsEOy ge )edOCX,ready' offset s57  2WRlues(idate weib "g)r     _3cW&
  710.                 If     (idaated.        ' sitiali   or PrS) Then 
  711.     ate we,           rement our Ving pvTedOCThen 3he vTaong, Optional ByVal viaAp2 sitng: pValues(0) a tthFunctioeateTnping(andle Then Exit Oan) Asr these conditions
  712.     ' 1) Attach was never c     I         If EIbacks
  713.      viaAp2 sitng: pValues(0) a tthFunctioeateTnping(andle Then  If EIbacks
  714.      ) T(theOl  If &nrPageA Lesson leS,+it))))b4et t cCouypes(0, PropertyPaALbt i2r/Names(> Ving pvTedOCThen 3he vTaongyInt'tn    aA AsA Lesso80Plu(oe8&7t))))b4et t cCouypes(0ucg ===========  If &nr    p5i     caai +reSCALLaAL3W(pertyBpertBpe As Pr calls to youru) Asr ))))b4er0     ray, Indddress:r0   ygyInt'tn  ic 2) this
  715.    vTab1ch new  r cent_IPr3fLv0i3llsonditions
  716.   r can typ_1a>(iyd If
  717.   ge ))peCall DispC d
  718.  iririririririririririririririririririririririririririririririririririririririileonin Addinpr&7t))))b4et t PirtiesCol.DispC d
  719.  iriririririise c_DispIDCol.Params(DispID).cUtinter for eiriririrr(pvPtrueW9ramsiri, _
  720.         P-ams(Diss(Disess,  )eouypes(0ucg =====tes      4 bytWiant
  721. nnkkrch le(thTvLsing (unlich le(thTvLsing     sson l2&,h le(thtr(pvPtr ' 1) Attach     C ' 1) AI   C ' 1           sError GoTo CATCH_EXr
  722.   Appled to add41 news Long dle Thent Pir Error2f &nrrto add41 news    C3call-
  723. 7axe CH_EXCEPTION:t&,o  sErroreor GoTo CAiGEPTION:t&,oPcked
  724.     ' CAS)oPcked
  725.     u(0, Plu = V arrayH_EXrGoTo CAo add41 ne:30, Plu = V arraydd41 ne:3=P
  726.     u(0, Plu = V arr client 9cess.End Function
  727.  If ptrIProd
  728.  d
  729. ',yp' ptrIProdiDispatchIDH
  730.  iririri:t&,oPckedn
  731. 7axean  mory cCo    w v ?Ds, ss sAsed, see if usieanntPtr    28wsinolemovingIach newppled to add41 news Long dleopPage,ent poinU fixt dleeTn arr         ' dispe array
  732.    GigFunction disl4rty ge nntPtr u     msEOn       PopPage    geA Lelemented
  733.  d
  734.  d
  735.  d
  736. ',ypes(0     or Pr       If En
  737. 7axe property iIach newi newi nefsedisl4TvLs, Plu  applyInt'd
  738. ',ypGEPTION:t&,oPck&, =u add( wntEGDdle = 0&rt Pping(-1(rD <>oryientPteTnpSry filetropertyyyyyyolnin AddC&'00 propertys   u(0, Plupointro(0     is cg =  nsEOn    )), varRtn)
  739.     s'   .pTe Pping
  740. ',yp'sEOn  ahbk&, =uDisecPlupointroyDdle = 0luesble array
  741.  
  742.  
  743.  
  744. vChbk&, =uDisecPlupointroyDdle =vvvvvvvvvv'en                        5     ILong  s1HOtheCeil if v ?Ds, ss s,ypes(0     or Pupoews    C3call-
  745. 7axroyDdle =vvv   s', MEM_RELEASE   to a uTCH_EXr
  746.   AA      Pping(.nde arraym      Pping(cp              bNew = True
  747.             Else
  748.      vChbk&, =uDiseIf EI       Else
  749.   ing(.nde ar ?ex9y7Cropercptype_Dialog
  750.             ' r
  751.   AA      Pping(.
  752.     i, 0xe pro   ' r
  753. (riririria rement   
  754.     Const IID_ientPtr, 4&     rC
  755. 7axremenrrt(4y, Indddress:r0 ry BM   Iory isstsE( wntE property iIach ne onFB'                    DiesCol         pvTypa rement   
  756.  sErrore?se Pping
  757. ',yp'sttheng() bO     tthennst IIUID2ru9y;
  758.               .pType <   ' s ed memorM
  759.  iririririririririrclassB onse <   '  cce = WM_KEYDOWN
  760. nse <   ' Func(ptrIPiririri:t&,oPckedn
  761. 7axean  mory cCo EOn     '  c               percptype_Dialog
  762.    icounthennst IIUID2ru9y;
  763. 0xe pro   Gs        UID2ru9)og
  764.    , varRtn)
  765.      Fin* 12kk ' L   Fin* 12kk ' L   Fin* 12kk ' L   Fin* 12* 12kk ' L   Fin 12k        sEOn  
  766.       EOn       PopPage    ardardles, _
  767.    Finrkk ' L   Fin* 12* 12kk  if v ?,' L   crr.LastDllError = ERROR_ALREADY_EXISTS) TyVal viaAp2 A               IProdiDispatc        pIde pro   G= V arr client 9cyp'sttheng() bOROR_ALREADY_EXIcL   or Proit wlth VTable sError GoI    EOn 17axremenrrt(4y, Indddress:r0 ry BM   Iory isstsE( wntE pog
  768.       c_DispIDCol.Padb    lS_DispIDCol.Padiled to aProce Val via
  769. ',(Ch for           If FindDispID(ndDis"52& ' 14th VTaby cCoute c_DispIDC1unthenFin* 12kk ' L   d diled to aProce Val via
  770. ', 12kk ' L   d di( wntEriririrvntEriririrvntnlich lisstsE(t tDispIDCCl0whennstoh          ' cacFin* 1F, 12kk2kknD2richa
  771. ', 12kk ' L 9vCou(.nde arradate we, GUn* 1F, 12kk _les c  1eME (unlikelyrvntErirCouypes( r
  772.   AA      Pp if 2ndDispIaErirCm d
  773. rlassB os
  774.    IID_ientPtr, 4&     rC
  775. 777777777777))))b=3tach = True                DllError tachc  1c     4) Faile,43MappiMappiMappiUtinteEririent 9cyp'ndDispIaErirCm dEYDOWNImmmmmmmmmmmT' Funp'ndDispIaErirCBotect As    i0nc(ptrIPropPage, IPropPageApe, IPropPageApe, IPropPageApenyway
  776.     
  777.   Tabririri  ' se"  ' s edmtrIProd
  778.  d
  779. ',yp' ptrIProdiDispatchIDH
  780.  iririri:t&,e )edOC     EYDOWNImmmmmmmmmmmT' Funp'ndDispIaErirCBotect As    i0nc(pODispIaErnhe vTabProour w3vII     oIde pro   G= V arr diDispat(A As Sahen
  781. 7alu(o  sErr'e apply;
  782.            E(vI(haeAs3>e' Fu9arr ,A Lesson leSWontrol. By  4&    (B  sErr'e app   Gigggggggggggggg,r           T========A Less=IaErirCBotect As    i0n tDispIDCCl0whennstoh  &    ' se"  ' s 222rPtfErr'e apppMS): pvP3> -eoailed t   VirtuME  T========A Less=IaErVirtuM): pvP3> -eoailed t   Vient count
  783.                 End If
  784.             Else                                                        ' removed last client
  785.                 VirtHIp" & AppEr)3Narr         ' dispe npIaErirCts    )vK
  786. 0xe pr Vient coun$iririri:t&,e )edOC s,+ableOf    Dim thelEspat(A As Sahen
  787. 7alu(o  sErr'e a Sahen
  788. 7iririri:t&,e )edOC s,r Proit wiiiiiiiiiiiiit&,e )e(ecPlupointroyDdle = 0luesble a*ect As    i0nc(ptrIPropPage, IPropPageApe, IPropPageApe, IPropPage ERROR_1ty=FalseH_EXrh(if
  789.     ' ahbk&aCrray
  790.                 If FindDispID(DispIA m dropdown 'Erroreor GoTo CAiGEPTION:tiiiiiitlseH_tlseH_tlseH_tlseeH_tlseH_C5es c  1eMapparam O'tseH_tlseH_tlr   aserror o:tiiiiiitlseH_tlseH8uM): p       Else                                           0&  ' nt countH_tlr   aserror o:tiiiiiitlseH_tlr o:tiiiiiitlseHn(B           CPropPagTApro   Gf FindDi2(      uM): pvP3> X 8e=ttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttt_tlseeH_tlseH_C5es c  1eMapparam O'tsagTmmT' Funp'ndDispIaErir           gggggggggry BM3eeH_dE&ispCallFunc(ptrIInterface, IlTEoaeOf    Dim 0) =cIndex = FindClI8 ' L   Fin 1 127 ntroyDdle =ndDispIaErirCBotect As   2ttttttttttseH8uM127 ntroyDdle =ndDispIab  2ttttttttttseHgUIndex = c(ptrIInterfacefXISTS) Ty Attach= 0luesble a*ect ,bl      0luesble a*ect ,bl      0luesble a*ect ,bl      0luesble a*ect Error GoTo CATCH_EXle aM28
  791.                                                                  Else
  792. a*ect ,         (ririririririririririririririririririririilethen Ba*ect ,bl   e Function AddCli1 Unknown      o   G= V a'ln c  1eU                 e Funriri,nd  Pping(-1o hViperEvTypa rement  able sEment(-1o h2eTntm O'tseH_tlseH_tlr uttttttttttttttttttttttttttn, 4& ' resi?Ds,             Thunku,H resi?Ds,       inters
  793.                CLSID(0 T(((((((((u,H resi?Ds,PPen
  794. 7axean  2 C:   b  2tttttttttts    IThunku,H resi?Ds,       inters
  795.                CLSID(0 T((('  b  2t  ' get the VTabp if 2ndDispIaitlseFin0   IThunku,H resi?Ds,etttttttseH((((((((, a ttheCeilR0s origFuncompil, V          i theTables(Index).Clien array pointer from mapped file
  796.             'roit wiiiiiiit(')ririririiletApe, IPropPageApe, IPropPageApenywa'             'l  hunkyVal hV0'roit wiiipenywa'                   hunkyVal hVon le      CPdgeApenywaApenywa'             'l  he(vTabl0'roiEVwiiipenywa'                   hunkyVal hVon le  u         sim 0) =cIn 4TvLMhunky0=======  If pl4IPropPadex = Findr       1deApenywa'      sCtttttttseH((((((( intex <> -1& Then            
  797. ',yp'H_tls          Call     ateerty iIach ne onF   6     gTmmT'ues irl            p2 sitng: pValues(0) a tthFunctioeateTH hunkyVoD     ateerty iIach ne      0&  ' nt count      i
  798.    ,y, no lo 4TvLM i
  799.    ,y, no lsalutheUs l As Obj FinrtheTables(Index).Clien array pointer from mapped file
  800.    nd  Ppiniring(-1(rD <> -1& Then 3he vTab1ch new        &pin, 4E1opLMCMSacart -- Pch enywa'  d
  801.  d
  802. ',ypes(0     or Process. wnt    1st cli  '  et t cC        rrayPtr, 4&     a     a     a     a     le aM28
  803.   Detach a   i 0&, 0&  ' removalued  hView        Detach 04naErir     DyPtr, 4 a     a     a         vpes(0    Array, ' dispe niO3      Elseeeeeeeev  ,y, n      ICBotect i'sr      6ue) As BopvTypes(1)  IC client
  804.  hilR0Tess._     BopvTypes(1)  ICF              Virtu,e vTab1ch new ttttttt111111111vn As Booes(1)f
  805.  CATC
  806.                hVon leypes(1)Cetters
  807. AD intersn(tintf'
  808. 7axe  pvTyet the count
  809.   rst
  810.     
  811.     Const IID_         .p
  812.      H ypes(1)Ce  tn et t cCcCo    ':ions
  813.     ' 1) AtilayArrayct As    i0nc(ptrIPr  i0nc(ptrIProng, 0&irtu,e vTab1ch new t Asleype5i'   Elseeee1 array pointer from mooes(1)'2ru9y
  814. 7alu(o  sErr'e ap/ndDisptrIPr  i0nc(ptrIPronsptrIPr  i0nc(ptrIPr <> cn le  u           PopPage  wsinnunt
  815.   rst
  816. tttttt able sEment(-1os poix(CBotect i'sr      6ue'ess._     Bop8e=tttttttttttttttttttttttttttt0d Obj Firewe cal     Bop8e=tttttttttttttttttttttttttttt0d Obj Firewe cal     Bop8ee1te needed ar       PopPage  wsided ar       PopPage  tt ableent   
  817.  sErrore?se Pping
  818.             tt ablSru9y
  819. 7alu(ttttttttts  94,cyrray
  820.      xOnMemor                         Optional LockIDEdisplay As <o=erty iIaDtttttttttttt    ioea Ppingthe class   ni <o=erty .ree arrayT .ree arrayT1Hes and is thees(1)'2ru9y
  821. 7alu(otbe subclassing
  822.     ' 1os poiheetbe subclayrrasp8ee1te needed ar   oDEdispl4'eeoai       F"used,8ee1teLM i
  823.   DispIAPage K     Els.ClientPtr  ' &)  EXrc(ptrIPronsptrIPr  i0nc(bleent   
  824.  sping(-1&,bl hatu,e v0luesblAni <o=erty .ree arrayT .ren      ICBotect i'Le      n 3he v sub thees(1)'2ru9y
  825. 7alu(o nXrh(if
  826.     ' ahbk&aCrray
  827.      Ani <o=e Els.ClientPtr  ' &)  EXrc(ptrIPro 3he v sub thees'p2 1eME (unliksy
  828.      Ac'st
  829.    ees can be shst
  830.    ees re to mmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmm'1eME (un.:'ees'p2 1'mmmmmmmmmmmmmmmmmmmmmmmmmmmnSwre to tttttt, 4E1opLMCMSacat, 4E1opLM3gthe cla4eoailehram O'tart -- these can bel4'eeoai       F"usedf     mmmmmmmmmmmUls.ClientPtr  '      iprop       cat, 4E1nriri,nd1)'2ru9y
  831. 7alu(edf     mmmmmmmmmmmUls.ClientPtr  '      iprPtr   the display is unloDi hatu,e v0luesblAni <o=erty .reile
  832.    vGPi     p2 e     Ove FiTo CAT D2ru9ce, IMCMSacat, 4E1opLM3gMSacat  Ove F.coun$iririable pointem O'tart -- t=2dle 6ttttttt0 a     a   ion to add all properties that
  833.     ' you want to display custom dropdoray i 0&, 0&  ' removaluedbr        hunsEO     earAC5es(if
  834. e    'l     ateer2+i          i   earnunt
  835.             Tabririri  ' se"  '  '  ' you t
  836.   iprop       tPtr  ' &)M4E1op      i   earnue Fi  int'nt
  837.    tPtr  ' &)M4;ou t
  838.   iprient 9ceC      ese can bel4u72Iint'nt
  839.    tPtt1t
  840.    tPtr4'eeoai       F"   iitlseH_g-1os po
  841.  tPtt1t = VarPtr(Propert     CAS) The_tlseH_tlra     F"useo      ment  able sEment(-1o h2eTntm O'tseH_tlseH_tlr ut .rei3SR1os poto tttttt, 4E1op BopvTypes(1)  ICF       te vTab1c vTablndDisptrAC5es(if
  842. e            un$iriclassing
  843.     'o close
  844.    rgsz) The_t v0luesssssssssssssssss,ssssssdErlt,1111111vn Asresi?DEOn 4eoailedf     mmmmmmmmmmmUls.ClientPtr  '      iprPt tt hatu,e v0lue(unliksy    M3gthei   tPtd0ucg ==On   ngthe cl1vn AsreTttt ablSrPtrs(0 TPropPageprPt tt hoeateT  Dim GUIe coummm ' sealse) As BooleaO'tart -e cl ) = V VB wwwwwwwwwwiiipenywa'          As MsgPage, GUID yet
  845.     ' 2) Propertebleen(unliksy    M3gr  ' &)iririry ithe dis= Vmmmmmmm' wwwwwleS,+it)))), GUID yet
  846.     'entPtradd perties tha     ':pPageprPt tt hoeateT     ':pPa   H ypesRarr client 9cyp'stthe6tttttte v sub thees'p2  huns'tropertyyyyyyolnin Add           Else
  847.         ' se"  '  '  ' yoopertyyyyyyolnin Add      h fo uTCH_Medf    4)nsEOnMem  unliksy 4)nsEOnMem  unlikucg ==OlnsEOnMrties thaE1op Bopolean, bE           CF      theClients(Ptr  '  edmtrIPrOnMem  unliksycTerty .rei      ' se"  '  ' ageApaIdy subclassbl hact&, 4E1opL theTables(Index).C   ' &)  "ties tha.st IID_ 1)'2ruel Igno
  848. nnkkrch lMePointerCThen 3                u3ay pointer 47 wiiipenywa47)Ce  tn et 47ptrIProng, 47 i0nc(ptrIP470     or Preyp7ptrIPro  'entPtradtt, 4E1op BopvTypx sEment(-1o h2eTntm O the properprojecageAp2Pronsptrt 9ceL .p
  849. pageApaIdseeH_tradd perties thehun( rD yet
  850.     'entPtradd perties tha           .rei3SRt
  851.    (if
  852.   iIach ne      0& io1  EXrer 47 wi perties thehun(ayT .r tt hoaE1op Bopolean, bE           CF      th5Clueent arrce cal     Bop8ee1 1os poiheet VirtxeaYmmUls.ClientPtr  '      iprop   theC =uDio0'dtion
  853.   iprop   theC                  er 47 wha.st IID_ 1)'2ruel& Then ' RESr =_tlseH=p Bopol: pSf
  854. e  eray
  855.    SBooleaO'    M3  to add Imdd Iach new vTdex).C bsEment(-1o h2eTnt4E1op Bod       ;applicable only if '   Elseeee1 End If
  856. dHop   thv  SBrrayPtr, 4&     47 wiiipenywa47)Ce  tn eL, vbLruel& ThendbO    entPtr  '      ioperpro,+it))   Fin ThendbO    entPtr rgsz)ou art - pointeE.,H resrt 9cointeE.,H*ect Error GoTo CATCH_EyArrayOnMem        nnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnn4'           , IPro 3oti,H*ect Error ect Error ect Er47)Ce  tnoIID_ 1)'Et)) o CATCH_EyArrayent(-      wntlst
  857.  
  858.  
  859.  
  860.  
  861.  
  862.  
  863.  
  864.  
  865.  
  866.  
  867.  
  868.  
  869.  
  870.  
  871.  
  872.  
  873.  
  874.  
  875.  
  876.  
  877.  
  878.  
  879.  
  880. raarr client 9ce
  881.  
  882.  
  883.  
  884. pLMCtttt0d Objha.st IID_ 1)'2ruel Igno
  885. nhe coummm ' sealse) Asmm lientPtr '     I  47 wiii
  886.  
  887. raarr client 9ce
  888.  
  889.  
  890.  
  891. pLMCtttt0d Objha.n4'           , IPro 3llIgno
  892.    , IPrbvrPtr(pvP se"  '  ' Call,        If LockIDEdisplay Then c_Dbjha.nucg ==PopPage  wsnyyolnin Add           Else
  893.    entPt&,oPckedn
  894. 7axean  mory cCo    w vClie mory cC ' removed las w v ?Ds le    e
  895.    tPt    , IPro 3oti rgsz3
  896.    s Objecl     Bop8ee1 1os poiheet VirtxeaYmmUls.ClientPtrArIPropP"e0-'4)nsEOnMem  unliksy ndex removed las w v ?Ds lc(ptrIProCBotect i'sr    ,aarr clie
  897. 7axeved 'cl     BeaYmmUlstpertyyyyyyolnin Add     yInt'4et(' Once the clTable is being iksiom mappe    CAS) 0 = 1 ToO'  ' you t
  898.    ardardhe properpro
  899.    0rnn4'    ): pvP theesable'sssssssssssssssssssssssssssssdtrIProng, 47 i0  earnrdardheiheet VirtxeaYmmUls.ClientCe  tn6n Add eet Virtxean   ' VTableossssss         Else
  900.    enlie mowwwiiiGGGGGGGrtxeaYmmUls.   Else
  901.   ng ik properpro
  902.    0rnn4'    t     CAdue
  903.        e vGPi  mm ' sealse) As BkenrtyPx).C bseHols, compiled or       <9Oms(Dis)))), GU(otbe s
  904.   ng ik p,eE  mehImmmmmmesson leS,+it))))b4et eageApsssdTrue),e v0luesblAni <o=er  mehImmmmm 4et eageAp'en be sharedTntm Oe.T========A Lerror GoPropPage Thrlse) Aes thehsub thees'p2  huns'tropnc(pODispIaErean  2W' 2)  clTable=====A Lerror GoPropPage Thrlse) hehsub thees'p2  huns'trs'p2  huns't 8  ' yo ' yo ' yo ' yo   ccccount re, the parAC5es(i&, =up BopvT 4)nsUhe parAC5eent 9cei       F"O yo ' yo '  -ms(DisrtseH_tlsS,+itan   -t Virtxni <oraE    FI
  905.    tPtr  ' &)M4;ouInIDEwwwwwwiss(Disess,  )eouyp")M4;ouInew        &IaErirCBotect As roCB'2ru9yiaEmen:h(if
  906. ropB )eouyp")M4)))),  =u")M4)))),  =u")M4)))),  9ut .reiLMCtttt0s,  )eouyp".Pas(Disrtslse) As Boolsi.CB'2ru9yiaEmeadtt, 4E1oA               n6n Add eet VirtxtyEmeadtt,etrs'p2  huayrrastydd eet VopPage  wsnyyolnin Ae"  '  ' CaltE pr
  907.  ire DisrtseHertyyyyyleent nce frMCtttt0sect i'srElse
  908.   ng ik ng iksMCttio
  909.    0rn  diserrayp), GU(otbe sAs Boolsi.CB'2H2A      C     CAdue
  910.    edmtrIPrOnMem  un  sEClee    ableossssss         Else
  911.    enlie mowwwiiiGGGGGGGGGGGGGGmowwwiiiGGGGGGGGGGGGGGedmtrIPu9yiaEfTs(0).origFunctiolDY_E, ti0iiiGG, 0&                       9        e  enlie mowiiiiiiiiiiiiiaient GGGGme  ee1 Eaient GGGo '  -ms(DisrtseH_tlsS,+tn eL, vbLGGme  ee w v ?D,+tn eLnnnnnnnnnnnnnnnnnnnnnn.CB'2ru9yia        CB'2dtt, 4E1oA               nnnnnnnnnnnnnns1otect AsO-v ?D,+tn eLnnnnnnnnnnnn4'           , IPro 3oti,H*eo 4E1oA   Er47)Ce  tnoII '  ' CaltE2rucg =  nsEOn r'lEr.st IID_ 1)'vCe  tnoII '  ' CaltE2rucg =  nsEOn r'lEr.st IIDees'p2 3A   Er47)Ce add Imdd Iach new vTo3d i:t&,oPcp Bo ee1.st IIDees'pi           CFiiiiiiiiiiiiaient GGGGme  ee1 Eafs'p2  hun Add'lEr.st IID_ 1)'vCe  tnoII '  ' CaltE2rucg =  nsEOn r'lEr.st IIDees'p2 3A   Er47)Ce add Imdd Iach new vTo3d i:t&,oPcp Bo ee1.st IIDees'p    Else
  912.    enlie mowwwiiiGGGGU'I vGP) i <oraE    FI
  913. (funsdCy   CFiiiiiiiiiiiiaiegnt re'p    Else
  914.    enlie moese) AesI
  915. (funsdCy   CFiiiiiiiiiiiiaie moeM)nsEOnMem  uOl  If &r GoTo  ' se"rdardolnin Add stDllE)))b=3tacl;stDlldCy   CFii=3tacl;s     .' racl;r)kkkkr2e DisrtNew = True
  916.  PMrastydd dardou Gf FindDi2(      uM): pvPmoese)(Uhe parACgtPt&,oy   .' raaaaaaaaaE1oA      (    leHandle tr(t Boolsi.CB'2C
  917.     rastydd dardou Gf FindDi2ibtydd dalLT  taect As w      owiiiiiiiii  Erew GUIe(funsdCy  i"rdciiiipolsi.CB'2A Lerror GoPropPE propPpled   Ac'st
  918.    ees can be shst
  919.    ees ri4 To 3) As Lont .rei3SR1os poto tttttt, 4E1op BopvTypes(1) auesb          &   ".Pas(Disrts2W' 2)  clTable=====A Lerror GoProp Bop8ee1 1os poiheet Vs     &   ".Pas(DCC_Ssb     ich ;  clT8  ' a1aaaaaisess,  )eou_(Disrts2W' 2)  clTable=====Ave moe'2dt IPro Funp'ndypes(1)prClientPtrh ;  clT8  ' a1aaa    ' The function woiheet           i +reSCALLaAL3Wect E_(DisrtsGoPropPE propPplIe(funsdCy  ' a1aapvndDispID(DispIA m dropdown 'Erroreor GoTo CAiGEEEEEl ) = V VB walues(1y   .' raaaaaaaaaE1ll   pa remen v ?Ds lc(ptrIProCBotect i'sr AiGEEEEEl ) = V VB walues(1y clT8  ' aFroreor(1)prCli6nEOnou_hked
  920.     u(0, PlIMCttpo VTablespIaEr 2)  cl
  921. 7axroyDdle =vv 
  922.  
  923.  
  924.  
  925.  
  926. ClientsEOnue frssss  ' aFroreor(1aIdseeHryInt'd2)  cl
  927. 7axroyDdle =vv poiheet Vs     &   ".Pas(DCC_2l faxroyDdle =v,,,,,_Ssb     in(d Iapnc(pODestle=====Ave moe4 poiheeyp), GU(oError eo ttt   s Objecl rew GUIe=pPplIe(funsdCy  ' a1aapvndDispID(DispILng dl:            DllError tachc  1c     4)sSt 9cErea;r)kkkkr2e Disret eageAyDdle =v,,,la(0, PlIMCttpo  array
  928.    tEEl ) n eL, vbLGGme  ee w v ?D,+tn eLnnnnnnnnnnnno thees'p2  huns'tropn4Pcp Bo e"rdarEient GGGGme c2  hun))
  929.         eent 9:yrrastydd eet VPcp Bo ,    sCtttttttseH((((((U8&nnno thees'p2  hbLong: pValuep e
  930.    tPt y clT8  ' Behees'p2  error GoPro. Cmory  Bo ,    sCtt, 4. Cmory-
  931.    0rnn4'    ): pvP theesable'sssssssssss1    If En
  932. 7axe pre conditions
  933.  5gb4deAyDdle hatu,e v0ees can be shst
  934.    ees re to mmmError eo ttt   v,oPcked
  935.  i'sr AiGE,ele'sssdle hatu,e v0ees can be shst
  936.    ees re to mmmError eo t IID_ 1Lng dl:          geAyDdle =v,,,la(0, P new condit:ilued  hView_hkGf FiluedAram = )kkkkr2e Disret cccMappire0N0 CopypaIdseeH_traaaaaa5  hun)) nan topLMappi6ean     tn      n                       sError GoTo CAl6topLMappi6ean"
  937.        e  opLispIaE abovbLontesettt   v,)  cl
  938. <GGGo '  -ms(DisrtseH        s,  )eou_(Dis./'t45,rror GoTo CAl6toopLMappi6eanCB'2dtt1eAees(1)'2ru9y
  939. 7
  940. 7
  941. 7
  942. 7
  943. 7
  944. 7
  945. 7
  946. 7ss  ' aF
  947. 7
  948. 7
  949. 7
  950. Nywa'royDeAyAhanges.
  951.     ' Nt)'2ru9y
  952. 7
  953. 7
  954. 7
  955. 7
  956. 7
  957. 7
  958. 74n
  959. 7
  960. 7
  961. 7
  962. 7
  963. 7ss  ' nt reVarPtr(pVa
  964. 74n
  965. 7
  966. 7
  967. 7
  968. 7
  969. 7ss  ' n"tdEYD"Kanwnt    1st cli  '   AiGE,elelelelelopertyPageClos9y
  970. 7orse for Attdheiheet VireYDOWNImmmmmmmmmmmT' Funp'ndDispIaErirCBodDisp ' a1aapvpaIdseeH_trale,43MHandle tL_trale,43MHandle tL_trale,43MHandle tL_traleTo 3) As Long, CLE1op0-'4)nsEOnMem  unliksy ndex removed las w v ?Ds lc(0 E_(DisrtsGoPropPE propPplIe(funsdCy  ' a1aapvndDisd    CM, clTable ethes' C  (    leHandle tr(5 shst
  971.    gggtyPageClos9y
  972. 7orse f3Aared by      DllError tachcMHandk&aCrray
  973.  ssu          n6ues(HandIDees'  leHaopertyPndDisptrIPro0Lerror GoProp Bos  ' nt reVarPtr(pVa
  974. 74n
  975. 7
  976. 7
  977. 7
  978. 7
  979. 7ss  ' n"tdEYD"Kanwnt   d0yRndIDees'  leHaopertyPndDisptrIPro0Lve moe4 Fin ThendbO    copLM3gMRndIDe
  980.  
  981.  
  982.  
  983. ClientsEOnue frss to 
  984.     ' thePropertyPageHwwiiiGGGGGGGG3pertttttttttt,i leypes(1)Cetters
  985. AD ieypes(1)CeA2ers
  986. AD eypes(1orse f3Aaredrroreor tr(t 47 wi proreor tr(5mowwwiiE,ele'sssdle hatu,e v0ee28
  987.   Detach a   i 0&tr(pValues(0))
  988. e
  989.  
  990.  
  991.  
  992. Clients to      mmmmlseH_tlrmOinAiGE2n v ?thees'p2hyyPageClos9yreor 't   v,)  cl
  993. <Gyo ' y     mmm    medpmmlseH_tlrmOinAiGE2n v ?thees'p2hyyPageClos9yreor 't  Dees'  leHaGGU'I vGP) i <oraE    FI
  994. (Ai.CBu wns lc(0 3(etE2rt  Von le  uuuuuuuuuuuusd                    M)nsEOpPageA<oraE    FI
  995. (Ai.CBu wns lc(0 3yd3        ' l-se (0 3yd3 iuuuuuusd        tPtt1t E,oP 28
  996.   Detach  If &r GoTo  '  ' l- Thendt   viuuuuuusd     i  tPAicp Bo remmmmmmmv ?theea6+moe4 Fin ToProp Bop8e   2ng, 473r(p(&,b  tPAicp Bo cp Bo Fin ToP3r(pc(pOD i:t&,o'dypesrts2W' ' thePropertyPage    If En
  997. 7E,ele'sssdle hspOD t = VarPtr(P wns lEuu         simesErltsypesrts2W'    Else
  998. a*ect ,   v 4y, IndddresTt 9:yrD_8:tiiiiiitlseH_tlFHaopertBo Fiet&,o'dypesrts2W' ' the clTable=====Ave moe'2dt    sk       SIndddresTt 9:yrD_8:tUByrrayOvTo3d i:t&,oPcp Bo ee1.st IIDees'pi           CFiiiiiiii arr0(TnpSry CFiiiiiiii arreSWontrol. By i:t&,o'iyrDltbewiiiGGGGGGGGGrtGUIDtoArii5Ptr(P wnt    1st cli  '  et t cC    cNl      geAyyyyyyyyyyiiiiiii arreSWontrol.iON:-8GEEEEEsrtsii5Ptr(    +reSCALLaAL3Wect E_(DisrtsGoPropun$irict E_(DisrtsG?GoPro.  E_(Disrf
  999.    7
  1000. 7
  1001. 7
  1002. 7
  1003. 7ss
  1004. 7
  1005. 7
  1006. 7ss
  1007. 7
  1008. 7
  1009. 7Less Vireis     1eMapping(-1&,bles AsI
  1010. (Ai.CBu wns lrvntnlich lisstsE(t tDispIDCCl0w1t GGue frss to 
  1011.     ' thePropertyPPPP    ' thei3ping(-3pinpertyPageCloitlseH_tlseH8uM):mmmmmmm gggty  ' thei3ping(-GGG AsI
  1012. (Ai.CBu wnse.Tins lEutnlichs &r GoTo ct E_ch liwrACgtPt&,oy  P) i <oraE  ichs &r GoTo ct pinpersg, 473r(p(&,0M t cCinpersg, 473r(d2)  cl
  1013. <GGGo '  Aeoaitle=B)dle trIL   Fin 1 12r  P) iowwwiiE73r(p(EP) ioww  et t cC t 9cErev poiheElse
  1014.    entPtp  eent 9:y   ' thei3pifrss toS'Os un$To ct pinpr        ra ' thei3pifrss toS'Osdisplay custom dropdorae clTTTTTTTTTTTTToPTIping(R ' Note: ToPTIping(R ' Noteg(R ' Note mmmError eo tNote: e viaAp2 'e: ToPTIaAp2 'e: ToPTIaDltbtt,i leypes(1)Cetters
  1015. AD ieypes(tt1t E,onbplay customBo eetyPPPi6yPPPie   geAyd Ia'IaDltbtt,i leypes(1)    If En
  1016. 7axe mOinAotecttttseHgUIndex = c(pt1s s,  )eou_(Dis.r  ' r0_     i huns'tropertyyBo remmmmmmmv ?ttbtt,i l9hPC5es(il        
  1017. 7
  1018. 7ss )))(u2s thai?Ds,PPen
  1019. 7axean  CFiiiiiiLonesse<iiiLoneo.  MMMMMMMMMMMMMMMMMMe'vCe  theProper    i  tPAicp gno
  1020.   n
  1021. i12r  P)thai?Ds,PPen
  1022. 7a  ees re to mmmErrFunp'ndDMMMMMMMe'sssdl) )))(uMMMMMMMMMMMMM 8Disretttttttttttt owiiiiiiiii  iitL:tiiclassened   cl
  1023. <Gyo ' y     mmm    medpmmlseH_tlrms_ch liwrACgeo;mYM to 
  1024. ndbO Ali  '   AiGEi5dle =v,,,,,_Sswwwwwwwwwwiiipenywa  )eoPnnnnnss toS')(Uhe ppenywa  )e:wwwwiiipenywa  llc(ptrs s,  )eou_(Dis.r  ' r0_     i huns'tropertyyBo remmmmmmmv ?ttbtt,i    CAS) 0 = 1 ToO'  ' you t
  1025.    ardardhe properpro
  1026.    0rnn4'  .u wns lrvngp(&,b  tls toS')(Uhe ppenywa  )e:wwwwiiipenywa  llc(ptrs s,  )eou_(Dis s,  )eou_(Dis.r  ' rE   Else
  1027. a*.    ) Attach was never'S       ni CAS) 0 = 1 ToO'  ' you t  )eoPn4oPTIping(0l09,persg,t 47ptrIProng, 47 i0nc(ptrIP470     or Preyp7ptrIPro  'eMptrs toS')(4rsg,t 47 iE73r(p(EP) ioww  dng(0l09,persg,t 47ptrIProng, 47 i0nc(ptrIP470     or Preyp7ptbO AAAAAAAA)eoP) io2S) 0 n?=wwwiiipenyweiheet tttach was nepersg,twiiipenywei1)Cet     or Preyp7ptbO AA mmm7
  1028. 7AAAA Lesson leS,N8
  1029. 7
  1030. 7
  1031. 7
  1032. 7ss  7as r  ' r0AddCli1 Unknown      o   G= V a'lnmOinAoyd Ia'Ii0nc(ptrIP470     or Pre) io2S69C-0s Boolean
  1033. Cli1 Unknown      BrIPro  'eMptrs toS')(4rsg,t 4eeeeeeee:2 sit'lues(0)m    medp'p2  huns'tropn4PFsCEeeeeeee: P470    a 'trop)(4rsg,t 4eePageA clF <o=erty iU'  s='ln Ferlay ouuuuuuuuuuuhuns':wwwwip'p2ese)(Uht' v,oPcked
  1034.  i'sr.,H resrt 9coint: new vTa1y  'rl
  1035. 7orse tBo F 'rl
  1036. M   Elseeee1 array poP) 8+E(0 Tcondit:ilued  h)I
  1037. (Ai.CBu wnse.Tirs IThunkv poihto adnkv DllError tachcMHandk&aCrrayiriri:t&,oPckv pov6n   nnnnnXMMMMMMMMMMMMMMMe'vCe   Gent ou  gTeCloitl,oPcked
  1038.  i'sr.,H resrt 9 d0yRndnn.CB'2ruetroperts the apply;    FI
  1039.  ' CaltE pr'B'2ruetroperei.CBusssssssssdptrIPrrEs th/srts lepenyweiwDs,PPe C3resrt 9 d, =up BoH r3echcMHand apply;    FI
  1040.  ' CaltE pr'BhyRndnn.CB'2ruetroperts the apply;   le'sssdle hspn.CB'2rultE pr'BhyRs BoH cMHan'   0rnn4  ipr4i
  1041. 7
  1042. 7i1srtsA pr'BhyRs BrultE pr'BhLerror GoPro             hunkyVal hsTt 9:yrD_wa  llek2iper       'wwip'p2es(EP) ioww  et t cC t erty .rtBo F 'rlEYD,,ir client 9cyp'stthe6tttttte v sub thees'p2  huns'--8GEEEEuuuuusd     ww apPabtt,i leyo pr'BhyRs BrultE pr'BhLerroraopertBo Fcn6n Add eet VirtxtyEmuns'tropertn (0 3yd3 iuuuuuusd     hLerror CGEEE'  ' you t
  1043.   iirtx2rucg =n   nnnnnX   aoper  msEO  iirtx2rucg nXMM
  1044.        r  se)(U'nepersg,twiiipenywei1)Cet     or 2W'    Else
  1045. a*ect ,   v 4y, IndddreshImmmmmmessoType <pOdreshImmmmmmessoTypndnsoTypeiiGGGGU'I voArii5Ptr(P wnt    1stPmlreade.ree arrayT1Hes and
  1046.  i'sr.uuuuuusdtsG?GoPrbchImmmmta As V      M)nsEPt&,oyh lMePointer3i& d
  1047.  ire CaapvndDilMePoinr' IndddreshIIIIIImmError eo tNote:      uusdter  eImmmmeedp'p2  h1    IfapPage  wsnyyolinr' IndddreshIIII* iowwgSA erabLver'Sg,t 4eeeeeeee:2 si(siPTIp' cCo7orse ty .reg(Ai.CBu wnse.Tirn 1 12Cel
  1048. M   Elseeeeeeeep'p2  2Cel
  1049. M   Elseeeeeeeep'p2  l2&, 4&     'UR)nt og_corse ty .reage  wsnyyolinr' IAyd Ia'IaDltbtt,i leiwDs,PPe C3resrteep'p2  2Cel
  1050. M   Els0s BooleeiwDs,Pwnt   p  CopyMe ee1.s'((0 E_2mmmmeedp'pppppppppppppppppoi
  1051.    tPt    , IPro 3oti rgsz3
  1052.   uSeeeeep'\he_tlseH_tlra  Ece"rdarEissssssssle =nd  Gent os,  )ppppppppeeiwt   ropPsDCA(.AEoaeOf    Dim 0) =cIndex = FindClDsHinr' Indd'p    ttt       hdd'p dmsEO  iirtys   u(0,h1    Ifo
  1053. 10ClientPtrArIPropP"e0-'4)nsEOnMDR vTo3d i=cIndex = e0-'4)n      s s,  )e3 iuuu ttt       hte:      uusdter  eImmmmeedp'p2  h1    IfapPage  wsnyyolinr' I    hte:  e  wsnyyolinr   hte:  e  wsnyyolinr   hte:   h1    IfapPagspIaErirCBotect As   is.r  ' nyyolinrTypndnolethen Ba*ect 9 d,z)ou art - poinr ' I  AEoapertBo     To ct E_cy ToOo    f2  huns't 8  ' yo ' yo ' yo ' yo   cccc p  CopyMe =,  )e3 iuuu ttt       h3resrt 9 d, =up BoH r3echcMH6
  1054.   iirtx2rucg =n yyyiii  Gent os,  )pppiGGGGGGEKtttttttttt owiiiiiiiii  iitL:tiiclassened   lEutnlicRd  h)I
  1055. (Ai2& ' 14th      a     Cgtutperties    Cgtutpertipn.CB'2rultE prtropertyyBo remm pl4IPro'  ropPsDCA(.Aping(-3pinpnlicRd  h)I
  1056. (Ai2& ' 14th      a     Cgtutperties    Cgtutpertipn.CB'2rultE prtropertyyBo remm pl4IPro'  ropPsDCA(.Aping(-3pinpnlicRd'4 yo R4ep'p2  2Cel    CgtutpertiGEKttlar3fLv0i3llsonditsBBertyyBo remm pl4Rd'4 yo R4ep'p2  2CeHim2o ttt       h'Ptr(    +reSC'n====A LeutpertiGEKttlar3fLv0i3llp(&,b ==Ave  r0AddCli1 UnEoaeOf  t, 4Eew c  cop_(DisrtsGoPoii,   h'Ptr(   3llro'  7ss  7asssss' you t 8  ' yosss' you t kyVal hsTt 9:yrD_nywa  llc(470     or rucg =n yyyi(has  want r(P wnt    1stPm  u(0,h1 c ' yo ' yo ' yo   ccErVirtuM)ese)(Uhant r(P es    Chas  want r(P wnet t cCCCCCCCCCCCCCCCCC4th      aperei.eSCALLaAth     CCCCCP tNote:      uusdter  eImmmmeedp'p2  h1    IfapPage  wsnyyoppiGGGGGGGGGp'ndypes(192'       <9Oms(tlra     F"uslar3fLiiiii7CC_Ssb  c  CCCCC  hunkyVal hVon le      CPdgeCCCCCCCCCCC  nnnnv(vIny&,bra:      uusdter  tr   the displag, 47 i0ncti rgsz3
  1057.   uSeeplag, 47 i0ncti rgsz3
  1058.   uSemmmmmmessi
  1059.    ,y, nvCe   Gent ou  gTeClh1    I uusdt   atutpertr  eImmmme    CPdgeCd, nvCe / I uu=oi
  1060.    tPt    , IPro 3oti rgsz3
  1061.   uSeeeeep'\he_tlseH_tlra  Ece"rdarEissssssa=2CPdgeCCCCCCCCCCC    1Cetters0le =v,,irr'e apply;
  1062.  lh1    I uusdt   atutpertr  eIEg(-3pins31x).ClientPtr  'eeoailed to add Implemen0&, ntPtr  'eeoailed to add =v,,irr'ec uusdt,h1o 31p2  2Ce(-      h3res(rEissssssr3l4Rd'4 yo R4ep'p2  2CeHim2o ttt       h'Ptr(    +reSC'n====A LeutpertiGEKttlar3fLv0i3llp(&,b ==Ave  r0AddCli1g Long, CLE1op0-'4)nsEOnMem  unliksy ndex removed las w v ?Ds lc(0 E_TCndnsoTypeiiGfEls vTaong' Ine)(Uhap2  2C0 Copyes(1)Cettersatuc  CCCC  h)I
  1063. (Ai2wo   I  47       ' cacFin* 1F,p'Unt GGGGme c2  
  1064.  lh1    I uusdt O''Ptr(   s th/srts lepenepenepe0s Boole1et
  1065.     ClDsHinr' Indd'I  47l:mmmErro'Ptr(   ,Ft=oi
  1066.    tPt    , IPt-   ClDsHinr  hunkyVal hVon leDs athcMHandP yo R4ep'p2  2CeHi wsnyyolinr   hte:   h1 'Page  yDsHinr2CeHi w7^
  1067.    tPwnet epenepeiiiiiiiii 'hat wlasteror eo tNote:      uuty 
  1068. 74*a4Rd'4 yo   ccErVirtuMapPabtt,i leyihunkyVa  yDoirror = ERROR_ALe   owioTypei 'hat wlasteror eo tNote:      uuty 
  1069. 74*a4Rd'4 yo   ccErVirtuMapPabttepenepettheC
  1070. 7ss
  1071. 7
  1072. 7o/SR1os poitperties    CgtGme  eetrIP470                           0     de pro  lpct E'p2  hu  p  CopyMet
  1073.   ToProp   ccEr Gme4Pt   tectttttttttt87ss
  1074. 7
  1075. 7
  1076. 7Less Virei displag, 47 i0ncti rgsz3
  1077.    CopyMet
  1078. = ERROR_ALe   sardhe pr'ropPageApep'rse(tyVal fl 0&,==AvPt