Grid Custom Control Project - Converting It To COM

[Frederick J. Harris]

Code: [Select]

Entering fnWndProc_OnCreate()
  Entering DllGetClassObjectImpl()
    Entering IClassFactory_QueryInterface()
      Entering IClassFactory_AddRef()
        g_lObjs =  1
      Leaving IClassFactory_AddRef()
      this =  2693828
    Leaving IClassFactory_QueryInterface()
    IClassFactory_QueryInterface() For iid Succeeded!
  Leaving DllGetClassObjectImpl()

  Entering IClassFactory_CreateInstance()
    pGrid                      =  5504200
    Varptr(@pGrid.lpIGridVtbl) =  5504200
    Varptr(@pGrid.lpICPCVtbl)  =  5504204
    Varptr(@pGrid.lpICPVtbl)   =  5504208
    @pGrid.pISink              =  5499216
    @ppv                       =  0  << Before QueryInterface() Call
    Entering IGrid_QueryInterface()
      Trying To Get IFHGrid
      Entering IGrid_AddRef()
        @pGrid.m_cRef =  0  << Before
        @pGrid.m_cRef =  1  << After
      Leaving IGrid_AddRef()
      this =  5504200
    Leaving IGrid_QueryInterface()
    @ppv                       =  5504200  << After QueryInterface() Call
    Entering Initialize() -- Initialize()
      GetModuleHandle()        =  2621440
    Leaving Initialize()
  Leaving IClassFactory_CreateInstance()

  Entering IGrid_AddRef()
    @pGrid.m_cRef =  1  << Before
    @pGrid.m_cRef =  2  << After
  Leaving IGrid_AddRef()

  Entering IGrid_Release()
    @pGrid.m_cRef =  2  << Before
    @pGrid.m_cRef =  1  << After
  Leaving IGrid_Release()

  Entering IClassFactory_Release()
    g_lObjs =  1
  Leaving IClassFactory_Release()

  Entering IGrid_QueryInterface()
    Trying To Get IFHGrid
    Entering IGrid_AddRef()
      @pGrid.m_cRef =  1  << Before
      @pGrid.m_cRef =  2  << After
    Leaving IGrid_AddRef()
    this =  5504200
  Leaving IGrid_QueryInterface()

  Entering IGrid_Release()
    @pGrid.m_cRef =  2  << Before
    @pGrid.m_cRef =  1  << After
  Leaving IGrid_Release()

  pVnt =  5499240

  Entering IGrid_QueryInterface()
    Looking For Something I Ain't Got!
  Leaving IGrid_QueryInterface()

  Entering IGrid_QueryInterface()                 'Here is where PowerBASIC is doing an AddRef() on the
    Trying To Get IUnknown                        'copy operation it just saw being done when the pGrid
    Entering IGrid_AddRef()                       'pointer was stored in the Variant!
      @pGrid.m_cRef =  1  << Before
      @pGrid.m_cRef =  2  << After
    Leaving IGrid_AddRef()
    this =  5504200
  Leaving IGrid_QueryInterface()

  Entering IGrid_CreateGrid()
    this           =  5504200
    hContainer     =  2294940
    strSetup       =  120:Column 1:^,130:Column 2:^,140:Column 3:^,150:Column 4:^,160:Column 5:^
    x              =  10
    y              =  10
    cx             =  570
    cy             =  222
    iRows          =  25
    iCols          =  5
    iRowHt         =  20
    strFontName    =
    GetLastError() =  0
    hGrid          =  2622038
    pGridData      =  4340256
  Leaving IGrid_CreateGrid()

  Entering IGrid_QueryInterface()
    Trying To Get IConnectionPointContainer
    this =  5504200
    Entering IConnectionPointContainer_AddRef()
      @pGrid.m_cRef =  2  << Before
      @pGrid.m_cRef =  3  << After
    Leaving IConnectionPointContainer_AddRef()
    this =  5504204
  Leaving IGrid_QueryInterface()

  pVnt =  4345408

  Entering IConnectionPointContainer_QueryInterface()
    Looking For Something I Ain't Got!
  Leaving IConnectionPointContainer_QueryInterface()

  Entering IConnectionPointContainer_QueryInterface()         'Here is the next AddRef() PowerBASIC is doing
    Looking For IID_IUnknown                                  'on your or my behalf when it catches us
    Entering IGrid_AddRef()                                   'copying pConnectionPointContainer to
      @pGrid.m_cRef =  3  << Before                           'a variant.  Note at this point we have a
      @pGrid.m_cRef =  4  << After                            'reference count of 4.
    Leaving IGrid_AddRef()
  Leaving IConnectionPointContainer_QueryInterface()

  Entering IConnectionPointContainer_FindConnectionPoint()
    this  =  5504204
    @ppCP =  0
    Entering IConnectionPointContainer_QueryInterface()
      Looking For IID_IConnectionPoint
      Entering IConnectionPoint_AddRef()
        @pGrid.m_cRef =  4  << Before
        @pGrid.m_cRef =  5  << After
      Leaving IConnectionPoint_AddRef()
    Leaving IConnectionPointContainer_QueryInterface()
    @ppCP =  5504208
  Leaving IConnectionPointContainer_FindConnectionPoint()

  pVnt =  4345432

  Entering IConnectionPoint_QueryInterface()
    Looking For Something I Ain't Got!
  Leaving IConnectionPoint_QueryInterface()

  Entering IConnectionPoint_QueryInterface()                   'Now PowerBASIC catches us storing
    Entering IGrid_AddRef()                                    'pConnectionPointContainer in a variant, and
      @pGrid.m_cRef =  5  << Before                            'that drives the reference count up to 6!
      @pGrid.m_cRef =  6  << After
    Leaving IGrid_AddRef()
    Looking For IID_IUnknown
  Leaving IConnectionPoint_QueryInterface()

  Objptr(pSink) =  4338092

  Entering IConnectionPoint_Advise()!  Grab Your Hardhat And Hang On Tight!
    this               =  5504208
    pGrid              =  5504200
    @pGrid.hControl    =  2622038
    pUnkSink           =  4338092
    Vtbl               =  2111209
    @Vtbl[0]           =  2119368
    dwPtr              =  4338092
    Call Dword Succeeded!
    0     5499216     0  Found Open Slot!
    Will Be Able To Store Connection Point!
  Leaving IConnectionPoint_Advise() And Still In One Piece!

  dwCookie      =  0
Leaving fnWndProc_OnCreate()


Entering IGrid_Release()                                   'Here's the really interesting part! 
  @pGrid.m_cRef =  6  << Before                            'At the exact point fnWndProc_OnCreate() exits,
  @pGrid.m_cRef =  5  << After                             'the reference count was driven up to 6 due
Leaving IGrid_Release()                                    'to the three AddRef()s PowerBASIC did on the
                                                           'three interface pointers, i.e., pGrid,
Entering IConnectionPoint_Release()                        'pConnectionPointContainer, and pConnectionPoint.
  @pGrid.m_cRef =  5    << Before                          'Because these three interface pointers were
  @pGrid.m_cRef =  4    << After                           'locals, PowerBASIC, in its effort to prevent
Leaving IConnectionPoint_Release()                         'memory leaks, will call Release() on each of
                                                           'these three variables.  That will reduce the
Entering IConnectionPointContainer_Release()               'reference count back to the 3 it was after the
  @pGrid.m_cRef =  4  << Before                            'C++ program I posted above without all this
  @pGrid.m_cRef =  3  << After                             'reference counting hokus - pokus!  Has it begun
Leaving IConnectionPointContainer_Release()                'to dawn on you yet the concept of 'Reference
                                                           'Counting Optimazation?'

Got WM_LBUTTONDOWN In Grid Cell From CGridEvents1(3,2)
Got KeyDown From CGridEvents1! 46=.
Got KeyDown From CGridEvents1! 46=.
Got KeyDown From CGridEvents1! 46=.
Got KeyDown From CGridEvents1! 46=.
Got KeyDown From CGridEvents1! 46=.
Got KeyDown From CGridEvents1! 70=F
Got KeyPress From CGridEvents1! 102=f
Got KeyDown From CGridEvents1! 82=R
Got KeyPress From CGridEvents1! 114=r
Got KeyDown From CGridEvents1! 69=E
Got KeyPress From CGridEvents1! 101=e
Got KeyDown From CGridEvents1! 68=D
Got KeyPress From CGridEvents1! 100=d


Entering fnWndProc_OnCommand()              'Here you can see where PowerBASIC drove the reference count up
  Case %IDC_RETRIEVE                        'to 4 again when it retrieved the Variant Ptr from instance
  Entering IGrid_QueryInterface()           'memory, and assigned the interface pointer in it to pGrid so
    Trying To Get IFHGrid                   'it could be used to reference the grid methods.
    Entering IGrid_AddRef()
      @pGrid.m_cRef =  3  << Before
      @pGrid.m_cRef =  4  << After
    Leaving IGrid_AddRef()
    this =  5504200
  Leaving IGrid_QueryInterface()
  Cell 3,2 Contains fred
Leaving fnWndProc_OnCommand()

Entering IGrid_Release()                    'And then here you can see where PowerBASIC called Release() on
  @pGrid.m_cRef =  4  << Before             'the local pGrid object when the procedure exited and it cleaned
  @pGrid.m_cRef =  3  << After              'up its stack.
Leaving IGrid_Release()


Entering fnWndProc_OnCommand()
  Case %IDC_UNLOAD_GRID
  Entering DestroyGrid()                    'Finally, this code shows again how the reference count
    pVnt =  4345432                         'continually bounced from 3 to 4 and back down to 3 after
                                            'each assignment and release of the pointers from variant
    Entering IGrid_QueryInterface()         'memory.  It was only after this WM_COMMAND message ends
      Trying To Get IConnectionPoint        'that the three releases caused the reference count to fall
      this =  5504200                       'to zero and the object itself and the dll to be released.
      Entering IConnectionPoint_AddRef()
        @pGrid.m_cRef =  3  << Before
        @pGrid.m_cRef =  4  << After
      Leaving IConnectionPoint_AddRef()
      this =  5504208
    Leaving IGrid_QueryInterface()

    Entering IConnectionPoint_Unadvise()
      this            =  5504208
      dwCookie        =  0
      @pGrid.hWndCtrl =  2622038
      dwPtr           =  4338092
      IGrid_Events::Release() Succeeded!
      Release() Returned  1
    Leaving IConnectionPoint_Unadvise()

    hr =  0

    Entering IConnectionPoint_Release()
      @pGrid.m_cRef =  4    << Before
      @pGrid.m_cRef =  3    << After
    Leaving IConnectionPoint_Release()

    iCnt =  3
    pVnt =  4345408

    Entering IGrid_QueryInterface()
      Trying To Get IConnectionPointContainer
      this =  5504200
      Entering IConnectionPointContainer_AddRef()
        @pGrid.m_cRef =  3  << Before
        @pGrid.m_cRef =  4  << After
      Leaving IConnectionPointContainer_AddRef()
      this =  5504204
    Leaving IGrid_QueryInterface()

    Entering IConnectionPointContainer_Release()
      @pGrid.m_cRef =  4  << Before
      @pGrid.m_cRef =  3  << After
    Leaving IConnectionPointContainer_Release()

    iCnt =  0
    pVnt =  5499240

    Entering IGrid_QueryInterface()
      Trying To Get IFHGrid
      Entering IGrid_AddRef()
        @pGrid.m_cRef =  3  << Before
        @pGrid.m_cRef =  4  << After
      Leaving IGrid_AddRef()
      this =  5504200
    Leaving IGrid_QueryInterface()

    Entering IGrid_Release()
      @pGrid.m_cRef =  4  << Before
      @pGrid.m_cRef =  3  << After
    Leaving IGrid_Release()

    iCnt =  3
  Leaving DestroyGrid()

  Entering IGrid_Release()                           'These three Release() calls triggered by exit of
    @pGrid.m_cRef =  3  << Before                    'the DestroyGrid() routine is what finally causes
    @pGrid.m_cRef =  2  << After                     'the grid to be destroyed due to the bizarre series
  Leaving IGrid_Release()                            'of AddRef()/Release() calls involving interface
                                                     'pointer copy operations.
  Entering IConnectionPoint_Release()
    @pGrid.m_cRef =  2    << Before
    @pGrid.m_cRef =  1    << After
  Leaving IConnectionPoint_Release()

  Entering IConnectionPointContainer_Release()
    @pGrid.m_cRef =  1  << Before
    0     5499216     0
    1     5499220     0
    2     5499224     0
    3     5499228     0
    @pGrid.m_cRef = 0 And Will Now Delete pGrid!
  Leaving IConnectionPointContainer_Release()
Leaving fnWndProc_OnCommand()


Entering fnWndProc_OnDestroy()
  Entering DestroyGrid()
    pVnt =  0
    pConnectionPoint Was Already Released!
    pVnt =  0
    pConnectionPointContainer Was Already Released!
    pVnt =  0
    pGrid Was Already Released!
  Leaving DestroyGrid()

  Entering DllCanUnloadNow()                          'The client calls CoFreeUnusedLibraries() and
    I'm Outta Here! (dll is unloaded)                 'if there is no lock count or object count the
  Leaving DllCanUnloadNow()                           'COM Dll will be released from memory.
Leaving fnWndProc_OnDestroy()

     After suffering through all those complications, I can well imagine that you've come to the conclusion that you'll just live with global variables for all your COM objects!  There is an easier way, however.  You might wonder why I didn't show you the easier way, then, rather than having you suffer through all those memory allocations, reference counting complications, so on and so forth.  Well, I did that so as to make you realize the nature of the underlying complications involving reference counting.  And using the above technique you really didn't have to do much of it on your own; PowerBASIC was recognizing fully what you were doing at all times, and it was handling it for you.  The only three Release() calls you needed to make were the three at the end to 'undue' the three reference counts you picked up in the WM_CREATE handler in creating the object and setting up the connection point.  If there is such a thing as the 'approved' PowerBASIC way of eliminating globals what I showed you using Variants is likely it.  What I'll show you now is the 'unapproved' but easier way of doing it.  What it will save you is having to allocate memory and use pointers to store the interface pointers in Variants.  And of course, since you won't be allocating GlobalAlloc() memory, you won't have to worry about releasing that.  The thing you will have to do yourself though using this new technique is take care of all the reference counting yourself using AddRef() and Release(), because we're completely 'going behind PowerBASIC's back', so to speak, and this is the 'unapproved' way of doing it.  Nonetheless it works.

     I didn't come up with this technique myself.  I had an interesting exchange with Steven Pringels over in the PowerBASIC Forums about it, and he is the one showed it to me.  However, he stated he got it from either Edwin Knoppert or Jose Roca. 

     If you followed my discussions above you should have picked up on the fact that the whole problem in leaving interface pointers go out of scope is that you are going to have excruciating difficulties in restoring them into an object variable even if you saved them.  Related to that is the need to keep the object alive by not allowing its reference count to fall to zero, which condition would likely cause the object to be released, invalidating any pointers to the now dead object which you might have saved somewhere.  The whole point of using the Variant approach was that PowerBASIC apparently worked out the code for whatever reason (likely to support object parameters) to support transfer of interface pointers into and out of variants. 

     This new method is based on the idea that we'll simply allocate a local object pointer and copy the address of the the existing and still valid pointer which we've retrieved from window instance memory into the local variable ourselves using Poke or some other memory copy operation. We'll do this because the PowerBASIC compiler simply refuses to allow a simple assignment - no matter how valid it is.  Once we get the local initialized - behind PowerBASIC's back, so to speak, we'll have to take care of the reference counting ourselves.  The end result though, even considering the AddRef() and Release() calls we'll now have to make, is less code.  Here is how the technique will now look in WM_CREATE...

Code: [Select]

Let pGrid = NewCom "FHGrid4.Grid"             'Create object and get object reference in pGrid   
Call SetWindowLong(Wea.hWnd,0,Objptr(pGrid))  'Assign object reference to window instance memory
pGrid.AddRef()                                'Interface copied - so AddRef() it ourselves

Then, when you need to reinstate the interface pointer for use in some procedure such as where my program accesses Cell 3, 2 in the grid, do this...

Code: [Select]

Local strData As BStr
Local pGrid As IGrid
Local dwPtr As Dword

dwPtr=GetWindowLong(Wea.hWnd,0)           'Get pointer to Grid in dwPtr saved in .cbWndExtra bytes
Poke Dword, pGrid, dwPtr                  'PowerBASIC won't allow an assign to pGrid so we have to
Call pGrid.AddRef()                       'Poke it in ourselves!
pGrid.FlushData()                         
strData=pGrid.GetData(3,2)               
MsgBox("Cell 3,2 Contains " & strData)

That Poke Dword thing reminds me of a need for another PowerBASIC conversion function to add to its existing complement of such things as CInt, CLng, CSng, etc.  This new one would be CObj though, i.e., convert an interface pointer address into an object reference, kind of the reverse of Objptr().  Since I don't see one I made my own with a macro...

Macro  CObj(pUnk, dwAddr) = Poke Dword, Varptr(pUnk), dwAddr

So the above code could be this instead...

Code: [Select]

Local strData As BStr
Local pGrid As IGrid
Local dwPtr As Dword

dwPtr=GetWindowLong(Wea.hWnd,0)           'Get pointer to Grid in dwPtr saved in .cbWndExtra bytes
CObj(pGrid, dwPtr)                        'PowerBASIC won't allow an assign to pGrid, so 'Poke'
pGrid.FlushData()                         'it in ourselves!
strData=pGrid.GetData(3,2)               
MsgBox("Cell 3,2 Contains " & strData)


     Here is the whole program implementing this with a commented out debug version after...

[Frederick J. Harris]

Code: [Select]

'PBClient9_v4.bas         Uses Jose's Includes And PBWin 10.02
#Compile                  Exe  "PBClient9_v4.exe"
#Dim                      All
%UNICODE                  = 1                           
#If %Def(%UNICODE)
    Macro ZStr            = WStringz
    Macro BStr            = WString
    %SIZEOF_CHAR          = 2
#Else
    Macro ZStr            = Asciiz
    Macro BStr            = String
    %SIZEOF_CHAR          = 1
#EndIf
$CLSID_FHGrid             = GUID$("{20000000-0000-0000-0000-000000000070}")
$IID_IFHGrid              = GUID$("{20000000-0000-0000-0000-000000000071}")
$IID_IGridEvents          = GUID$("{20000000-0000-0000-0000-000000000072}")
%IDC_RETRIEVE             = 1500
%IDC_UNLOAD_GRID          = 1505
#Include                  "Windows.inc"
#Include                  "ObjBase.inc"

Type WndEventArgs                                                              'This program shows what's likely the best and easiest way
  wParam                  As Long                                              'to eliminate global object variales from your program.
  lParam                  As Long                                              'What we're doing here, instead of allocating a variant
  hWnd                    As Dword                                             'dynamically like in PBClient4_v4.bas, is to just directly
  hInst                   As Dword                                             'store the object's address in .cbWndExtra bytes.  We then
End Type                                                                       'need to do our own AddRef() on the pointer to prevent it
                                                                               'from going out of scope, but at least we save ourselves a
Declare Function FnPtr(wea As WndEventArgs) As Long                            'memory allocation.  Then we need to get real tricky when
                                                                               'we want to use that address in some other procedure.  I
Type MessageHandler                                                            'learned of this technique from Steven Pringels, and he
  wMessage                As Long                                              'attributed it to either Jose Roca or Edwin Knoppert.
  dwFnPtr                 As Dword                                             'It works quite
End Type                                                                       'well.  What you need to do when you extract the interface
                                                                               'pointer's address from .cbWndExtra bytes or Window Properties
Global MsgHdlr()          As MessageHandler                                    'is use Poke Dword to Poke the Address into a locally
Macro  CObj(pUnk, dwAddr) = Poke Dword, Varptr(pUnk), dwAddr                   'allocated object variable.  Or, look at my Macro CObj() <<
                                                                               'just left!  That's really underhanded, isn't it?  I bet
                                                                               'stuff like that is just about enough to give Mr. Zale an
Interface IGrid $IID_IFHGrid : Inherit IAutomation                             'ulcer!
  Method CreateGrid _
  ( _
    Byval hParent     As Long, _
    Byval strSetup    As WString, _
    Byval x           As Long, _
    Byval y           As Long, _
    Byval cx          As Long, _
    Byval cy          As Long, _
    Byval iRows       As Long, _
    Byval iCols       As Long, _
    Byval iRowHt      As Long, _
    Byval strFontName As WString, _
    Byval iFontSize   As Long, _
    Byval iFontWeight As Long _
  )
  Method SetRowCount(Byval iRowCount As Long, Byval blnForce As Long)
  Method SetData(Byval iRow As Long, Byval iCol As Long, Byval strData As WString)
  Method GetData(Byval iRow As Long, Byval iCol As Long) As WString
  Method FlushData()
  Method Refresh()
  Method GetCtrlId() As Long
  Method GethGrid() As Long
End Interface


Class CGridEvents  As Event
  Interface IGridEvents $IID_IGridEvents : Inherit IAutomation
    Method Grid_OnKeyPress(Byval iKeyCode As Long, Byval iKeyData As Long, Byval iCellRow As Long, Byval iGridRow As Long, Byval iCol As Long)
      'Prnt "Got KeyPress From CGridEvents1!" & Str$(iKeyCode) & "=" & Chr$(iKeyCode)
    End Method
    Method Grid_OnKeyDown(Byval KeyCode As Long, Byval iKeyData As Long, Byval iCellRow As Long, Byval iGridRow As Long, Byval iCol As Long)
      'Prnt "Got KeyDown From CGridEvents1!" & Str$(KeyCode) & "=" & Chr$(KeyCode)
    End Method
    Method Grid_OnLButtonDown(Byval iCellRow As Long, Byval iGridRow As Long, Byval iCol As Long)
      'Prnt "Got WM_LBUTTONDOWN In Grid Cell From CGridEvents1" & "(" & Trim$(Str$(iGridRow)) & "," & Trim$(Str$(iCol)) & ")"
    End Method
    Method Grid_OnLButtonDblClk(Byval iCellRow As Long, Byval iGridRow As Long, Byval iCol As Long)
      ' Insert your code here
    End Method
    Method Grid_OnPaste(Byval iCellRow As Long, Byval iGridRow As Long, Byval iCol As Long)
      ' Insert your code here
    End Method
    Method Grid_OnVButtonClick(Byval iCellRow As Long, Byval iGridRow As Long)
      MsgBox("You Clicked For Row #" & Str$(iGridRow) & " And This Courtesy CGridEvents1!")
    End Method
  End Interface
End Class


Function fnWndProc_OnCreate(Wea As WndEventArgs) As Long                                             'What's Stored Where
  Local pConnectionPointContainer As IConnectionPointContainer               
  Local pConnectionPoint As IConnectionPoint                                   'Offset      Item
  Local pCreateStruct As CREATESTRUCT Ptr                                      '====================================================================
  Local strSetup,strCoordinate As BStr                                         '0  -  3     IGrid Ptr                     - pGrid
  Local pSink As IGridEvents                                                   '4  -  7     IConnectionPoint Ptr          - pConnectionPoint
  Local EventGuid As Guid                                                      '8  - 11     IConnectionPointContainer Ptr - pConnectionPointContainer
  Local dwCookie As Dword                                                      '12 - 15     Connection Cookie             - dwCookie
  Local pGrid As IGrid
  Local hCtl As Dword
  Register i As Long
  Register j As Long

  pCreateStruct=wea.lParam : wea.hInst=@pCreateStruct.hInstance                'Create object with PB's NewCom() and immediately store it in
  Let pGrid = NewCom "FHGrid4.Grid"                                            'instance Window Class memory with ObjPtr().  ObjPtr() returns
  Call SetWindowLong(Wea.hWnd,0,Objptr(pGrid))                                 'the address of a pointer to an interface.  For IGrid Ptr pGrid
  pGrid.AddRef()                                                               'lets stick it at offset zero.  We then absolutely need to do
  strSetup= _                                                                  'an AddRef() on pGrid because when this procedure exits Power-
  "120:Column 1:^,130:Column 2:^,140:Column 3:^,150:Column 4:^,160:Column 5:^" 'BASIC is going to clean up the stack and call Release() on the
  pGrid.CreateGrid(Wea.hWnd,strSetup,10,10,570,222,25,5,20,"",18,%FW_DONTCARE) 'Local pGrid as IGrid Ptr.  If the reference count on such an
  pConnectionPointContainer = pGrid                                            'object would only be '1', that Release() would decrement the
  Call SetWindowLong(Wea.hWnd,8,Objptr(pConnectionPointContainer))             'reference count to zero and the object would automatically
  pConnectionPointContainer.AddRef()                                           'delete itself.  The code for that is in the COM Server.  If
  EventGuid=$IID_IGridEvents                                                   'you're interested, look in FHGrid4.bas proc IGrid_Release().
  Call pConnectionPointContainer.FindConnectionPoint _                         'This same sequence is going to have to be repeated for all the
  ( _                                                                          'interface pointers, i.e., pConnectionPointContainer,
    Byval Varptr(EventGuid), _                                                 'and pConnectionPoint. 
    Byval Varptr(pConnectionPoint) _
  )
  Call SetWindowLong(Wea.hWnd,4,Objptr(pConnectionPoint))
  pConnectionPoint.AddRef()
  Let pSink = Class  "CGridEvents"
  Call pConnectionPoint.Advise(Byval Objptr(pSink), dwCookie)
  Call SetWindowLong(Wea.hWnd,12,dwCookie)
  For i=1 To 25
    For j=1 To 5
      strCoordinate="(" & Trim$(Str$(i)) & "," & Trim$(Str$(j)) & ")"
      pGrid.SetData(i, j, strCoordinate)
    Next j
  Next i
  pGrid.Refresh()
  hCtl=CreateWindow("button","Retrieve Cell (3,2)",%WS_CHILD Or %WS_VISIBLE,75,245,200,30,Wea.hWnd,%IDC_RETRIEVE,Wea.hInst,ByVal 0)
  hCtl=CreateWindow("button","Unload Grid",%WS_CHILD Or %WS_VISIBLE,325,245,200,30,Wea.hWnd,%IDC_UNLOAD_GRID,Wea.hInst,ByVal 0)
 
  fnWndProc_OnCreate=0
End Function


Sub DestroyGrid(Wea As WndEventArgs)                                           'Here we need to Destroy the Grid And Release() the object.
  Local pConnectionPointContainer As IConnectionPointContainer                 'We'll retrieve out pointers from within the .cbWndExtra
  Local pConnectionPoint As IConnectionPoint                                   'bytes of instance Window Class memory and do whatever we
  Local dwCookie,dwPtr As Dword                                                'need to do, no matter how bizarre, to get the address
  Local pGrid As IGrid                                                         'situated back in an Object Pointer that PowerBASIC is
                                                                               'willing to deal with.  My little CObj() macro uses Poke
  dwCookie=GetWindowLong(Wea.hWnd,12)                                          'Dword to do this.  The logic is exactly the same as with
  dwPtr=GetWindowLong(Wea.hWnd,4)                                              'PBClient4_v4.bas, where the sequence of AddRef() and
  If dwPtr Then                                                                'Release() calls only results in a reference count of zero
     CObj(pConnectionPoint,dwPtr)                                              'after DestroyGrid() exits, and PowerBASIC's automatic stack
     Call pConnectionPoint.AddRef()                                            'clean up releases the local object pointers.  Then the
     Call pConnectionPoint.Unadvise(dwCookie)                                  'object releases itself.
     Call pConnectionPoint.Release()
     Call SetWindowLong(Wea.hWnd,4,0)
  End If
  dwPtr=GetWindowLong(Wea.hWnd,8)
  If dwPtr Then
     CObj(pConnectionPointContainer,dwPtr)
     Call pConnectionPointContainer.AddRef()
     Call SetWindowLong(Wea.hWnd,8,0)
     Call pConnectionPointContainer.Release()
  End If
  dwPtr=GetWindowLong(Wea.hWnd,0)
  If dwPtr Then
     CObj(pGrid,dwPtr)
     Call pGrid.AddRef()
     Call SetWindowLong(Wea.hWnd,0,0)
     Call pGrid.Release()
  End If
End Sub


Function fnWndProc_OnCommand(Wea As WndEventArgs) As Long
  Local strData As BStr
  Local pGrid As IGrid
  Local dwPtr As Dword
 
  Select Case As Long Lowrd(Wea.wParam)
    Case %IDC_RETRIEVE
      dwPtr=GetWindowLong(Wea.hWnd,0)
      CObj(pGrid,dwPtr)
      Call pGrid.AddRef()
      pGrid.FlushData()
      strData=pGrid.GetData(3,2)
      MsgBox("Cell 3,2 Contains " & strData)
    Case %IDC_UNLOAD_GRID
      Call DestroyGrid(Wea)
      Call EnableWindow(GetDlgItem(Wea.hWnd,%IDC_RETRIEVE),%False)
      Call EnableWindow(GetDlgItem(Wea.hWnd,%IDC_UNLOAD_GRID),%False)
      Call InvalidateRect(Wea.hWnd,Byval %Null, %True)
  End Select
 
  fnWndProc_OnCommand=0
End Function


Function fnWndProc_OnDestroy(Wea As WndEventArgs) As Long
  Call DestroyGrid(Wea)
  Call CoFreeUnusedLibraries()
  Call PostQuitMessage(0)
  Function=0
End Function


Function fnWndProc(ByVal hWnd As Long,ByVal wMsg As Long,ByVal wParam As Long,ByVal lParam As Long) As Long
  Local wea As WndEventArgs
  Register iReturn As Long
  Register i As Long

  For i=0 To 2
    If wMsg=MsgHdlr(i).wMessage Then
       wea.hWnd=hWnd: wea.wParam=wParam: wea.lParam=lParam
       Call Dword MsgHdlr(i).dwFnPtr Using FnPtr(wea) To iReturn
       fnWndProc=iReturn
       Exit Function
    End If
  Next i

  fnWndProc=DefWindowProc(hWnd,wMsg,wParam,lParam)
End Function


Sub AttachMessageHandlers()
  ReDim MsgHdlr(2) As MessageHandler  'Associate Windows Message With Message Handlers
  MsgHdlr(0).wMessage=%WM_CREATE   :   MsgHdlr(0).dwFnPtr=CodePtr(fnWndProc_OnCreate)
  MsgHdlr(1).wMessage=%WM_COMMAND  :   MsgHdlr(1).dwFnPtr=CodePtr(fnWndProc_OnCommand)
  MsgHdlr(2).wMessage=%WM_DESTROY  :   MsgHdlr(2).dwFnPtr=CodePtr(fnWndProc_OnDestroy)
End Sub


Function WinMain(ByVal hIns As Long,ByVal hPrev As Long,ByVal lpCL As Asciiz Ptr,ByVal iShow As Long) As Long
  Local szAppName As ZStr*16
  Local wc As WndClassEx
  Local hWnd As Dword
  Local Msg As tagMsg

  szAppName="Grid Test"                           : Call AttachMessageHandlers()
  wc.lpszClassName=VarPtr(szAppName)              : wc.lpfnWndProc=CodePtr(fnWndProc)
  wc.cbClsExtra=0                                 : wc.cbWndExtra=16
  wc.style=%CS_HREDRAW Or %CS_VREDRAW             : wc.hInstance=hIns
  wc.cbSize=SizeOf(wc)                            : wc.hIcon=LoadIcon(%NULL, ByVal %IDI_APPLICATION)
  wc.hCursor=LoadCursor(%NULL, ByVal %IDC_ARROW)  : wc.hbrBackground=%COLOR_BTNFACE+1
  wc.lpszMenuName=%NULL
  Call RegisterClassEx(wc)
  hWnd=CreateWindowEx(0,szAppName,szAppName,%WS_OVERLAPPEDWINDOW,200,100,600,330,0,0,hIns,ByVal 0)
  Call ShowWindow(hWnd,iShow)
  While GetMessage(Msg,%NULL,0,0)
    TranslateMessage Msg
    DispatchMessage Msg
  Wend

  Function=msg.wParam
End Function



''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

'debug version
'#Compile                  Exe  "PBClient9_v4.exe"
'#Dim                      All
'%UNICODE                  = 1
'#If %Def(%UNICODE)
'    Macro ZStr            = WStringz
'    Macro BStr            = WString
'    %SIZEOF_CHAR          = 2
'#Else
'    Macro ZStr            = Asciiz
'    Macro BStr            = String
'    %SIZEOF_CHAR          = 1
'#EndIf
'$CLSID_FHGrid             = GUID$("{20000000-0000-0000-0000-000000000070}")
'$IID_IFHGrid              = GUID$("{20000000-0000-0000-0000-000000000071}")
'$IID_IGridEvents          = GUID$("{20000000-0000-0000-0000-000000000072}")
'%IDC_RETRIEVE             = 1500
'%IDC_UNLOAD_GRID          = 1505
'#Include                  "Windows.inc"
'#Include                  "ObjBase.inc"

'Type WndEventArgs
'  wParam                  As Long
'  lParam                  As Long
'  hWnd                    As Dword
'  hInst                   As Dword
'End Type

'Declare Function FnPtr(wea As WndEventArgs) As Long

'Type MessageHandler
'  wMessage                As Long
'  dwFnPtr                 As Dword
'End Type

'Global MsgHdlr()          As MessageHandler
'Macro  CObj(pUnk, dwAddr) = Poke Dword, Varptr(pUnk), dwAddr


'Sub Prnt(strLn As BStr)
'  Local iLen, iWritten As Long
'  Local hStdOutput As Dword
'  Local strNew As BStr
'  hStdOutput=GetStdHandle(%STD_OUTPUT_HANDLE)
'  strNew=strLn + $CrLf
'  iLen = Len(strNew)
'  WriteConsole(hStdOutput, Byval Strptr(strNew), iLen, iWritten, Byval 0)
'End Sub


'Interface IGrid $IID_IFHGrid : Inherit IAutomation
'  Method CreateGrid _
'  ( _
'    Byval hParent     As Long, _
'    Byval strSetup    As WString, _
'    Byval x           As Long, _
'    Byval y           As Long, _
'    Byval cx          As Long, _
'    Byval cy          As Long, _
'    Byval iRows       As Long, _
'    Byval iCols       As Long, _
'    Byval iRowHt      As Long, _
'    Byval strFontName As WString, _
'    Byval iFontSize   As Long, _
'    Byval iFontWeight As Long _
'  )
'  Method SetRowCount(Byval iRowCount As Long, Byval blnForce As Long)
'  Method SetData(Byval iRow As Long, Byval iCol As Long, Byval strData As WString)
'  Method GetData(Byval iRow As Long, Byval iCol As Long) As WString
'  Method FlushData()
'  Method Refresh()
'  Method GetCtrlId() As Long
'  Method GethGrid() As Long
'End Interface


'Class CGridEvents  As Event
'  Interface IGridEvents $IID_IGridEvents : Inherit IAutomation
'    Method Grid_OnKeyPress(Byval iKeyCode As Long, Byval iKeyData As Long, Byval iCellRow As Long, Byval iGridRow As Long, Byval iCol As Long)
'      Prnt "Got KeyPress From CGridEvents1!" & Str$(iKeyCode) & "=" & Chr$(iKeyCode)
'    End Method
'    Method Grid_OnKeyDown(Byval KeyCode As Long, Byval iKeyData As Long, Byval iCellRow As Long, Byval iGridRow As Long, Byval iCol As Long)
'      Prnt "Got KeyDown From CGridEvents1!" & Str$(KeyCode) & "=" & Chr$(KeyCode)
'    End Method
'    Method Grid_OnLButtonDown(Byval iCellRow As Long, Byval iGridRow As Long, Byval iCol As Long)
'      Prnt "Got WM_LBUTTONDOWN In Grid Cell From CGridEvents1" & "(" & Trim$(Str$(iGridRow)) & "," & Trim$(Str$(iCol)) & ")"
'    End Method
'    Method Grid_OnLButtonDblClk(Byval iCellRow As Long, Byval iGridRow As Long, Byval iCol As Long)
'      ' Insert your code here
'    End Method
'    Method Grid_OnPaste(Byval iCellRow As Long, Byval iGridRow As Long, Byval iCol As Long)
'      ' Insert your code here
'    End Method
'    Method Grid_OnVButtonClick(Byval iCellRow As Long, Byval iGridRow As Long)
'      Prnt "You Clicked For Row #" & Str$(iGridRow) & " And This Courtesy CGridEvents1!"
'    End Method
'  End Interface
'End Class

''What's Stored Where

''Offset      Item
''=====================================================================
''0  -  3     IGrid Ptr                     - pGrid
''4  -  7     IConnectionPoint Ptr          - pConnectionPoint
''8  - 11     IConnectionPointContainer Ptr - pConnectionPointContainer
''12 - 15     Connection Cookie             - dwCookie

'Function fnWndProc_OnCreate(Wea As WndEventArgs) As Long
'  Local pConnectionPointContainer As IConnectionPointContainer
'  Local pConnectionPoint As IConnectionPoint
'  Local pCreateStruct As CREATESTRUCT Ptr
'  Local strSetup,strCoordinate As BStr
'  Local pSink As IGridEvents
'  Local EventGuid As Guid
'  Local dwCookie As Dword
'  Local pGrid As IGrid
'  Local hCtl As Dword
'  Register i As Long
'  Register j As Long

'  Call AllocConsole()
'  Prnt "Entering fnWndProc_OnCreate()"
'  pCreateStruct=wea.lParam : wea.hInst=@pCreateStruct.hInstance
'  Let pGrid = NewCom "FHGrid4.Grid"
'  Prnt "  Objptr(pGrid) = " & Str$(Objptr(pGrid))
'  Call SetWindowLong(Wea.hWnd,0,Objptr(pGrid))
'  pGrid.AddRef()
'  strSetup="120:Column 1:^,130:Column 2:^,140:Column 3:^,150:Column 4:^,160:Column 5:^"
'  pGrid.CreateGrid(Wea.hWnd, strSetup, 10, 10, 570, 222, 25, 5, 20, "", 18, %FW_DONTCARE)
'  pConnectionPointContainer = pGrid
'  Call SetWindowLong(Wea.hWnd,8,Objptr(pConnectionPointContainer))
'  pConnectionPointContainer.AddRef()
'  EventGuid=$IID_IGridEvents
'  Call pConnectionPointContainer.FindConnectionPoint(Byval Varptr(EventGuid), Byval Varptr(pConnectionPoint))
'  Call SetWindowLong(Wea.hWnd,4,Objptr(pConnectionPoint))
'  pConnectionPoint.AddRef()
'  Let pSink = Class  "CGridEvents"
'  Prnt "  Objptr(pSink) = " & Str$(Objptr(pSink))
'  Call pConnectionPoint.Advise(Byval Objptr(pSink), dwCookie)
'  Prnt "  dwCookie      = " & Str$(dwCookie)
'  Call SetWindowLong(Wea.hWnd,12,dwCookie)
'  For i=1 To 25
'    For j=1 To 5
'      strCoordinate="(" & Trim$(Str$(i)) & "," & Trim$(Str$(j)) & ")"
'      pGrid.SetData(i, j, strCoordinate)
'    Next j
'  Next i
'  pGrid.Refresh()
'  hCtl=CreateWindow("button","Retrieve Cell (3,2)",%WS_CHILD Or %WS_VISIBLE,75,245,200,30,Wea.hWnd,%IDC_RETRIEVE,Wea.hInst,ByVal 0)
'  hCtl=CreateWindow("button","Unload Grid",%WS_CHILD Or %WS_VISIBLE,325,245,200,30,Wea.hWnd,%IDC_UNLOAD_GRID,Wea.hInst,ByVal 0)
'  Prnt "Leaving fnWndProc_OnCreate()"

'  fnWndProc_OnCreate=0
'End Function


'Sub DestroyGrid(Wea As WndEventArgs)
'  Local pConnectionPointContainer As IConnectionPointContainer
'  Local pConnectionPoint As IConnectionPoint
'  Local dwCookie,dwPtr As Dword
'  Local hr,iCnt As Long
'  Local pGrid As IGrid

'  Prnt "  Entering DestroyGrid()"
'  dwCookie=GetWindowLong(Wea.hWnd,12)


'  dwPtr=GetWindowLong(Wea.hWnd,4)
'  Prnt "    dwPtr = " & Str$(dwPtr)
'  If dwPtr Then
'     CObj(pConnectionPoint,dwPtr)
'     Call pConnectionPoint.AddRef() To iCnt
'     Prnt "    iCnt = " & Str$(iCnt)
'     Call pConnectionPoint.Unadvise(dwCookie) To hr
'     Prnt "    hr = " & Str$(hr)
'     Call pConnectionPoint.Release() To iCnt
'     Prnt "    iCnt = " & Str$(iCnt)
'     Call SetWindowLong(Wea.hWnd,4,0)
'  Else
'     Prnt "    pConnectionPoint Was Already Released!"
'  End If

'  dwPtr=GetWindowLong(Wea.hWnd,8)
'  Prnt "    dwPtr = " & Str$(dwPtr)
'  If dwPtr Then
'     CObj(pConnectionPointContainer,dwPtr)
'     Call pConnectionPointContainer.AddRef() To iCnt
'     Prnt "    iCnt = " & Str$(iCnt)
'     Call SetWindowLong(Wea.hWnd,8,0)
'     Call pConnectionPointContainer.Release() To iCnt
'     Prnt "    iCnt = " & Str$(iCnt)
'  Else
'     Prnt "    pConnectionPointContainer Was Already Released!"
'  End If


'  dwPtr=GetWindowLong(Wea.hWnd,0)
'  Prnt "    dwPtr = " & Str$(dwPtr)
'  If dwPtr Then
'     CObj(pGrid,dwPtr)
'     Call pGrid.AddRef() To iCnt
'     Prnt "    iCnt = " & Str$(iCnt)
'     Call SetWindowLong(Wea.hWnd,0,0)
'     Call pGrid.Release() To iCnt
'     Prnt "    iCnt = " & Str$(iCnt)
'  Else
'     Prnt "    pGrid Was Already Released!"
'  End If
'  Prnt "  Leaving DestroyGrid()"
'End Sub


'Function fnWndProc_OnCommand(Wea As WndEventArgs) As Long
'  Local strData As BStr
'  Local pGrid As IGrid
'  Local dwPtr As Dword
'  Local iCnt As Long

'  Prnt "Entering fnWndProc_OnCommand()"
'  Select Case As Long Lowrd(Wea.wParam)
'    Case %IDC_RETRIEVE
'      Prnt "  Case %IDC_RETRIEVE"
'      dwPtr=GetWindowLong(Wea.hWnd,0)
'      Prnt "  dwPtr = " & Str$(dwPtr)
'      CObj(pGrid,dwPtr)
'      Call pGrid.AddRef() To iCnt
'      Prnt "  iCnt = " & Str$(iCnt)
'      pGrid.FlushData()
'      strData=pGrid.GetData(3,2)
'      Prnt "  Cell 3,2 Contains " & strData
'    Case %IDC_UNLOAD_GRID
'      Prnt "  Case %IDC_UNLOAD_GRID"
'      Call DestroyGrid(Wea)
'      Call EnableWindow(GetDlgItem(Wea.hWnd,%IDC_RETRIEVE),%False)
'      Call EnableWindow(GetDlgItem(Wea.hWnd,%IDC_UNLOAD_GRID),%False)
'      Call InvalidateRect(Wea.hWnd,Byval %Null, %True)
'  End Select
'  Prnt "Leaving fnWndProc_OnCommand()"

'  fnWndProc_OnCommand=0
'End Function


'Function fnWndProc_OnDestroy(Wea As WndEventArgs) As Long
'  Prnt "Entering fnWndProc_OnDestroy()"
'  Call DestroyGrid(Wea)
'  Call CoFreeUnusedLibraries()
'  Call PostQuitMessage(0)
'  Prnt "Leaving fnWndProc_OnDestroy()"
'  Function=0
'End Function


'Function fnWndProc(ByVal hWnd As Long,ByVal wMsg As Long,ByVal wParam As Long,ByVal lParam As Long) As Long
'  Local wea As WndEventArgs
'  Register iReturn As Long
'  Register i As Long

'  For i=0 To 2
'    If wMsg=MsgHdlr(i).wMessage Then
'       wea.hWnd=hWnd: wea.wParam=wParam: wea.lParam=lParam
'       Call Dword MsgHdlr(i).dwFnPtr Using FnPtr(wea) To iReturn
'       fnWndProc=iReturn
'       Exit Function
'    End If
'  Next i

'  fnWndProc=DefWindowProc(hWnd,wMsg,wParam,lParam)
'End Function


'Sub AttachMessageHandlers()
'  ReDim MsgHdlr(2) As MessageHandler  'Associate Windows Message With Message Handlers
'  MsgHdlr(0).wMessage=%WM_CREATE   :   MsgHdlr(0).dwFnPtr=CodePtr(fnWndProc_OnCreate)
'  MsgHdlr(1).wMessage=%WM_COMMAND  :   MsgHdlr(1).dwFnPtr=CodePtr(fnWndProc_OnCommand)
'  MsgHdlr(2).wMessage=%WM_DESTROY  :   MsgHdlr(2).dwFnPtr=CodePtr(fnWndProc_OnDestroy)
'End Sub


'Function WinMain(ByVal hIns As Long,ByVal hPrev As Long,ByVal lpCL As Asciiz Ptr,ByVal iShow As Long) As Long
'  Local szAppName As ZStr*16
'  Local wc As WndClassEx
'  Local hWnd As Dword
'  Local Msg As tagMsg

'  szAppName="Grid Test"                           : Call AttachMessageHandlers()
'  wc.lpszClassName=VarPtr(szAppName)              : wc.lpfnWndProc=CodePtr(fnWndProc)
'  wc.cbClsExtra=0                                 : wc.cbWndExtra=16
'  wc.style=%CS_HREDRAW Or %CS_VREDRAW             : wc.hInstance=hIns
'  wc.cbSize=SizeOf(wc)                            : wc.hIcon=LoadIcon(%NULL, ByVal %IDI_APPLICATION)
'  wc.hCursor=LoadCursor(%NULL, ByVal %IDC_ARROW)  : wc.hbrBackground=%COLOR_BTNFACE+1
'  wc.lpszMenuName=%NULL
'  Call RegisterClassEx(wc)
'  hWnd=CreateWindowEx(0,szAppName,szAppName,%WS_OVERLAPPEDWINDOW,200,100,600,330,0,0,hIns,ByVal 0)
'  Call ShowWindow(hWnd,iShow)
'  While GetMessage(Msg,%NULL,0,0)
'    TranslateMessage Msg
'    DispatchMessage Msg
'  Wend : MsgBox("Last Chance To Get What You Can!")

'  Function=msg.wParam
'End Function

I'll let you be the judge as to which technique is best.  And here would be a console output from a program run with the debug output...

[Frederick J. Harris]

Code: [Select]

Entering fnWndProc_OnCreate()
  Entering DllGetClassObjectImpl()
    Entering IClassFactory_QueryInterface()
      Entering IClassFactory_AddRef()
        g_lObjs =  1
      Leaving IClassFactory_AddRef()
      this =  2693828
    Leaving IClassFactory_QueryInterface()
    IClassFactory_QueryInterface() For iid Succeeded!
  Leaving DllGetClassObjectImpl()

  Entering IClassFactory_CreateInstance()
    pGrid                      =  4845256
    Varptr(@pGrid.lpIGridVtbl) =  4845256
    Varptr(@pGrid.lpICPCVtbl)  =  4845260
    Varptr(@pGrid.lpICPVtbl)   =  4845264
    @pGrid.pISink              =  4582528
    @ppv                       =  0  << Before QueryInterface() Call
    Entering IGrid_QueryInterface()
      Trying To Get IFHGrid
      Entering IGrid_AddRef()
        @pGrid.m_cRef =  0  << Before
        @pGrid.m_cRef =  1  << After
      Leaving IGrid_AddRef()
      this =  4845256
    Leaving IGrid_QueryInterface()
    @ppv                       =  4845256  << After QueryInterface() Call
    Entering Initialize() -- Initialize()
      GetModuleHandle()        =  2621440
    Leaving Initialize()
  Leaving IClassFactory_CreateInstance()

  Entering IGrid_AddRef()
    @pGrid.m_cRef =  1  << Before
    @pGrid.m_cRef =  2  << After
  Leaving IGrid_AddRef()

  Entering IGrid_Release()
    @pGrid.m_cRef =  2  << Before
    @pGrid.m_cRef =  1  << After
  Leaving IGrid_Release()

  Entering IClassFactory_Release()
    g_lObjs =  1
  Leaving IClassFactory_Release()

  Entering IGrid_QueryInterface()
    Trying To Get IFHGrid
    Entering IGrid_AddRef()
      @pGrid.m_cRef =  1  << Before
      @pGrid.m_cRef =  2  << After
    Leaving IGrid_AddRef()
    this =  4845256
  Leaving IGrid_QueryInterface()

  Entering IGrid_Release()
    @pGrid.m_cRef =  2  << Before
    @pGrid.m_cRef =  1  << After
  Leaving IGrid_Release()

  Objptr(pGrid) =  4845256

  Entering IGrid_AddRef()
    @pGrid.m_cRef =  1  << Before
    @pGrid.m_cRef =  2  << After
  Leaving IGrid_AddRef()

  Entering IGrid_CreateGrid()
    this           =  4845256
    hContainer     =  328532
    strSetup       = 120:Column 1:^,130:Column 2:^,140:Column 3:^,150:Column 4:^,160:Column 5:^
    x              =  10
    y              =  10
    cx             =  570
    cy             =  222
    iRows          =  25
    iCols          =  5
    iRowHt         =  20
    strFontName    =
    GetLastError() =  0
    hGrid          =  720942
    pGridData      =  4860464
  Leaving IGrid_CreateGrid()

  Entering IGrid_QueryInterface()
    Trying To Get IConnectionPointContainer
    this =  4845256
    Entering IConnectionPointContainer_AddRef()
      @pGrid.m_cRef =  2  << Before
      @pGrid.m_cRef =  3  << After
    Leaving IConnectionPointContainer_AddRef()
    this =  4845260
  Leaving IGrid_QueryInterface()

  Entering IConnectionPointContainer_AddRef()
    @pGrid.m_cRef =  3  << Before
    @pGrid.m_cRef =  4  << After
  Leaving IConnectionPointContainer_AddRef()

  Entering IConnectionPointContainer_FindConnectionPoint()
    this  =  4845260
    @ppCP =  0
    Entering IConnectionPointContainer_QueryInterface()
      Looking For IID_IConnectionPoint
      Entering IConnectionPoint_AddRef()
        @pGrid.m_cRef =  4  << Before
        @pGrid.m_cRef =  5  << After
      Leaving IConnectionPoint_AddRef()
    Leaving IConnectionPointContainer_QueryInterface()
    @ppCP =  4845264
  Leaving IConnectionPointContainer_FindConnectionPoint()

  Entering IConnectionPoint_AddRef()
    @pGrid.m_cRef =  5  << Before
    @pGrid.m_cRef =  6  << After
  Leaving IConnectionPoint_AddRef()

  Objptr(pSink) =  4858300

  Entering IConnectionPoint_Advise()!  Grab Your Hardhat And Hang On Tight!
    this               =  4845264
    pGrid              =  4845256
    @pGrid.hControl    =  720942
    pUnkSink           =  4858300
    Vtbl               =  2111205
    @Vtbl[0]           =  2117896
    dwPtr              =  4858300
    Call Dword Succeeded!
    0     4582528     0  Found Open Slot!
    Will Be Able To Store Connection Point!
  Leaving IConnectionPoint_Advise() And Still In One Piece!

  dwCookie      =  0
Leaving fnWndProc_OnCreate()

Entering IGrid_Release()
  @pGrid.m_cRef =  6  << Before
  @pGrid.m_cRef =  5  << After
Leaving IGrid_Release()

Entering IConnectionPoint_Release()
  @pGrid.m_cRef =  5    << Before
  @pGrid.m_cRef =  4    << After
Leaving IConnectionPoint_Release()

Entering IConnectionPointContainer_Release()
  @pGrid.m_cRef =  4  << Before
  @pGrid.m_cRef =  3  << After
Leaving IConnectionPointContainer_Release()


Got WM_LBUTTONDOWN In Grid Cell From CGridEvents1(3,2)
Got KeyDown From CGridEvents1! 46=.
Got KeyDown From CGridEvents1! 46=.
Got KeyDown From CGridEvents1! 46=.
Got KeyDown From CGridEvents1! 46=.
Got KeyDown From CGridEvents1! 46=.
Got KeyDown From CGridEvents1! 70=F
Got KeyPress From CGridEvents1! 102=f
Got KeyDown From CGridEvents1! 82=R
Got KeyPress From CGridEvents1! 114=r
Got KeyDown From CGridEvents1! 69=E
Got KeyPress From CGridEvents1! 101=e
Got KeyDown From CGridEvents1! 68=D
Got KeyPress From CGridEvents1! 100=d


Entering fnWndProc_OnCommand()
  Case %IDC_RETRIEVE
  dwPtr =  4845256
  Entering IGrid_AddRef()
    @pGrid.m_cRef =  3  << Before
    @pGrid.m_cRef =  4  << After
  Leaving IGrid_AddRef()
  iCnt =  4
  Cell 3,2 Contains fred
Leaving fnWndProc_OnCommand()

Entering IGrid_Release()
  @pGrid.m_cRef =  4  << Before
  @pGrid.m_cRef =  3  << After
Leaving IGrid_Release()


Entering fnWndProc_OnCommand()
  Case %IDC_UNLOAD_GRID

  Entering DestroyGrid()
    dwPtr =  4845264

    Entering IConnectionPoint_AddRef()
      @pGrid.m_cRef =  3  << Before
      @pGrid.m_cRef =  4  << After
    Leaving IConnectionPoint_AddRef()

    iCnt =  4
 
    Entering IConnectionPoint_Unadvise()
      this            =  4845264
      dwCookie        =  0
      @pGrid.hWndCtrl =  720942
      dwPtr           =  4858300
      IGrid_Events::Release() Succeeded!
      Release() Returned  0
    Leaving IConnectionPoint_Unadvise()

    hr =  0

    Entering IConnectionPoint_Release()
      @pGrid.m_cRef =  4    << Before
      @pGrid.m_cRef =  3    << After
    Leaving IConnectionPoint_Release()

    iCnt =  3
    dwPtr =  4845260

    Entering IConnectionPointContainer_AddRef()
      @pGrid.m_cRef =  3  << Before
      @pGrid.m_cRef =  4  << After
    Leaving IConnectionPointContainer_AddRef()

    iCnt =  4

    Entering IConnectionPointContainer_Release()
      @pGrid.m_cRef =  4  << Before
      @pGrid.m_cRef =  3  << After
    Leaving IConnectionPointContainer_Release()

    iCnt =  3
    dwPtr =  4845256

    Entering IGrid_AddRef()
      @pGrid.m_cRef =  3  << Before
      @pGrid.m_cRef =  4  << After
    Leaving IGrid_AddRef()

    iCnt =  4

    Entering IGrid_Release()
      @pGrid.m_cRef =  4  << Before
      @pGrid.m_cRef =  3  << After
    Leaving IGrid_Release()

    iCnt =  3
  Leaving DestroyGrid()

  Entering IGrid_Release()
    @pGrid.m_cRef =  3  << Before
    @pGrid.m_cRef =  2  << After
  Leaving IGrid_Release()

  Entering IConnectionPoint_Release()
    @pGrid.m_cRef =  2    << Before
    @pGrid.m_cRef =  1    << After
  Leaving IConnectionPoint_Release()

  Entering IConnectionPointContainer_Release()
    @pGrid.m_cRef =  1  << Before
     0     4582528     0
     1     4582532     0
     2     4582536     0
     3     4582540     0
    @pGrid.m_cRef = 0 And Will Now Delete pGrid!
  Leaving IConnectionPointContainer_Release()
Leaving fnWndProc_OnCommand()

Entering fnWndProc_OnDestroy()
  Entering DestroyGrid()
    dwPtr =  0
    pConnectionPoint Was Already Released!
    dwPtr =  0
    pConnectionPointContainer Was Already Released!
    dwPtr =  0
    pGrid Was Already Released!
  Leaving DestroyGrid()

  Entering DllCanUnloadNow()
    I'm Outta Here! (dll is unloaded)
  Leaving DllCanUnloadNow()
Leaving fnWndProc_OnDestroy()

     Just as an interesting tid-bit of information, the C++ program above compiled for me to about 30 K.  My PBClient4_v4.exe comes in around 28 K, and PBClient9_v4.exe about 26 K.  So even with the extra reference counting hassles in the PowerBASIC programs, they are still coming in smaller than the C++ program.  And that's using my string class.  If I were using the STL Basic String Class that is a part of the C++ Standard Library, you would be able to add another 30 to 40 K for that.

[Frederick J. Harris]

Version 8 Grid And More On Object Destruction Issues

     Looks like its been since last summer (2011) that I posted anything on my grid COM control.  Last I posted it was at version 4, but I'll shortly post version 8 which has a delete routine now, the ability to include a combo box control in any column, ability to select/deselect rows (only one at a time), and the ability to set the background and text color of cells.  After posting the control code as it now stands, I'll post several clients.  I've found it interesting the past few days revisiting some of the material I posted last summer concerning object lifetime, and how one must deal with AddRef(), Release(), and Let object = Nothing type idioms when one is storing object references within the .cbWndExtra bytes or Window Properties of a hosting window.  I've always been somewhat 'hazy' about what PowerBASIC is actually doing in the background regarding object cleanup, i.e., garbage collection, vis a vie deallocating local objects and so forth.  I think I've made some progress at that, and if any of my readers are like me confused about it, perhaps my examples will help clear things up.  Can't absolutely guarantee that, but I'm hopeful!

     Here is the grid code as it now stands.  Under no circumstances should PBWin 10.03 be used.  Only compile with PBWin 10.01 or 10.02.  It can be compiled in either the debug or release version depending on whether the %DEBUG = 1 equate on the 3rd line is commented out or not.  Compiled for release I'm coming in with about a 48K binary, which compacts down to about 22K with the UPX packer utility.  For my purposes, this grid control is about finished, as it meets all my needs.

Code: [Select]

#Compile                              Dll "FHGrid8.dll" 'This ActiveX Grid Control compiles to about 48 K as a release
#Dim                                  All               'build, and 90 K as a debug build.  With UPX binary packer the
%DEBUG                                = 1               'release build can be compacted to 22 K.  The control can at this
%UNICODE                              = 1               'time only be used if compiled with PowerBASIC Windows 10.01 or
#If %Def(%UNICODE)                                      '10.02.  PBWin 10.03 builds malfunction in various ways.
    Macro ZStr                        = WStringz        'This is exactly how C/C++ programmers handle the ansi/unicode
    Macro BStr                        = WString         'issue.  They have a macro called TCHAR that reduces to a single
    %SIZEOF_CHAR                      = 2               'byte char data type if UNICODE isn't defined and wchar_t if it
#Else
    Macro ZStr                        = Asciiz          'is defined.  wchar_t is a 'typedef' of an unsigned short int in
    Macro BStr                        = String          'C or C++, and that is a WORD or two byte sequence.  Just what
    %SIZEOF_CHAR                      = 1               'unicode uses.
#EndIf
#Include                              "Win32api.inc"
#Include                              "ObjBase.inc"
#Resource                             Typelib, 1, "FHGrid8.tlb"

%IDC_GRID                             = 1400            'There are a number of simpler windows controls out of which the
%IDC_BASE                             = 1499            'grid is created.  The "Base" class is a child of the grid that
%SIZEOF_PTR                           = 4               'became necessary due to a truely miserable and intractable
%SIZEOF_HANDLE                        = 4               'SetWindowPos() problem I was having with the "Pane" class and
%ID_PANE                              = 1500            'the verticle buttons along the left edge of the grid.  The "Pane"
%ID_HEADER                            = 1505            'class is what scrolls horizontally.  Upon it sit the "Cell" objects
%ID_CELL                              = 1600            'which are just simple white windows.  When the user clicks in a cell an
%IDC_EDIT                             = 1605            'edit control is created over the cell and the parent set to the cell.
%IDC_COMBO                            = 1705            'If a combo box is used in some column it becomes a child of the cell.
%MAX_CONNECTIONS                      = 4               'Maximum number of sinks which can be hooked up to connection point
%GRID_CELL_CTRL_NONE                  = 0               'Not used yet I don't believe.
%GRID_CELL_CTRL_EDIT                  = 1               'Most typical case, i.e., an edit control set as child of cell.
%GRID_CELL_CTRL_COMBO                 = 2               'Combo Box used as child of cell.
%GRID_CELL_CTRL_CHECK                 = 3               'Not implemented yet.
%CONNECT_E_FIRST                      = &H80040200
%CONNECT_E_ADVISELIMIT                = %CONNECT_E_FIRST + 1
%MAX_COLORS                           = 15              'Maximum number of brushes, i.e., colors that can be created.


Declare Function ptrQueryInterface _                    'Model procedure declares for Call Dword need to be created, as this
( _                                                     'control is implemented with low level COM, i.e., it goes 'underneath'
  Byval this                          As Dword Ptr, _   'the PowerBASIC's high level COM implementation. 
  Byref iid                           As Guid, _
  Byval pUnknown                      As Dword _
) As Long

Declare Function ptrRelease _                           'If it is important for you to understand this code, and you don't, let
( _                                                     'me say it is indeed complicated stuff.  Here is how I learned it.  The
  Byval this                          As Dword Ptr _    'three main books I used were "Indide COM" by Dale Rogerson, "Inside DCOM"
) As Long                                               'by Guy And Henry Eddon, and "Developers Workshop To COM And ATL 3.0" by
                                                        'Andrew W. Troelsen.  Also very noteworthy was "COM In Plain C" by Jeff
Declare Function ptrKeyPress _                          'Glatt.  You can do an internet search for "COM In Plain C" and you should
( _                                                     'be able to locate Jeff's code and tutorial.  In terms of what the
  Byval this                          As Dword Ptr, _   'translations of all that to PowerBASIC look like, I had to rough that out
  Byval iKeyCode                      As Long, _        'myself, and it was hard and long.  My COM Tutorials on Jose Roca's site
  Byval iKeyData                      As Long, _        'give details of that.  It took me years to figure this stuff out, so keep
  Byval iRow                          As Long, _        'that in mind if you are having difficulties.
  Byval iCol                          As Long, _
  Byref blnCancel                     As Long _
) As Long

Declare Function ptrKeyDown _
( _
  Byval this                          As Dword Ptr, _
  Byval iKeyCode                      As Long, _
  Byval iKeyData                      As Long, _
  Byval iRow                          As Long, _
  Byval iCol                          As Long, _
  Byref blnCancel                     As Long _
) As Long

Declare Function ptrLButtonDown _
( _
  Byval this                          As Dword Ptr, _
  Byval iCellRow                      As Long, _
  Byval iGridRow                      As Long, _
  Byval iCol                          As Long _
) As Long

Declare Function ptrLButtonDblClk _
( _
  Byval this                          As Dword Ptr, _
  Byval iCellRow                      As Long, _
  Byval iGridRow                      As Long, _
  Byval iCol                          As Long _
) As Long

Declare Function ptrPaste _
( _
  Byval this                          As Dword Ptr, _
  Byval iCellRow                      As Long, _
  Byval iGridRow                      As Long, _
  Byval iCol                          As Long _
) As Long

Declare Function ptrRowSelection _
( _
  Byval this                          As Dword Ptr, _
  Byval iRow                          As Long, _
  Byval iAction                       As Long _
) As Long

Declare Function ptrDelete _
( _
  Byval this                          As Dword Ptr, _
  Byval iRow                          As Long _
) As Long

$IID_IUnknown                         = Guid$("{00000000-0000-0000-C000-000000000046}")
$IID_IClassFactory                    = Guid$("{00000001-0000-0000-C000-000000000046}")
$IID_IConnectionPoint                 = Guid$("{B196B286-BAB4-101A-B69C-00AA00341D07}")
$IID_IConnectionPointContainer        = Guid$("{B196B284-BAB4-101A-B69C-00AA00341D07}")
$CLSID_FHGrid                         = Guid$("{20000000-0000-0000-0000-000000000084}")
$IID_IFHGrid                          = Guid$("{20000000-0000-0000-0000-000000000085}")
$IID_IFHGrid_Events                   = Guid$("{20000000-0000-0000-0000-000000000086}")
$IID_LIBID_FHGrid                     = Guid$("{20000000-0000-0000-0000-000000000087}")

Type IGridVtbl                                          ' One of these becomes one of the few global variables
  QueryInterface                      As Dword Ptr      ' in this code...
  AddRef                              As Dword Ptr      '
  Release                             As Dword Ptr      ' Global IGrid_Vtbl As IGridVtbl
  CreateGrid                          As Dword Ptr      '
  SetRowCount                         As Dword Ptr      ' The individual variables or in actuality 'members' of
  SetData                             As Dword Ptr      ' this Type get set down in DllMain(), for example ...
  GetData                             As Dword Ptr      '
  FlushData                           As Dword Ptr      ' IGrid_Vtbl.QueryInterface = CodePtr(IGrid_QueryInterface)
  Refresh                             As Dword Ptr      ' IGrid_Vtbl.AddRef         = CodePtr(IGrid_AddRef)
  GetCtrlId                           As Dword Ptr      ' IGrid_Vtbl.Release        = CodePtr(IGrid_Release)
  GethGrid                            As Dword Ptr      ' IGrid_Vtbl.CreateGrid     = CodePtr(IGrid_CreateGrid)
  GethComboBox                        As Dword Ptr      '
  SetCellAttributes                   As Dword Ptr      ' So in that sense you can see that an Interface is really
  DeleteRow                           As Dword Ptr      ' just a block of memory holding addresses or pointers to
End Type                                                ' the functions that are called when an object member call
                                                        ' is made.  And the Interface pointer itself, or, if you
Type IGrid                                              ' will - VTable pointer, is just a Type holding a lone
  lpVtbl                              As IGridVtbl Ptr  ' pointer to one of the above as seen just left.
End Type


Type IConnectionPointContainerVtbl
  QueryInterface                      As Dword Ptr
  AddRef                              As Dword Ptr
  Release                             As Dword Ptr
  EnumConnectionPoints                As Dword Ptr
  FindConnectionPoint                 As Dword Ptr
End Type

Type IConnectionPointContainer1
  lpVtbl                              As IConnectionPointContainerVtbl Ptr
End Type


Type IConnectionPointVtbl
  QueryInterface                      As Dword Ptr
  AddRef                              As Dword Ptr
  Release                             As Dword Ptr
  GetConnectionInterface              As Dword Ptr
  GetConnectionPointContainer         As Dword Ptr
  Advise                              As Dword Ptr
  Unadvise                            As Dword Ptr
  EnumConnections                     As Dword Ptr
End Type

Type IConnectionPoint1
  lpVtbl                              As IConnectionPointVtbl Ptr
End Type


Type GridData                                           'This object is used to maintain 'state' in the grid control.
  iCtrlID                             As Long           'Each instantiation of a grid object will cause one of these
  hParent                             As Dword          'to be dynamically allocated, and the pointer to the allocated
  hGrid                               As Dword          'storage will be stored at offset zero in the grid object's
  hBase                               As Dword          'WNDCLASSEX::cbWndExtra bytes.  The IGrid Interface has a method
  hPane                               As Dword          'named CreateGrid() implemented in IGrid_CreateGrid(), and it is
  hCtrlInCell                         As Dword          'there where the CreateWindowEx() call is made that starts
  cx                                  As Dword          'construction of the grid.  The actual grid construction code
  cy                                  As Dword          'is largely contained in function fnGridProc_OnCreate(), which
  hHeader                             As Dword          'is the WM_CREATE handler for objects of class "Grid".
  iCols                               As Dword
  iRows                               As Dword          'GridData::pComObj is particularly noteworthy.  GridData, which
  iVisibleRows                        As Dword          'holds mostly GUI specific data, holds this pointer to the COM
  iRowHeight                          As Dword          'specific data of the IGrid Interface.  Likewise, the CGrid object,
  iPaneHeight                         As Dword          'which holds COM specific data relating to the COM plumbing of the
  iEditedCellRow                      As Long           'grid, i.e., the addresses of the various VTables, also stores the
  iEditedRow                          As Long           'hWnd of the grid there in CGrid::hWndCtrl.  In a sense, this is
  iEditedCol                          As Long           'the interface or conduit between these two types of objects created
  pComObj                             As Dword Ptr      'by an instantiation of a grid in a host object.
  pColWidths                          As Dword Ptr
  pCellCtrlTypes                      As Dword Ptr
  pCellHandles                        As Dword Ptr
  pGridMemory                         As Dword Ptr      'Will be storing ZStr Ptrs here
  pTextColor                          As Dword Ptr      'Will be storing RGB values here
  pBackColor                          As Dword Ptr      'Will be storing HBRUSHs here.  May be zero for default brush.
  pCreatedColors                      As Dword Ptr      'Colors so far asked for by user per grid instance
  pCreatedBrushes                     As Dword Ptr      'Will be storing created HBRUSHs here.  Accumulate them.
  pVButtons                           As Dword Ptr
  pCtrlHdls                           As Dword Ptr
  iSelectionBackColor                 As Long
  iSelectionTextColor                 As Long
  blnRowSelected                      As Long
  iSelectedRow                        As Long
  iFontSize                           As Long
  iFontWeight                         As Long
  hFont                               As Dword
  szFontName                          As ZStr * 28
End Type


Type CGrid                                                                   'This is the 'Class' of the grid, and each
  lpIGridVtbl                         As IGridVtbl Ptr                       'IClassFactory::CreateInstance() call will
  lpICPCVtbl                          As IConnectionPointContainerVtbl Ptr   'cause one of these to be created.  Note one
  lpICPVtbl                           As IConnectionPointVtbl Ptr            'of the members is CGrid::hWndCtrl.  This
  hWndCtrl                            As Dword                               'member will be filled in after a call of the
  pISink                              As Dword Ptr                           'IGrid::CreateGrid member, which represents
  m_cRef                              As Long                                'the Window Grid Control object of a CGrid
End Type                                                                     'instantiation. 


Type IGridEventsVtbl
  QueryInterface                      As Dword Ptr
  AddRef                              As Dword Ptr
  Release                             As Dword Ptr
  Grid_OnKeyPress                     As Dword Ptr
  Grid_OnKeyDown                      As Dword Ptr
  Grid_OnLButtonDown                  As Dword Ptr
  Grid_OnLButtonDblClk                As Dword Ptr
  Grid_OnPaste                        As Dword Ptr
  Grid_OnRowSelection                 As Dword Ptr
  Grid_OnDelete                       As Dword Ptr
End Type

Type IGridEvents
  lpVtbl                              As IGridEventsVtbl Ptr
End Type


Type IClassFactoryVtbl
  QueryInterface                      As Dword Ptr
  AddRef                              As Dword Ptr
  Release                             As Dword Ptr
  CreateInstance                      As Dword Ptr
  LockServer                          As Dword Ptr
End Type

Type IClassFactory1
  lpVtbl                              As IClassFactoryVtbl Ptr
End Type

Type WndEventArgs
  wParam                              As Long
  lParam                              As Long
  hWnd                                As Dword
  hInst                               As Dword
End Type

Declare Function FnPtr(wea As WndEventArgs) As Long

Type MessageHandler
  wMessage                            As Long
  dwFnPtr                             As Dword
End Type
Global MsgHdlr()                      As MessageHandler

Macro  dwIdx(r,c)                     = (r-1) * @pGridData.iCols + (c-1)   'Used to relate two dimensional (row,col) grid coordinates
Global CDClassFactory                 As IClassFactory1                    'to a linear address space
Global IClassFactory_Vtbl             As IClassFactoryVtbl
Global IGrid_Vtbl                     As IGridVtbl
Global IConnPointContainer_Vtbl       As IConnectionPointContainerVtbl
Global IConnPoint_Vtbl                As IConnectionPointVtbl
Global g_hModule                      As Dword
Global g_lLocks                       As Long
Global g_lObjs                        As Long
Global g_CtrlId                       As Long
Global fnEditWndProc                  As Dword                             'Used for edit control subclassing

#If %Def(%DEBUG)
Global fp                             As Long
#EndIf


#If %Def(%DEBUG)
Sub Prnt(strLn As BStr)
  Local iLen, iWritten As Long
  Local hStdOutput As Dword
  Local strNew As BStr
  hStdOutput=GetStdHandle(%STD_OUTPUT_HANDLE)
  strNew=strLn + $CrLf
  iLen = Len(strNew)
  WriteConsole(hStdOutput, Byval Strptr(strNew), iLen, iWritten, Byval 0)
End Sub
#EndIf

Function IGrid_QueryInterface(ByVal this As IGrid Ptr, ByRef iid As Guid, ByVal ppv As Dword Ptr) As Long
  #If %Def(%DEBUG)
  Prnt "    Entering IGrid_QueryInterface()"
  #EndIf
  @ppv=%NULL
  Select Case iid
    Case $IID_IUnknown
      #If %Def(%DEBUG)
      Prnt "        Trying To Get IUnknown"
      #EndIf
      Call IGrid_AddRef(this)
      @ppv=this
      #If %Def(%DEBUG)
      Prnt "        this = " & Str$(this)
      Prnt "      Leaving IGrid_QueryInterface()"
      #EndIf
      Function=%S_OK : Exit Function
    Case $IID_IFHGrid
      #If %Def(%DEBUG)
      Prnt "      Trying To Get IFHGrid"
      #EndIf
      Call IGrid_AddRef(this)
      @ppv=this
      #If %Def(%DEBUG)
      Prnt "      this = " & Str$(this)
      Prnt "    Leaving IGrid_QueryInterface()"
      #EndIf
      Function=%S_OK : Exit Function
    Case $IID_IConnectionPointContainer
      #If %Def(%DEBUG)
      Prnt "        Trying To Get IConnectionPointContainer"
      Prnt "        this = " & Str$(this)
      #EndIf
      Incr this
      @ppv=this
      Call IConnectionPointContainer_AddRef(this)
      #If %Def(%DEBUG)
      Prnt "        this = " & Str$(this)
      Prnt "      Leaving IGrid_QueryInterface()"
      #EndIf
      Function=%S_OK : Exit Function
    Case $IID_IConnectionPoint
      #If %Def(%DEBUG)
      Prnt "        Trying To Get IConnectionPoint"
      Prnt "        this = " & Str$(this)
      #EndIf
      Incr this : Incr this
      @ppv=this
      Call IConnectionPoint_AddRef(this)
      #If %Def(%DEBUG)
      Prnt "        this = " & Str$(this)
      Prnt "      Leaving IGrid_QueryInterface()"
      #EndIf
      Function=%S_OK : Exit Function
    Case Else
      #If %Def(%DEBUG)
      Prnt "        Looking For Something I Ain't Got!"
      Prnt "      Leaving IGrid_QueryInterface()"
      #EndIf
  End Select

  Function=%E_NoInterface
End Function


Function IGrid_AddRef(ByVal this As IGrid Ptr) As Long
  Local pGrid As CGrid Ptr

  #If %Def(%DEBUG)
  Prnt "    Entering IGrid_AddRef()"
  #EndIf
  pGrid=this
  #If %Def(%DEBUG)
  Prnt "      @pGrid.m_cRef = " & Str$(@pGrid.m_cRef) & "  << Before"
  #EndIf
  Incr @pGrid.m_cRef
  #If %Def(%DEBUG)
  Prnt "      @pGrid.m_cRef = " & Str$(@pGrid.m_cRef) & "  << After"
  Prnt "    Leaving IGrid_AddRef()"
  #EndIf

  IGrid_AddRef=@pGrid.m_cRef
End Function


Function IGrid_Release(ByVal this As IGrid Ptr) As Long
  Local pGrid As CGrid Ptr
  Register i As Long

  #If %Def(%DEBUG)
  Prnt "  Entering IGrid_Release()"
  #EndIf
  pGrid=this
  #If %Def(%DEBUG)
  Prnt "    pGrid         = " & Str$(pGrid)
  Prnt "    @pGrid.m_cRef = " & Str$(@pGrid.m_cRef) & "  << Before"
  #EndIf
  Decr @pGrid.m_cRef
  If @pGrid.m_cRef=0 Then
     #If %Def(%DEBUG)
     For i=0 To %MAX_CONNECTIONS-1
       Prnt "    " & Str$(i) & "    " & Str$(Varptr(@pGrid.@pISink[i])) & "    " & Str$(@pGrid.@pISink[i])
     Next i
     #EndIf
     Call DestroyWindow(@pGrid.hWndCtrl)
     Call CoTaskMemFree(@pGrid.@pISink)  ' Or, Less Insane ... Call CoTaskMemFree(Byval @pGrid.pISink)
     Call CoTaskMemFree(@this)           ' Or, Less Insane ... Call CoTaskMemFree(Byval this)
     Call InterlockedDecrement(g_lObjs)
     #If %Def(%DEBUG)
     Prnt "    @pGrid.m_cRef = 0   << After"
     Prnt "    Grid Was Deleted!"
     Prnt "  Leaving IGrid_Release()"
     #EndIf
     Function=0
  Else
     #If %Def(%DEBUG)
     Prnt "    @pGrid.m_cRef = " & Str$(@pGrid.m_cRef) & "  << After"
     Prnt "  Leaving IGrid_Release()"
     #EndIf
     Function=@pGrid.m_cRef
  End If
End Function


Function IGrid_CreateGrid _                            ' This is one of the IGrid Interface methods.  The act of invoking something like this in the client ...
  ( _                                                  '
    ByVal this                  As IGrid Ptr, _        ' pGrid = NewCom "FHGrid8.Grid"   
    Byval hContainer            As Long, _             '
    Byval strSetup              As BStr, _             ' doesn't directly crete a visible grid.  What the above statement does is load the dll and cause
    Byval x                     As Long, _             ' all the internal COM related plumbing to be constructed, such as creation of virtual function
    Byval y                     As Long, _             ' tables, etc. If a call such as the above succeeds and a viable pGrid object returned, then a call
    Byval cx                    As Long, _             ' such as this ...
    Byval cy                    As Long, _             '
    Byval iRows                 As Long, _             ' pGrid.CreateGrid(Wea.hWnd,strSetup,10,10,570,141,%NUMBER_ROWS,%NUMBER_COLUMNS,20,0,0,"Courier New",10,%FW_BOLD)     
    Byval iCols                 As Long, _             '
    Byval iRowHt                As Long, _             ' will eventuate in this procedure being called.  The whole thing below with 'Local gd As GridData' is rather
    Byval iSelectionBackColor   As Long, _             ' nonsense, as I won't use global variables unless I have to, and so gd is filled out from the parameters of
    Byval iSelectionTextColor   As Long, _             ' IGrid_CreateGrid, and the Varptr(gd) passed into the CreateWindowEx() lpCreateParams of the aforementioned
    Byval strFontName           As BStr, _             ' call.  That is how the parameters of IGrid_CreateGrid manage to get into the WM_CREATE handler for the
    Byval iFontSize             As Long, _             ' grid object created through the CreateWindowEx() call just below.  Ridiculous, I agree.  But I can't
    Byval iFontWeight           As Long _              ' help myself!  Also note, not too far below this call ...
  )                             As Long                '
  Local pGridData               As GridData Ptr        ' hGrid=CreateWindowEx(%WS_EX_OVERLAPPEDWINDOW,"Grid",Byval Strptr(strSetup),dwStyle,x,y,cx,cy,hContainer,g_CtrlId,g_hModule,ByVal Varptr(gd))
  Local hGrid,dwStyle           As Dword               '
  Local pGrid                   As CGrid Ptr           ' which call creates the grid, is this call ...
  Local gd                      As GridData            '
                                                       ' pGridData=GetWindowLong(hGrid,0)
  #If %Def(%DEBUG)                                     
  Prnt "  Entering IGrid_CreateGrid()"                 ' The 'state' data for the Window Grid Object is, as has previously been mentioned, a GridData object allocated
  Prnt "    this                = " & Str$(this)       ' in fnGridProc_OnCreate().  That object becomes available here after the CreateWindowEx() call just above, and
  Prnt "    hContainer          = " & Str$(hContainer) ' more of the fields of it are filled out.  Note particularly that CGrid::hWndCtrl gets filled out, as well as this ...
  Prnt "    strSetup            = " & strSetup         '
  Prnt "    x                   = " & Str$(x)          ' @pGridData.pComObj=this
  Prnt "    y                   = " & Str$(y)          '
  Prnt "    cx                  = " & Str$(cx)         ' In this way you can see how connections are set up between two different types of memory allocations representing
  Prnt "    cy                  = " & Str$(cy)         ' the grid, i.e., the memory allocation for COM related infrastructure such as virtual function tables, and for
  Prnt "    iRows               = " & Str$(iRows)      ' Windows GUI object stuff such as HANDLE of the grid, HANDLEs of grid cells, etc.
  Prnt "    iCols               = " & Str$(iCols)
  Prnt "    iRowHt              = " & Str$(iRowHt)
  Prnt "    iSelectionBackColor = " & Hex$(iSelectionBackColor)
  Prnt "    iSelectionTextColor = " & Hex$(iSelectionTextColor)
  Prnt "    strFontName         = " & strFontName
  Prnt "    iFontSize           = " & Str$(iFontSize)
  Prnt "    iFontWeight         = " & Str$(iFontWeight)
  #EndIf
  dwStyle                       = %WS_CHILD Or %WS_VISIBLE Or %WS_HSCROLL Or %WS_VSCROLL
  gd.iCols                      = iCols
  gd.iRowHeight                 = iRowHt
  gd.szFontName                 = strFontName
  gd.iFontSize                  = iFontSize
  gd.iFontWeight                = iFontWeight
  gd.iRows                      = iRows
  gd.iSelectionBackColor        = iSelectionBackColor
  gd.iSelectionTextColor        = iSelectionTextColor
  hGrid=CreateWindowEx(%WS_EX_OVERLAPPEDWINDOW,"Grid",Byval Strptr(strSetup),dwStyle,x,y,cx,cy,hContainer,g_CtrlId,g_hModule,ByVal Varptr(gd))
  #If %Def(%DEBUG)
  Prnt "    hGrid          = " & Str$(hGrid)
  #EndIf
  Incr g_CtrlId
  pGrid=this
  @pGrid.hWndCtrl=hGrid
  pGridData=GetWindowLong(hGrid,0)
  #If %Def(%DEBUG)
  Prnt "    pGridData      = " & Str$(pGridData)
  #EndIf
  @pGridData.pComObj=this
  If iSelectionBackColor=0 Then                        ' Here is where @pGridData.iSelectionBackColor and @pGridData.iSelectionTextColor
     @pGridData.iSelectionBackColor=%RGB_ROYALBLUE     ' are set.
  End If
  If iSelectionTextColor=0 Then
     @pGridData.iSelectionTextColor=%RGB_MAROON
  End If
  Call IGrid_SetCellAttributes(this,0,0,@pGridData.iSelectionBackColor,@pGridData.iSelectionTextColor)
  Call SetFocus(hGrid)
  #If %Def(%DEBUG)
  Prnt "  Leaving IGrid_CreateGrid()" : Prnt ""
  #EndIf

  Function=%S_OK
End Function


Function IGrid_SetRowCount(Byval this As IGrid Ptr, Byval iRowCount As Long, Byval blnForce As Long) As Long
  Local pGridData As GridData Ptr
  Local iSize,blnFree As Long
  Local pGrid As CGrid Ptr
  Local si As SCROLLINFO
  Register i As Long

  pGrid=this
  #If %Def(%DEBUG)
  Print #fp, "  Entering IGrid_SetRowCount()"
  Print #fp,
  Print #fp, "    i         blnFree"
  Print #fp, "    ================="
  #EndIf
  pGridData=GetWindowLong(@pGrid.hWndCtrl,0)
  iSize=@pGridData.iRows * @pGridData.iCols
  For i=0 To iSize - 1
    blnFree=GlobalFree(@pGridData.@pGridMemory[i])
    #If %Def(%DEBUG)
    Print #fp, "    " i, blnFree
    #EndIf
  Next i
  blnFree=GlobalFree(@pGridData.pGridMemory)
  #If %Def(%DEBUG)
  Print #fp,
  Print #fp, "     GlobalFree(@pGridData.pGridMemory) = " blnFree
  #EndIf
  blnFree=GlobalFree(@pGridData.pTextColor)
  #If %Def(%DEBUG)
  Print #fp, "     GlobalFree(@pGridData.pTextColor)  = " blnFree
  #EndIf
  blnFree=GlobalFree(@pGridData.pBackColor)
  #If %Def(%DEBUG)
  Print #fp, "     GlobalFree(@pGridData.pBackColor)  = " blnFree
  #EndIf

  'Create New Memory Block                                    ' This is the way its going to have to be!  I lost several days fighting
  If iRowCount < @pGridData.iVisibleRows Then                 ' with the fundamental restructuring of the grid to support a
     #If %Def(%DEBUG)                                         ' pGridData.iRows < pGridData.iVisibleRows, and I can tell you for a fact
     Print #fp, "    Got In Where iRowCount < iVisibleRows"   ' it isn't worth it!!!! So here I'm just going to modify the user's iRowCount
     #EndIf                                                   ' parameter so that a grid instance will never have an iRows member less
     iRowCount=@pGridData.iVisibleRows+1                      ' than the .iVisibleRows number.  In this way the grid will always have a
     @pGridData.iRows=@pGridData.iVisibleRows+1               ' verticle scrollbar, and I won't have to deal with funkiness caused by
  End If                                                      ' a blank area where the verticle scroll bar used to be (other funkiness too).
  iSize=iRowCount * @pGridData.iCols
  @pGridData.pGridMemory=GlobalAlloc(%GPTR,iSize*%SIZEOF_PTR) ' Maybe someday I'll revisit this situation, but I doubt it.
  If @pGridData.pGridMemory Then
     @pGridData.iRows=iRowCount
     si.cbSize=Sizeof(SCROLLINFO)
     si.fMask=%SIF_RANGE Or %SIF_PAGE Or %SIF_POS
     si.nMin=1
     si.nMax=@pGridData.iRows
     si.nPage=@pGridData.iVisibleRows
     si.nPos=1
     Call SetScrollInfo(@pGrid.hWndCtrl,%SB_VERT,si,%TRUE)

     @pGridData.pTextColor=GlobalAlloc(%GPTR,iSize*%SIZEOF_PTR)
     #If %Def(%DEBUG)
     Print #fp, "    @pGridData.pTextColor      = " @pGridData.pTextColor
     #EndIf
     If @pGridData.pTextColor=0 Then
        Function=%E_FAIL : Exit Function
     End If
     @pGridData.pBackColor=GlobalAlloc(%GPTR,iSize*%SIZEOF_PTR)
     #If %Def(%DEBUG)
     Print #fp, "    @pGridData.pBackColor      = " @pGridData.pBackColor
     #EndIf
     If @pGridData.pBackColor=0 Then
        Function=%E_FAIL : Exit Function
     End If
     #If %Def(%DEBUG)
     Print #fp, "  Leaving IGrid_SetRowCount()"
     Print #fp,
     #EndIf
     Function=%S_OK : Exit Function
  End If
  #If %Def(%DEBUG)
  Print #fp, "  Leaving IGrid_SetRowCount()"
  Print #fp,
  #EndIf

  Function=%E_FAIL
End Function


Function IGrid_SetData(Byval this As IGrid Ptr, Byval iRow As Long, Byval iCol As Long, Byval strData As BStr) As Long
  Local pGridData As GridData Ptr
  Local pGrid As CGrid Ptr
  Local pStr As ZStr Ptr
  Local iIndex As Long

  pGrid=this : pGridData=GetWindowLong(@pGrid.hWndCtrl,0)
  If iRow <= @pGridData.iRows And iCol <=@pGridData.iCols Then
     If iRow>0 And iCol>0 Then
        iIndex=dwIdx(iRow,iCol)
        pStr=@pGridData.@pGridMemory[iIndex]
        If @pStr<>strData Then
           Call GlobalFree(pStr)
           pStr=GlobalAlloc(%GPTR, (Len(strData)+1)*%SIZEOF_CHAR )
           If pStr Then
              @pStr=strData
              @pGridData.@pGridMemory[iIndex]=pStr
              Function=%S_OK
           Else
              Function=%S_FALSE
           End If
        Else
           Function=%S_OK
        End If
     Else
        Function=%S_FALSE
     End If
  Else
     Function=%S_FALSE
  End If
End Function


Function IGrid_GetData(Byval this As IGrid Ptr, Byval iRow As Long, Byval iCol As Long, Byref strData As BStr) As Long
  Local pGridData As GridData Ptr
  Local pGrid As CGrid Ptr
  Local pZStr As ZStr Ptr
  Local iIndex As Long

  pGrid=this
  pGridData=GetWindowLong(@pGrid.hWndCtrl,0)
  If iRow <= @pGridData.iRows And iRow > 0 Then
     If iCol<=@pGridData.iCols And iCol>0  Then
        iIndex=dwIdx(iRow,iCol)
        pZStr=@pGridData.@pGridMemory[iIndex]
        strData=@pZStr
        Function=%S_OK : Exit Function
     Else
        Function=%E_FAIL : Exit Function
     End If
  Else
     Function=%E_FAIL : Exit Function
  End If
End Function


Function IGrid_FlushData(Byval this As IGrid Ptr) As Long
  Local pGridData As GridData Ptr
  Local pGrid As CGrid Ptr
  Local pZStr As ZStr Ptr
  Local strData As BStr
  Local hGrid As Dword
  Local iLen As Long

  #If %Def(%DEBUG)
  Print #fp, "    Entering IGrid_FlushData()"
  #EndIf
  pGrid=this : hGrid=@pGrid.hWndCtrl : pGridData=GetWindowLong(hGrid,0)
  #If %Def(%DEBUG)
  Print #fp, "      pGrid     = " pGrid
  Print #fp, "      hGrid     = " hGrid
  Print #fp, "      pGridData = " pGridData
  #EndIf
  If @pGridData.hCtrlInCell Then
     #If %Def(%DEBUG)
     Print #fp, "      Got In Where @pGridData.hCtrlInCell = %True!"
     Print #fp, "      @pGridData.hCtrlInCell              = " @pGridData.hCtrlInCell
     #EndIf
     iLen=GetWindowTextLength(@pGridData.hCtrlInCell)
     pZStr=GlobalAlloc(%GPTR,(iLen+1)*%SIZEOF_CHAR)
     If pZStr Then
        Call GetWindowText(@pGridData.hCtrlInCell,Byval pZStr,iLen+1)
        strData=@pZStr
        Call IGrid_SetData(this,@pGridData.iEditedRow,@pGridData.iEditedCol,strData)
        #If %Def(%DEBUG)
        Print #fp, "      Got To Here!"
        #EndIf
        Call SetWindowLong(@pGridData.hCtrlInCell,%GWL_WNDPROC,fnEditWndProc)
        Call SetParent(@pGridData.hCtrlInCell,hGrid)
        Call SetWindowPos(@pGridData.hCtrlInCell,%HWND_BOTTOM,0,0,0,0,%SWP_HIDEWINDOW)
        @pGridData.hCtrlInCell=0
        Call IGrid_Refresh(this)
     Else
        #If %Def(%DEBUG)
        Print #fp, "      Function=%S_FALSE"
        Print #fp, "    Leaving IGrid_FlushData()"
        Print #fp,
        #EndIf
        Function=%S_FALSE : Exit Function
     End If
  End If
  #If %Def(%DEBUG)
  Print #fp, "      Function=%S_OK"
  Print #fp, "    Leaving IGrid_FlushData()"
  Print #fp,
  #EndIf
  Function=%S_OK
End Function

continued ...

[Frederick J. Harris]

Code: [Select]

Function IGrid_Refresh(Byval this As IGrid Ptr) As Long
  Local iRows,iCols,iCountCells,iIdx,iReturn As Long
  Local pGridData As GridData Ptr
  Local pGrid As CGrid Ptr
  Local pText As ZStr Ptr
  Local si As SCROLLINFO
  Register i As Long

  pGrid=this
  #If %Def(%DEBUG)
  Print #fp, "  Entering IGrid_Refresh()"
  #EndIf
  pGridData=GetWindowLong(@pGrid.hWndCtrl,0)
  iRows=@pGridData.iVisibleRows
  iCols=@pGridData.iCols
  iCountCells=iRows*iCols
  si.cbSize = sizeof(SCROLLINFO)
  si.fMask=%SIF_POS
  iReturn=GetScrollInfo(@pGrid.hWndCtrl,%SB_VERT,si)
  #If %Def(%DEBUG)
  Print #fp, "    iReturn                 = " iReturn
  Print #fp, "    @pGridData.iVisibleRows = " @pGridData.iVisibleRows
  Print #fp, "    @pGridData.iCols        = " @pGridData.iCols
  Print #fp, "    iCountCells             = " iCountCells
  Print #fp, "    si.nPos                 = " si.nPos
  Print #fp,
  Print #fp, "    i       @pCellHndls[i]  @pGridMem[i]  @pText  @pBackColor[iIdx]  @pTextColor[iIdx]"
  Print #fp, "    =================================================================================="
  #EndIf
  If iReturn Then
     For i=0 To @pGridData.iVisibleRows * @pGridData.iCols - 1
       iIdx=iCols*(si.nPos-1)+i
       Call SetWindowLong(@pGridData.@pCellHandles[i],0,@pGridData.@pGridMemory[iIdx])
       Call SetWindowLong(@pGridData.@pCellHandles[i],8,@pGridData.@pTextColor[iIdx])
       Call SetWindowLong(@pGridData.@pCellHandles[i],12,@pGridData.@pBackColor[iIdx])
       Call InvalidateRect(@pGridData.@pCellHandles[i], Byval %NULL, %TRUE)
       pText=@pGridData.@pGridMemory[i]
       #If %Def(%DEBUG)
       Print #fp, "    " i, @pGridData.@pCellHandles[i], @pGridData.@pGridMemory[i], @pText, Hex$(@pGridData.@pBackColor[iIdx]),Hex$(@pGridData.@pTextColor[iIdx])
       #EndIf
     Next i
     Function=%S_OK
  Else
     Function=%E_FAIL
  End If
  #If %Def(%DEBUG)
  Print #fp, "  Leaving Refresh()"
  Print #fp,
  #EndIf
End Function


Function IGrid_GetCtrlId(Byval this As IGrid Ptr, Byref iCtrlId As Long)  As Long
  Local pGridData As GridData Ptr
  Local pGrid As CGrid Ptr

  pGrid=this
  pGridData=GetWindowLong(@pGrid.hWndCtrl,0)
  If pGridData Then
     iCtrlId=@pGridData.iCtrlId
     Function=%S_OK
  Else
     Function=%E_FAIL
  End If
End Function


Function IGrid_GethGrid(Byval this As IGrid Ptr, Byref hGrid As Long)  As Long
  Local pGrid As CGrid Ptr

  pGrid=this
  hGrid=@pGrid.hWndCtrl
  If hGrid Then
     Function=%S_OK
  Else
     Function=%E_FAIL
  End If
End Function


Function IGrid_GethComboBox(Byval this As IGrid Ptr, Byval iCol As Long, Byref hComboBox As Long) As Long
  Local pGridData As GridData Ptr
  Local pGrid As CGrid Ptr

  pGrid=this
  pGridData=GetWindowLong(@pGrid.hWndCtrl,0)
  If @pGridData.@pCellCtrlTypes[iCol-1]=%GRID_CELL_CTRL_COMBO Then
     hComboBox=@pGridData.@pCtrlHdls[iCol-1]
     Function=%S_OK
  Else
     Function=%E_FAIL
  End If
End Function


Function IGrid_SetCellAttributes(Byval this As IGrid Ptr, Byval iRow As Long, Byval iCol As Long, Byval iBackColor As Long, Byval iTextColor As Long) As Long
  Local pGridData As GridData Ptr
  Local iIdx,blnFound As Long
  Local pGrid As CGrid Ptr
  Register i As Long

  #If %Def(%DEBUG)
  Print #fp,
  Print #fp, "  Entering IGrid_SetCellAttributes()"
  Print #fp, "    this                           = " this
  Print #fp, "    iRow                           = " iRow
  Print #fp, "    iCol                           = " iCol
  Print #fp, "    iBackColor                     = " Hex$(iBackColor)
  Print #fp, "    iTextColor                     = " Hex$(iTextColor)
  #EndIf
  pGrid=this
  pGridData=GetWindowLong(@pGrid.hWndCtrl,0)
  If iRow And iCol Then
     iIdx=dwIdx(iRow,iCol)
     @pGridData.@pTextColor[iIdx] = iTextColor
  Else
     iIdx=0
  End If
  #If %Def(%DEBUG)
  Print #fp, "    @pGridData.iCols               = " @pGridData.iCols
  Print #fp, "    iIdx                           = " iIdx
  Print #fp, "    @pGridData.pTextColor          = " @pGridData.pTextColor
  Print #fp, "    @pGridData.@pTextColor[iIdx]   = " @pGridData.@pTextColor[iIdx]
  Print #fp, "    @pGridData.@pCellHandles[iIdx] = " @pGridData.@pCellHandles[iIdx]
  Print #fp, "    @pGridData.@pCreatedColors[0]  = " @pGridData.@pCreatedColors[0]
  Print #fp, "    @pGridData.@pCreatedBrushes[0] = " @pGridData.@pCreatedBrushes[0]
  Print #fp, "    i         @pGridData.@pCreatedColors[i]            iBackColor"
  Print #fp, "    ============================================================="
  #EndIf

  'pGridMemory                         As Dword Ptr  'Will be storing ZStr Ptrs here
  'pTextColor                          As Dword Ptr  'Will be storing RGB values here, i.e., %Red, %Blue, etc
  'pBackColor                          As Dword Ptr  'Will be storing HBRUSHs here.  May be zero for default brush.
  'pCreatedColors                      As Dword Ptr  'Colors so far asked for by user per grid instance, e.g., %Red, %Yellow, %Blue, etc.
  'pCreatedBrushes                     As Dword Ptr  'Will be storing created HBRUSHs here.  Accumulate them. Numbers such as &HA0556789

  For i=1 To @pGridData.@pCreatedColors[0]
    #If %Def(%DEBUG)
    Print #fp, "    " i, Hex$(@pGridData.@pCreatedColors[i]),,,Hex$(iBackColor)
    #EndIf
    If @pGridData.@pCreatedColors[i]=iBackColor Then
       blnFound=%True : Exit For
    End If
  Next i
  If blnFound Then
     If iRow And iCol Then
        @pGridData.@pBackColor[iIdx] = @pGridData.@pCreatedBrushes[i]
     End If
     #If %Def(%DEBUG)
     Print #fp,
     Print #fp, "    Got In Where blnFound = %True!"
     Print #fp, "    @pGridData.@pCreatedBrushes[i] = " Hex$(@pGridData.@pCreatedBrushes[i])
     #EndIf
  Else
     #If %Def(%DEBUG)
     Print #fp,
     Print #fp, "    Got In Where blnFound = %False!"
     Print #fp, "    @pGridData.@pCreatedBrushes[0] = " @pGridData.@pCreatedBrushes[0] "  << Before"
     #EndIf
     If @pGridData.@pCreatedBrushes[0]<%MAX_COLORS Then          ' Test to see if @pGridData.@pCreatedBrushes[0]
        Incr @pGridData.@pCreatedBrushes[0]                      ' is less than 15, i.e., %MAX_COLORS
        Incr @pGridData.@pCreatedColors[0]
        #If %Def(%DEBUG)
        Print #fp, "    Will Be Able To Create Another Brush!"
        #EndIf
     Else
        Function=%E_FAIL : Exit Function                         ' We've already created 15 brushes
        #If %Def(%DEBUG)
        Print #fp, "    Can't Create Another Brush!"
        Print #fp, "  Leaving IGrid_SetCellAttributes()"
        Print #fp,
        #EndIf
     End If   
     #If %Def(%DEBUG)
     Print #fp, "    @pGridData.@pCreatedBrushes[0] = " @pGridData.@pCreatedBrushes[0] "  << After"
     #EndIf
     @pGridData.@pCreatedBrushes[@pGridData.@pCreatedBrushes[0]] = CreateSolidBrush(iBackColor)
     @pGridData.@pCreatedColors[@pGridData.@pCreatedColors[0]]   = iBackColor
     #If %Def(%DEBUG)
     Print #fp, "    @pGridData.@pCreatedBrushes[@pGridData.@pCreatedBrushes[0]] = " @pGridData.@pCreatedBrushes[@pGridData.@pCreatedBrushes[0]]
     #EndIf
     If iRow And iCol Then
        @pGridData.@pBackColor[iIdx] = @pGridData.@pCreatedBrushes[@pGridData.@pCreatedBrushes[0]]
        #If %Def(%DEBUG)
        Print #fp, "    Have Just Assigned A Newly Created Brush To pBackColor[]"
        Print #fp, "    @pGridData.@pBackColor[iIdx] = " Hex$(@pGridData.@pBackColor[iIdx])
        #EndIf
     End If
  End If
  #If %Def(%DEBUG)
  If iRow And iCol Then
     Print #fp, "    @pGridData.@pTextColor[iIdx]  = " Hex$(@pGridData.@pTextColor[iIdx])
  End If
  Print #fp, "  Leaving IGrid_SetCellAttributes()"
  Print #fp,
  #EndIf

  Function=%S_Ok
End Function


Function IGrid_DeleteRow(ByVal this As IGrid Ptr, Byval iRow As Long) As Long
  Local iStart,iSize,iCols As Long
  Local pGridData As GridData Ptr
  Local pGrid As CGrid Ptr
  Local hGrid As Dword
  Register i As Long

  #If %Def(%DEBUG)
  Prnt "    Entering IGrid_DeleteRow()"
  #EndIf
  pGrid=this
  hGrid=@pGrid.hWndCtrl
  pGridData=GetWindowLong(hGrid,0)
  #If %Def(%DEBUG)
  Prnt "      pGrid     = " & Str$(pGrid)
  Prnt "      hGrid     = " & Str$(hGrid)
  Prnt "      pGridData = " & Str$(pGridData)
  Prnt "      iRow      = " & Str$(iRow)
  #EndIf
  iSize=(@pGridData.iRows-1)*@pGridData.iCols-1
  iStart=dwIdx(iRow,1)
  iCols=@pGridData.iCols
  #If %Def(%DEBUG)
  Prnt "      iSize     = " & Str$(iSize)
  Prnt "      iStart    = " & Str$(iStart)
  Prnt "      iCols     = " & Str$(iCols)
  #EndIf
  For i=iStart To iSize
    @pGridData.@pGridMemory[i] = @pGridData.@pGridMemory[i+iCols]
    @pGridData.@pTextColor[i]  =  @pGridData.@pTextColor[i+iCols]
    @pGridData.@pBackColor[i]  =  @pGridData.@pBackColor[i+iCols]
  Next i
  iStart=dwIdx(@pGridData.iRows,1)
  For i=iStart To iStart+iCols - 1
    @pGridData.@pGridMemory[i] = 0
    @pGridData.@pTextColor[i]  = 0
    @pGridData.@pBackColor[i]  = 0
  Next i
  For i=1 To iCols
    Call IGrid_SetCellAttributes(this,iRow,i,@pGridData.iSelectionBackColor,@pGridData.iSelectionTextColor)
  Next i
  #If %Def(%DEBUG)
  Prnt "    Leaving IGrid_DeleteRow()"
  #EndIf

  Function=%S_Ok
End Function


Function fnEditSubClass(ByVal hEdit As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  Local hCell,hPane,hBase,hGrid As Dword
  Local pGridData As GridData Ptr
  Local Vtbl,dwPtr As Dword Ptr
  Local hr,blnCancel As Long
  Local pGrid As CGrid Ptr
  Register i As Long

  hCell=GetParent(hEdit) : hPane=GetParent(hCell)
  hBase=GetParent(hPane) : hGrid=GetParent(hBase)
  pGridData=GetWindowLong(hPane,0)
  pGrid=@pGridData.pComObj
  Select Case As Long wMsg
    Case %WM_CHAR
      #If %Def(%DEBUG)
      Print #fp, "    Entering fnEditSubClass"
      Print #fp, "      Got WM_CHAR Message In fnEditSubClass!"
      #EndIf
      For i=0 To %MAX_CONNECTIONS-1
        If @pGrid.@pISink[i] Then
           dwPtr=@pGrid.@pISink[i]
           VTbl=@dwPtr
           Call Dword @Vtbl[3] Using ptrKeyPress(dwPtr, wParam, lParam, @pGridData.iEditedRow, @pGridData.iEditedCol, blnCancel) To hr
           If blnCancel Then
              Exit Function
           End If
        End If
      Next i
      #If %Def(%DEBUG)
      If SUCCEEDED(hr) Then
         Print #fp, "      Call Dword @Vtbl[3] Using ptrKeyPress() Succeeded!"
      End If
      #EndIf
      If wParam=%VK_RETURN Then
         #If %Def(%DEBUG)
         Print #fp, "      Got WM_CHAR Message %VK_RETURN In fnEditSubClass!"
         #EndIf
         Call IGrid_FlushData(pGrid)
         Call IGrid_Refresh(@pGridData.pComObj)
         #If %Def(%DEBUG)
         Print #fp, "    Leaving fnEditSubClass"
         Print #fp,
         #EndIf
         Exit Function
      Else
         @pGridData.hCtrlInCell=hEdit
      End If
      #If %Def(%DEBUG)
      Print #fp, "    Leaving fnEditSubClass"
      Print #fp,
      #EndIf
    Case %WM_KEYDOWN
      #If %Def(%DEBUG)
      Print #fp, "    Entering fnEditSubClass"
      Print #fp, "      Got WM_KEYDOWN Message In fnEditSubClass!"
      #EndIf
      For i=0 To %MAX_CONNECTIONS-1
        If @pGrid.@pISink[i] Then
           dwPtr=@pGrid.@pISink[i]
           VTbl=@dwPtr
           Call Dword @Vtbl[4] Using ptrKeyDown(dwPtr, wParam, lParam, @pGridData.iEditedRow, @pGridData.iEditedCol, blnCancel) To hr
           If blnCancel Then
              Exit Function
           End If
        End If
      Next i
      #If %Def(%DEBUG)
      If SUCCEEDED(hr) Then
         Print #fp, "      Call Dword @Vtbl[4] Using ptrKeyDown() Succeeded!"
      End If
      Print #fp, "    Leaving fnEditSubClass"
      Print #fp,
      #EndIf
    Case %WM_PASTE
      #If %Def(%DEBUG)
      Print #fp, "      Got WM_PASTE Message In fnEditSubClass!"
      #EndIf
      For i=0 To %MAX_CONNECTIONS-1
        If @pGrid.@pISink[i] Then
           dwPtr=@pGrid.@pISink[i]
           VTbl=@dwPtr
           Call Dword @Vtbl[7] Using ptrPaste(dwPtr, @pGridData.iEditedCellRow, @pGridData.iEditedRow, @pGridData.iEditedCol) To hr
        End If
      Next i
      #If %Def(%DEBUG)
      If SUCCEEDED(hr) Then
         Print #fp, "      Call Dword @Vtbl[7] Using ptrPaste() Succeeded!"
      End If
      #EndIf
    Case %WM_LBUTTONDBLCLK
      #If %Def(%DEBUG)
      Print #fp, "      Got %WM_LBUTTONDBLCLK Message In fnEditSubClass!"
      #EndIf
      For i=0 To %MAX_CONNECTIONS-1
        If @pGrid.@pISink[i] Then
           dwPtr=@pGrid.@pISink[i]
           VTbl=@dwPtr
           Call Dword @Vtbl[6] Using ptrLButtonDblClk(dwPtr, @pGridData.iEditedCellRow, @pGridData.iEditedRow, @pGridData.iEditedCol) To hr
        End If
      Next i
      #If %Def(%DEBUG)
      If SUCCEEDED(hr) Then
         Print #fp, "      Call Dword @Vtbl[6] Using ptrPaste() Succeeded!"
      End If
      #EndIf
   End Select

  Function=CallWindowProc(fnEditWndProc,hEdit,wMsg,wParam,lParam)
End Function


Function EnumGridProc(Byval hWnd As Long, Byval lParam As Dword) As Long
  If GetClassLong(hWnd,%GCL_WNDPROC)=lParam Then
     #If %Def(%DEBUG)
     Print #fp, "    Called EnumGridProc() - ", hWnd, lParam
     #EndIf
     Local pGridData As GridData Ptr
     pGridData=GetWindowLong(hWnd,0)
     Call IGrid_FlushData(@pGridData.pComObj)
  End If
  Function=%True
End Function


Function fnCellProc(ByVal hCell As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  Select Case As Long wMsg
    Case %WM_CREATE
      Call SetWindowLong(hCell,0,%NULL)
      Function=0 : Exit Function
    Case %WM_LBUTTONDOWN
      Local iCellBufferPos,iGridMemOffset,iRow,iCol,hr As Long
      Local hPane,hBase,hGrid As Dword
      Local pGridData As GridData Ptr
      Local Vtbl,dwPtr As Dword Ptr
      Local si As SCROLLINFO
      Local pZStr As ZStr Ptr
      Local pGrid As CGrid Ptr
      Register i As Long
      Register j As Long

      #If %Def(%DEBUG)
      Print #fp, "  Entering fnCellProc - Case WM_LBUTTONDOWN"
      #EndIf
      hPane=GetParent(hCell)
      hBase=GetParent(hPane)
      hGrid=GetParent(hBase)
      pGridData=GetWindowLong(hPane,0)
      Call EnumChildWindows(@pGridData.hParent,CodePtr(EnumGridProc),Byval Codeptr(fnGridProc))
      si.cbSize = sizeof(SCROLLINFO)
      si.fMask=%SIF_POS
      Call GetScrollInfo(hGrid,%SB_VERT,si)
      For i=1 To @pGridData.iVisibleRows
        For j=1 To @pGridData.iCols
          iCellBufferPos = dwIdx(i,j)
          If @pGridData.@pCellHandles[iCellBufferPos]=hCell Then
             iGridMemOffset = @pGridData.iCols * (si.nPos -1) + iCellBufferPos
             pZStr=@pGridData.@pGridMemory[iGridMemOffset]
             iRow=i : iCol=j
             @pGridData.iEditedCellRow=iRow         'This is the one based row number in the visible grig
             @pGridData.iEditedRow=iRow+si.nPos-1   'This is the row in the buffer
             @pGridData.iEditedCol=iCol
             Exit, Exit
          End If
        Next j
      Next i
      #If %Def(%DEBUG)
      Print #fp, "    iRow                               = " iRow
      Print #fp, "    iCol                               = " iCol
      Print #fp, "    @pGridData.@pCellCtrlTypes[iCol-1] = " @pGridData.@pCellCtrlTypes[iCol-1]
      #EndIf

      @pGridData.hCtrlInCell=@pGridData.@pCtrlHdls[iCol-1]
      Call SetParent(@pGridData.hCtrlInCell,hCell)
      fnEditWndProc=SetWindowLong(@pGridData.hCtrlInCell,%GWL_WNDPROC,CodePtr(fnEditSubClass))  '<<added to fix bad bug
      If @pGridData.hFont Then
         Call SendMessage(@pGridData.hCtrlInCell,%WM_SETFONT,@pGridData.hFont,%TRUE)
      End If
      If @pGridData.@pCellCtrlTypes[iCol-1]=%GRID_CELL_CTRL_EDIT Then
         Call SetWindowPos(@pGridData.hCtrlInCell,%HWND_TOP,1,0,@pGridData.@pColWidths[iCol-1]-2,@pGridData.iRowHeight,%SWP_SHOWWINDOW)
         Call SetWindowText(@pGridData.hCtrlInCell,@pZStr)
         Call SetFocus(@pGridData.hCtrlInCell)
      End If
      If @pGridData.@pCellCtrlTypes[iCol-1]=%GRID_CELL_CTRL_COMBO Then
         Call SetWindowPos(@pGridData.hCtrlInCell,%HWND_TOP,1,0,@pGridData.@pColWidths[iCol-1]-2,180,%SWP_SHOWWINDOW)
         Call SendMessage(@pGridData.hCtrlInCell,%CB_SETCURSEL,-1,0)
      End If
      pGrid=@pGridData.pComObj
      For i=0 To %MAX_CONNECTIONS-1
        If @pGrid.@pISink[i] Then
           dwPtr=@pGrid.@pISink[i]
           VTbl=@dwPtr
           Call Dword @Vtbl[5] Using ptrLButtonDown(dwPtr, @pGridData.iEditedCellRow, @pGridData.iEditedRow, @pGridData.iEditedCol) To hr
           #If %Def(%DEBUG)
           Print #fp, "    hGrid = " hGrid
           Print #fp, "    dwPtr = " dwPtr
           Print #fp, "    Vtbl  = " Vtbl
           #EndIf
        End If
      Next i
      #If %Def(%DEBUG)
      Print #fp, "  Leaving fnCellProc - Case WM_LBUTTONDOWN" : Print #fp,
      #EndIf
      Function=0 : Exit Function
    Case %WM_PAINT
      Local hDC,hFont,hTmp,hBrush,hTmpBr,dwColor As Dword
      Local pBuffer As ZStr Ptr
      Local ps As PAINTSTRUCT
      hDC=BeginPaint(hCell,ps)
      pBuffer=GetWindowLong(hCell,0)
      hFont=GetWindowLong(hCell,4)
      dwColor=GetWindowLong(hCell,8)
      hBrush=GetWindowLong(hCell,12)
      If hFont Then
         hTmp=SelectObject(hDC,hFont)
      End If
      If dwColor Then
         Call SetTextColor(hDC,dwColor)
      End If
      If hBrush Then
         Local rc As RECT
         hTmpBr=SelectObject(hDC,hBrush)
         Call GetClientRect(hCell,rc)
         Call FillRect(hDC,rc,hBrush)
         Call SelectObject(hDC,hTmpBr)
      End If
      Call SetBkMode(hDC,%TRANSPARENT)
      Call TextOut(hDC,1,0,@pBuffer,Len(@pBuffer))
      If hFont Then
         hFont=SelectObject(hDC,hTmp)
      End If
      Call EndPaint(hCell,ps)
      Function=0 : Exit Function
  End Select

  fnCellProc=DefWindowProc(hCell, wMsg, wParam, lParam)
End Function


Function fnPaneProc(ByVal hPane As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  Local si As SCROLLINFO
  Register i As Long
  Register j As Long

  Select Case As Long wMsg
    Case %WM_NOTIFY
      Local pGridData As GridData Ptr
      Local pNotify As HD_NOTIFY Ptr
      Local iPos(),iWidth() As Long
      Local index,iHt,iRange As Long
      Local iCols As Dword
      pNotify=lParam
      pGridData=GetWindowLong(hPane,0)
      Select Case As Long @pNotify.hdr.Code
        Case %HDN_TRACK
          #If %Def(%DEBUG)
          Print #fp, "  Entering fnPaneProc() - %HDN_TRACK Case"
          #EndIf
          If @pGridData.hCtrlInCell Then
             Call IGrid_FlushData(@pGridData.pComObj)
             Call IGrid_Refresh(@pGridData.pComObj)
          End If
          If @pGridData.pColWidths Then
             @pGridData.@pColWidths[@pNotify.iItem]=@pNotify.@pItem.cxy
          End If
          iCols=@pGridData.iCols
          @pGridData.@pColWidths[iCols]=0
          For i=0 To iCols-1
            @pGridData.@pColWidths[iCols]=@pGridData.@pColWidths[iCols]+@pGridData.@pColWidths[i]
          Next i
          si.cbSize = sizeof(SCROLLINFO)
          si.fMask = %SIF_RANGE Or %SIF_PAGE Or %SIF_DISABLENOSCROLL
          si.nMin = 0 : si.nMax=@pGridData.@pColWidths[iCols]
          si.nPage=@pGridData.cx-33
          iRange=si.nMax-si.nMin
          Call SetScrollInfo(@pGridData.hGrid,%SB_HORZ,si,%TRUE)
          If iRange>si.nPage Then   'Original
             Call SetWindowPos(@pGridData.hPane,%HWND_TOP,0,0,@pGridData.@pColWidths[iCols],@pGridData.cy,%SWP_NOMOVE Or %SWP_SHOWWINDOW)
          Else
             Call SetWindowPos(@pGridData.hPane,%HWND_TOP,0,0,@pGridData.@pColWidths[iCols],@pGridData.cy,%SWP_SHOWWINDOW)
          End If
          Call SetWindowPos(@pGridData.hHeader,%HWND_BOTTOM,0,0,@pGridData.@pColWidths[iCols],@pGridData.iRowHeight,%SWP_NOMOVE Or %SWP_SHOWWINDOW)
          #If %Def(%DEBUG)
          Print #fp, "    si.nMin                       = " si.nMin
          Print #fp, "    si.nMax                       = " si.nMax
          Print #fp, "    si.nPage                      = " si.nPage
          Print #fp, "    @pGridData.@pColWidths[iCols] = " @pGridData.@pColWidths[iCols]
          #EndIf
          Redim iPos(iCols) As Long
          For i=1 To iCols-1
            iPos(i)=iPos(i-1)+@pGridData.@pColWidths[i-1]
          Next i
          If @pGridData.pCellHandles Then
             For i=0 To @pGridData.iVisibleRows-1
               For j=0 To iCols-1
                 index=iCols*i+j
                 iHt=@pGridData.iRowHeight
                 Call MoveWindow(@pGridData.@pCellHandles[index], iPos(j), iHt+(i*iHt), @pGridData.@pColWidths[j], iHt, %False)
               Next j
             Next i
             Call InvalidateRect(@pGridData.hGrid,Byval %NULL,%TRUE)
          End If
          Erase iPos()
          #If %Def(%DEBUG)
          Print #fp, "  Leaving fnPaneProc Case" : Print #fp,
          #EndIf
          Function=0
          Exit Function
        Case %HDN_ENDTRACK
          #If %Def(%DEBUG)
          Print #fp, "  Entering fnPaneProc() - %END_TRACK Case"
          #EndIf
          Call InvalidateRect(@pGridData.hGrid,Byval 0,%TRUE)
          #If %Def(%DEBUG)
          Print #fp, "  Leaving %END_TRACK Case"
          #EndIf
          Function=0 : Exit Function
      End Select
      Function=0 : Exit Function
  End Select

  fnPaneProc=DefWindowProc(hPane, wMsg, wParam, lParam)
End Function


Function fnBaseProc(ByVal hBase As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  fnBaseProc=DefWindowProc(hBase, wMsg, wParam, lParam)
End Function


Function fnGridProc_OnCreate(Wea As WndEventArgs) As Long  ' This is the procedure which actually creates the grid.
  Local iFlds,iHdlCount,iCols,iCtr,iSize As Long           ' When this Dll is loaded and DllGetClassObjectImpl() is
  Local strParseData(),strFieldData() As BStr              ' called, the Sub Initialize() is then called too.  This
  Local pGridData1,pGridData2 As GridData Ptr              ' latter Sub registers (RegisterClassEx()) several Window
  Local dwStyle,hButton,hCell,hDC As Dword                 ' Classes necessary to the grid's creation, such as the
  Local pCreateStruct As CREATESTRUCT Ptr                  ' "Grid", Class, the "Pane" Class, and the "Cell" Class.
  Local szText As ZStr*64                                  ' When a client app holding an IGrid Interface Pointer
  Local hdrItem As HDITEM                                  ' makes an IGrid::CreateGrid() member call, the function
  Local strSetup As BStr                                   ' IGrid_CreateGrid() is first called, and this latter
  Local iPos() As Long                                     ' function makes the CreateWindowEx(..., "Grid", ...)
  Register i As Long                                       ' call that triggers invocation of this fnGridProc_OnCreate()
  Register j As Long                                       ' WM_CREATE handler, which constructs the grid. 
  Local rc As RECT

  #If %Def(%DEBUG)                                         
  Print #fp, "  Entering fnGridProc_OnCreate()"         
  #EndIf
  pCreateStruct=Wea.lParam                                 ' A grid consists of many 'child' or subobjects.  For example,
  Wea.hInst=@pCreateStruct.hInstance                       ' there is the "Grid" itself, which is something of a "Container"
  pGridData1=@pCreateStruct.lpCreateParams                 ' object.  Within the "Grid", and as children of the grid, are
  strSetup=@pCreateStruct.@lpszName                        ' the "Base" object, and the "Pane" object.  Then the "Cell"
  Call GetClientRect(Wea.hWnd,rc)                          ' objects become children of the "Pane" object.  It is the "Pane"
  #If %Def(%DEBUG)
  Print #fp, "    %WM_USER                 = " %WM_USER                ' object which is involved in horizontal scrolling.
  Print #fp, "    %WM_APP                  = " %WM_APP                 ' It is the header control, i.e., WC_HEADER, which
  Print #fp, "    hGrid                    = " Wea.hWnd                ' I've used to provide the functionality of resizable
  Print #fp, "    pGridData1               = " pGridData1              ' grid columns.  That control sits atop and becomes a
  Print #fp, "    Wea.hInstance            = " Wea.hInst               ' child of the "Pane". Then the "Cell" objects, each
  Print #fp, "    @pCreateStruct.cx        = " @pCreateStruct.cx       ' of which are created through a CreateWindowEx() call,
  Print #fp, "    @pCreateStruct.cy        = " @pCreateStruct.cy       ' sit underneath the header control, and are also children
  Print #fp, "    rc.Right                 = " rc.Right                ' of the "Pane".  Of course, some of the first real work
  Print #fp, "    rc.Bottom                = " rc.Bottom               ' this procedure does is to determine the sizes of things
  Print #fp, "    @pGridData1.iFontSize    = " @pGridData1.iFontSize   ' and their locations, given the various parameters sent
  Print #fp, "    @pGridData1.iFontWeight  = " @pGridData1.iFontWeight ' in through the parameter list from the client.  After
  Print #fp, "    @pGridData1.szFontName   = " @pGridData1.szFontName  ' that is the necessity of dealing with the setup string
  Print #fp, "    strSetup                 = " strSetup                ' sent in from the client, which contains all the column info.
  #EndIf                                 
  iCols=ParseCount(strSetup,",")                                       
  #If %Def(%DEBUG)
  Print #fp, "    iCols                    = " iCols
  Print #fp, "    @pGridData1.iRows        = " @pGridData1.iRows
  Print #fp, "    @pGridData1.iCols        = " @pGridData1.iCols
  Print #fp, "    @pGridData1.iRowHeight   = " @pGridData1.iRowHeight
  #EndIf
  If iCols<>@pGridData1.iCols Then                 ' In terms of the strSetup parameter, that is a BSTR passed in from the client
     Function=-1 : Exit Function                   ' with a comma delimited format that contains the initial pixel width of the
  End If                                           ' column, the text to display in the header control, the type of control to
  pGridData2=GlobalAlloc(%GPTR,sizeof(GridData))   ' be set in the cell when a user clicks on a cell (at this time only edit controls
  If pGridData2=0 Then                             ' or combo boxes), and whether the text in the header control is left oriented,
     Function=-1 : Exit Function                   ' right oriented, or centered (<:>:^).  The ':' symbol further is used as the
  End If                                           ' delimiter of this information within each comma delimited substring.  Note
  Call SetWindowLong(Wea.hWnd,0,pGridData2)        ' that PowerBASIC's ParseCount / Parse statement functionality is used to seperate
  @pGridData2.iCtrlID=@pCreateStruct.hMenu         ' the substrings and get at this data.  The Parse Statement was broken in PBWin 10,
  @pGridData2.cx=@pCreateStruct.cx                 ' then fixed in update release 10.01.  In PBWin 10.02 it also worked, but was again
  @pGridData2.cy=@pCreateStruct.cy                 ' broken in PBWin 10.03.  This latter situation only applies to unicode builds
  @pGridData2.iCols=iCols                          ' and on Win 2000/XP machines (for whatever reason).  Therefore, I would not
  @pGridData2.iRows=@pGridData1.iRows              ' recommend using this grid if it is going to be built with PBWin 10.03.
  @pGridData2.iRowHeight=@pGridData1.iRowHeight
  @pGridData2.iVisibleRows=Fix((rc.Bottom-@pGridData1.iRowHeight)/@pGridData1.iRowHeight)
  If @pGridData1.iRows>@pGridData2.iVisibleRows Then   'DANGER!  ADDITION!!!
     @pGridData2.iRows=@pGridData1.iRows
  Else
     @pGridData2.iRows=@pGridData2.iVisibleRows+1
     @pGridData1.iRows=@pGridData2.iVisibleRows+1
  End If                                               'END DANGER ADDITION
  @pGridData2.iPaneHeight=(@pGridData2.iVisibleRows+1)*@pGridData1.iRowHeight
  @pGridData2.hGrid=Wea.hWnd
  @pGridData2.hParent=GetParent(Wea.hWnd)
  @pGridData1.iVisibleRows=@pGridData2.iVisibleRows
  #If %Def(%DEBUG)
  Print #fp, "    pGridData2               = " pGridData2
  Print #fp, "    @pGridData2.hParent      = " @pGridData2.hParent
  Print #fp, "    @pGridData2.iCtrlID      = " @pGridData2.iCtrlID
  Print #fp, "    @pGridData2.iPaneHeight  = " @pGridData2.iPaneHeight
  Print #fp, "    @pCreateStruct.cy        = " @pCreateStruct.cy
  Print #fp, "    @pGridData1.iRowHeight   = " @pGridData1.iRowHeight
  Print #fp, "    @pGridData2.iVisibleRows = " @pGridData2.iVisibleRows
  Print #fp, "    @pGridData2.iRows        = " @pGridData2.iRows
  #EndIf
  Redim strParseData(iCols) As BStr 
  Parse strSetup,strParseData(),","  ' Here is the statement that seems to cause memory corruption on 2000/XP.
  @pGridData2.pColWidths=GlobalAlloc(%GPTR,(iCols+1)*%SIZEOF_PTR)   'when 10.03 compiler is used.
  If @pGridData2.pColWidths=0 Then
     Goto CleanUp
  End If
  #If %Def(%DEBUG)
  Print #fp, "    @pGridData2.pColWidths   = " @pGridData2.pColWidths
  Print #fp,
  Print #fp, "    i         strParseData(i) "
  Print #fp, "    ============================="
  For i=0 To iCols-1
    Print #fp, "    " i, strParseData(i)
  Next i
  Print #fp,
  #EndIf

  @pGridData2.hBase=CreateWindowEx(0,"Base","",%WS_CHILD Or %WS_VISIBLE,0,0,0,0,Wea.hWnd,1499,Wea.hInst,Byval 0)               'Create Base
  dwStyle=%WS_CHILD Or %WS_BORDER Or %WS_VISIBLE Or %HDS_HOTTRACK Or %HDS_HORZ
  @pGridData2.hPane=CreateWindowEx(0,"Pane","",%WS_CHILD Or %WS_VISIBLE,0,0,0,0,@pGridData2.hBase,%ID_PANE,Wea.hInst,Byval 0)  'Create Pane
  @pGridData2.hHeader=CreateWindowEx(0,WC_HEADER,"",dwStyle,0,0,0,0,@pGridData2.hPane,%ID_HEADER,Wea.hInst,Byval 0)            'Create Header Control
  Call SetWindowLong(@pGridData2.hPane,0,pGridData2)

  @pGridData2.pCellCtrlTypes=GlobalAlloc(%GPTR,(iCols)*%SIZEOF_PTR)   'Set up ptr to buffer in GridData for holding control types for column, i.e.,
  If @pGridData2.pCellCtrlTypes=0 Then                                'edit controls, none, combo boxes, etc.
     Goto CleanUp
  End If
  @pGridData2.pCtrlHdls=GlobalAlloc(%GPTR,(iCols)*%SIZEOF_PTR)
  If @pGridData2.pCtrlHdls=0 Then
     Goto CleanUp
  End If

  #If %Def(%DEBUG)
  Print #fp, "    @pGridData2.hBase           = " @pGridData2.hBase
  Print #fp, "    @pGridData2.hPane           = " @pGridData2.hPane
  Print #fp, "    @pGridData2.hHeader         = " @pGridData2.hHeader
  Print #fp, "    @pGridData2.pCellCtrlTypes  = " @pGridData2.pCellCtrlTypes
  Print #fp,
  Print #fp, "    i     @pColWidths[i]     iPos(i)      szText        strFieldData(2),            strFieldData(3)              Cell Ctrl Type"
  Print #fp, "    ==========================================================================================================================="
  #EndIf
  hdrItem.mask=%HDI_FORMAT Or %HDI_WIDTH Or %HDI_TEXT
  Redim iPos(iCols) As Long

  For i=0 To iCols-1                                ' This rather complex code sets up the header control using the data parsed
    iFlds=ParseCount(strParseData(i),":")           ' from the setup string, such as grid column text strings, initial widths,
    Redim strFieldData(iFlds-1)                     ' justification of text in header control, etc.  Note that each of the sub-
    Parse strParseData(i), strFieldData(), ":"      ' strings parsed from the comma delimited setup string need to be further parsed
    @pGridData2.@pColWidths[i]=Val(strFieldData(0)) ' for the sub - sub-strings within them that use the ':' char as a delimiter.
    @pGridData2.@pColWidths[iCols]=@pGridData2.@pColWidths[iCols]+@pGridData2.@pColWidths[i]
    hdrItem.cxy=@pGridData2.@pColWidths[i]
    szText=strFieldData(1)
    hdrItem.pszText=Varptr(szText) : hdrItem.cchTextMax=Len(szText)
    If strFieldData(2)="<" Then
       hdrItem.fmt= %HDF_LEFT
    Else
       If strFieldData(2)="^" Then
          hdrItem.fmt=%HDF_CENTER
       Else
          hdrItem.fmt=%HDF_RIGHT
       End If
    End If
    hdrItem.fmt=hdrItem.fmt Or %HDF_STRING
    Call Header_InsertItem(@pGridData2.hHeader,i,Varptr(hdrItem))
    'Call Header_InsertItem(@pGridData2.hHeader,i,hdrItem)
    If i Then
       iPos(i)=iPos(i-1)+@pGridData2.@pColWidths[i-1]
    End If
    Select Case strFieldData(3)
      Case "none"
        @pGridData2.@pCellCtrlTypes[i]=0
      Case "edit"
        @pGridData2.@pCellCtrlTypes[i]=1
      Case "combo"
        @pGridData2.@pCellCtrlTypes[i]=2
      Case "check"
        @pGridData2.@pCellCtrlTypes[i]=3
    End Select
    #If %Def(%DEBUG)
    Print #fp, "   " i, @pGridData2.@pColWidths[i], iPos(i), szText, strFieldData(2), ,strFieldData(3), , @pGridData2.@pCellCtrlTypes[i]
    #EndIf
    Erase strFieldData()
  Next i

  #If %Def(%DEBUG)
  Print #fp,
  Print #fp, "    i         @pGridData2.@pCtrlHdls[i]"
  Print #fp, "    ==================================="
  #EndIf
  Local blnEditCreated,iCboCtr As Long                             '@pGridData2.hCtrlInCell is equal to the hWnd of the edit control
  For i=0 To iCols-1                                               'created in fnGridProc_OnCreate().  Also, GridData::pCtrlHdls[i]
    If @pGridData2.@pCellCtrlTypes[i]=%GRID_CELL_CTRL_EDIT Then    'hold the handles of the various edit or combo box controls.
       If blnEditCreated=%False Then                               'fnEditWndProc is the original edit control WndProc().
          dwStyle=%WS_CHILD Or %ES_AUTOHSCROLL
          @pGridData2.@pCtrlHdls[i]=CreateWindow("edit","",dwStyle,0,0,0,0,Wea.hWnd,%IDC_EDIT,Wea.hInst,ByVal 0)
          @pGridData2.hCtrlInCell=@pGridData2.@pCtrlHdls[i]
          blnEditCreated=%True
       Else
          @pGridData2.@pCtrlHdls[i]=@pGridData2.hCtrlInCell
       End If
    End If
    If @pGridData2.@pCellCtrlTypes[i]=%GRID_CELL_CTRL_COMBO Then
       dwStyle=%WS_CHILD Or %CBS_DROPDOWNLIST Or %WS_VSCROLL 'Or %CBS_NOINTEGRALHEIGHT
       @pGridData2.@pCtrlHdls[i]=CreateWindow("combobox","",dwStyle,0,0,0,0,Wea.hWnd,%IDC_COMBO+iCboCtr,Wea.hInst,ByVal 0)
       Incr iCboCtr
    End If
    #If %Def(%DEBUG)
    Print #fp, "   " i, @pGridData2.@pCtrlHdls[i]
    #EndIf
  Next i
  @pGridData2.hCtrlInCell=0

  #If %Def(%DEBUG)
  Print #fp,
  Print #fp, "    @pGridData2.@pColWidths[iCols]   = " @pGridData2.@pColWidths[iCols]
  Print #fp,
  #EndIf
  Call MoveWindow(@pGridData2.hBase,12,0,rc.right-12,@pGridData2.iPaneHeight,%FALSE)
  Call MoveWindow(@pGridData2.hPane,0,0,@pGridData2.@pColWidths[iCols],@pGridData2.iPaneHeight,%FALSE)  'Size Pane
  Call MoveWindow(@pGridData2.hHeader,0,0,@pGridData2.@pColWidths[iCols],@pGridData2.iRowHeight,%TRUE)  'Size Header

  'Make Verticle Buttons that go at far left in the grid, and which can be clicked to select a grid row
  @pGridData2.pVButtons=GlobalAlloc(%GPTR,(@pGridData2.iVisibleRows+1)*%SIZEOF_PTR)
  #If %Def(%DEBUG)
  Print #fp, "    @pGridData2.pVButtons = " @pGridData2.pVButtons
  Print #fp,
  Print #fp, "   i          @pGridData2.@pVButtons[i] "
  Print #fp, "   ====================================="
  #EndIf
  If @pGridData2.pVButtons Then
     For i=0 To @pGridData2.iVisibleRows
       @pGridData2.@pVButtons[i]=CreateWindow("button","",%WS_CHILD Or %WS_VISIBLE Or %BS_FLAT,0,@pGridData2.iRowHeight*i,12,@pGridData2.iRowHeight,Wea.hWnd,20000+i,Wea.hInst,Byval 0)
       #If %Def(%DEBUG)
       Print #fp, "   " i, @pGridData2.@pVButtons[i]
       #EndIf
     Next i
  Else
     Goto CleanUp
  End If

  'Try To Create Font  ' ANSI_CHARSET  '%OEM_CHARSET
  #If %Def(%DEBUG)
  Print #fp,
  Print #fp, "    Now Gonna Try To Create Font..."
  Print #fp, "    @pGridData1.szFontName = " @pGridData1.szFontName
  #EndIf
  If @pGridData1.szFontName<>"" Then
     hDC=GetDC(Wea.hWnd)
     @pGridData2.hFont=CreateFont _
     ( _
       -1*(@pGridData1.iFontSize*GetDeviceCaps(hDC,%LOGPIXELSY))/72, _
       0, _
       0, _
       0, _
       @pGridData1.iFontWeight, _
       0, _
       0, _
       0, _
       %ANSI_CHARSET, _
       0, _
       0, _
       %DEFAULT_QUALITY, _
       0, _
       @pGridData1.szFontName _
     )
     Call ReleaseDC(Wea.hWnd,hDC)
  End If
  #If %Def(%DEBUG)
  Print #fp, "    @pGridData2.hFont      = " @pGridData2.hFont
  #EndIf

  'Try To Make Grid Cells, i.e., "Cell" Class
  iHdlCount=@pGridData2.iCols*@pGridData2.iVisibleRows
  @pGridData2.pCellHandles=GlobalAlloc(%GPTR, iHdlCount * %SIZEOF_HANDLE)
  If @pGridData2.pCellHandles Then
     dwStyle=%WS_CHILD Or %WS_VISIBLE Or %WS_BORDER
     #If %Def(%DEBUG)
     Print #fp,
     Print #fp, "    i          j             iPos(j)       yLoc          hCell"
     Print #fp, "    ============================================================="
     #EndIf
     For i=0 To @pGridData2.iVisibleRows-1
       For j=0 To @pGridData2.iCols-1
         hCell=CreateWindowEx _
         ( _
           0, _
           "Cell", _
           "", _
           dwStyle, _
           iPos(j), _
           @pGridData2.iRowHeight+(i*@pGridData2.iRowHeight), _
           @pGridData2.@pColWidths[j], _
           @pGridData2.iRowHeight, _
           @pGridData2.hPane, _
           %ID_CELL+iCtr, _
           Wea.hInst, _
           Byval 0 _
         )
         @pGridData2.@pCellHandles[iCtr]=hCell
         Call SetWindowLong(hCell,4,@pGridData2.hFont)
         #If %Def(%DEBUG)
         Print #fp, "   " i, j, iPos(j), @pGridData2.iRowHeight+(i*@pGridData2.iRowHeight), hCell
         #EndIf
         Incr iCtr
       Next j
     Next i

     'Create Grid Memory
     iSize = @pGridData2.iCols * @pGridData2.iRows
     #If %Def(%DEBUG)
     Print #fp,
     Print #fp, "    Now Will Try To Create Grid Row Memory!"
     Print #fp,
     Print #fp, "    iSize                       = " iSize
     #EndIf
     @pGridData2.pGridMemory=GlobalAlloc(%GPTR,iSize*%SIZEOF_PTR)
     #If %Def(%DEBUG)
     Print #fp, "    @pGridData2.pGridMemory     = " @pGridData2.pGridMemory
     #EndIf
     @pGridData2.pTextColor=GlobalAlloc(%GPTR,iSize*%SIZEOF_PTR)
     #If %Def(%DEBUG)
     Print #fp, "    @pGridData2.pTextColor      = " @pGridData2.pTextColor
     #EndIf
     If @pGridData2.pTextColor=0 Then
        Goto Cleanup
     End If
     @pGridData2.pBackColor=GlobalAlloc(%GPTR,iSize*%SIZEOF_PTR)
     #If %Def(%DEBUG)
     Print #fp, "    @pGridData2.pBackColor      = " @pGridData2.pBackColor
     #EndIf
     If @pGridData2.pBackColor=0 Then
        Goto Cleanup
     End If
     @pGridData2.pCreatedColors=GlobalAlloc(%GPTR,(%MAX_COLORS+1)*%SIZEOF_PTR)
     #If %Def(%DEBUG)
     Print #fp, "    @pGridData2.pCreatedColors  = " @pGridData2.pCreatedColors
     #EndIf
     If @pGridData2.pCreatedColors=0 Then
        Goto Cleanup
     End If
     @pGridData2.pCreatedBrushes=GlobalAlloc(%GPTR,(%MAX_COLORS+1)*%SIZEOF_PTR)
     #If %Def(%DEBUG)
     Print #fp, "    @pGridData2.pCreatedBrushes = " @pGridData2.pCreatedBrushes
     #EndIf
     If @pGridData2.pCreatedBrushes=0 Then
        Goto Cleanup
     End If
  Else
     Goto CleanUp
  End If
  Erase strParseData()
  Erase iPos()
  #If %Def(%DEBUG)
  Print #fp,
  Print #fp, "  Leaving %WM_CREATE Case" : Print #fp,
  #EndIf
  Function=0 : Exit Function

  CleanUp:
  If @pGridData2.pColWidths Then
     Call GlobalFree(@pGridData2.pColWidths)
  End If
  If @pGridData2.pCellCtrlTypes Then
     Call GlobalFree(@pGridData2.pCellCtrlTypes)
  End If
  If @pGridData2.pCtrlHdls Then
     Call GlobalFree(@pGridData2.pCtrlHdls)
  End If
  If @pGridData2.pVButtons Then
     Call GlobalFree(@pGridData2.pVButtons)
  End If
  If @pGridData2.pCellHandles Then
     Call GlobalFree(@pGridData2.pCellHandles)
  End If
  If @pGridData2.pGridMemory Then
     Call GlobalFree(@pGridData2.pGridMemory)
  End If
  If @pGridData2.pTextColor Then
     Call GlobalFree(@pGridData2.pTextColor)
  End If
  If @pGridData2.pBackColor Then
     Call GlobalFree(@pGridData2.pBackColor)
  End If
  If @pGridData2.pCreatedColors Then
     Call GlobalFree(@pGridData2.pCreatedColors)
  End If
  If @pGridData2.pCreatedBrushes Then
     Call GlobalFree(@pGridData2.pCreatedBrushes)
  End If
  If pGridData2 Then
     Call GlobalFree(pGridData2)
  End If
  #If %Def(%DEBUG)
  Print #fp,
  Print #fp, "  Leaving %WM_CREATE Case" : Print #fp,
  #EndIf

  Function=-1
End Function

continued ...

[Frederick J. Harris]

Code: [Select]

Function fnGridProc_OnSize(Wea As WndEventArgs) As Long
  Local pGridData As GridData Ptr
  Local si As SCROLLINFO
  Local iCols As Long

  #If %Def(%DEBUG)
  Print #fp,
  Print #fp, "  Entering %WM_SIZE Case"
  #EndIf
  pGridData=GetWindowLong(Wea.hWnd,0)
  iCols=@pGridData.iCols

  'Set Up Horizontal Scrollbar
  si.cbSize=Sizeof(SCROLLINFO)
  si.fMask=%SIF_RANGE Or %SIF_PAGE Or %SIF_POS
  si.nMin=0
  si.nMax=@pGridData.@pColWidths[iCols]
  si.nPage=@pGridData.cx-33 '33 is the width of vert
  si.nPos=0                 'btns + width scroll bar + window edge
  Call SetScrollInfo(Wea.hWnd,%SB_HORZ,si,%TRUE)
  #If %Def(%DEBUG)
  Print #fp, "    Horizontal Scrollbar...."
  Print #fp, "    si.nMin    = " si.nMin
  Print #fp, "    si.nMax    = " si.nMax
  Print #fp, "    si.nPos    = " si.nPos
  #EndIf

  'Set Up Verticle Scrollbar
  si.cbSize=Sizeof(SCROLLINFO)
  si.fMask=%SIF_RANGE Or %SIF_PAGE Or %SIF_POS
  si.nMin=1
  si.nMax=@pGridData.iRows
  si.nPage=@pGridData.iVisibleRows
  si.nPos=1
  Call SetScrollInfo(Wea.hWnd,%SB_VERT,si,%TRUE)
  #If %Def(%DEBUG)
  Print #fp, "    Verticle Scrollbar...."
  Print #fp, "    si.nMin    = " si.nMin
  Print #fp, "    si.nMax    = " si.nMax
  Print #fp, "    si.nPos    = " si.nPos
  Print #fp, "  Leaving %WM_SIZE Case" : Print #fp,
  #EndIf

  fnGridProc_OnSize=0
End Function


Function fnGridProc_OnHScroll(Wea As WndEventArgs) As Long
  Local pGridData As GridData Ptr
  Local iCols,iScrollPos As Long
  Local si As SCROLLINFO

  #If %Def(%DEBUG)
  Print #fp,
  Print #fp, "  Entering %WM_HSCROLL Case"
  #EndIf
  pGridData=GetWindowLong(Wea.hWnd,0)
  iCols=@pGridData.iCols
  si.cbSize = sizeof(SCROLLINFO)   : si.fMask=%SIF_ALL
  Call GetScrollInfo(@pGridData.hGrid,%SB_HORZ,si)
  iScrollPos=si.nPos
  #If %Def(%DEBUG)
  Print #fp, "    Before Adjustments"
  Print #fp, "    si.nMin    = " si.nMin
  Print #fp, "    si.nMax    = " si.nMax
  Print #fp, "    si.nPos    = " si.nPos
  Print #fp,
  #EndIf
  Select Case As Long Lowrd(Wea.wParam)
    Case %SB_LINELEFT
      #If %Def(%DEBUG)
      Print #fp, "    Got In %SB_LINELEFT"
      #EndIf
      If si.nPos > si.nMin Then
         si.nPos=si.nPos-50
      End If
    Case %SB_PAGELEFT
      si.nPos = si.nPos - si.nPage
    Case %SB_LINERIGHT
      #If %Def(%DEBUG)
      Print #fp, "    Got In %SB_LINERIGHT"
      #EndIf
      If si.nPos<si.nMax Then
         si.nPos=si.nPos+50
      End If
    Case %SB_PAGERIGHT
      si.nPos = si.nPos + si.nPage
    Case %SB_THUMBTRACK
      si.nPos=si.nTrackPos
  End Select
  si.fMask=%SIF_POS
  Call SetScrollInfo(@pGridData.hGrid,%SB_HORZ,si,%TRUE)
  Call GetScrollInfo(@pGridData.hGrid,%SB_HORZ,si)
  If iScrollPos<>si.nPos Then   'Original
     If si.nPos=0 Then
        Call SetWindowPos(@pGridData.hPane,%HWND_TOP,0,0,@pGridData.@pColWidths[iCols],@pGridData.iPaneHeight,%SWP_SHOWWINDOW)
     Else
        Call SetWindowPos(@pGridData.hPane,%HWND_TOP,-si.nPos,0,@pGridData.@pColWidths[iCols],@pGridData.iPaneHeight,%SWP_SHOWWINDOW)
     End If
  End If
  #If %Def(%DEBUG)
  Print #fp, "    After All Adjustments"
  Print #fp, "    si.nMin    = " si.nMin
  Print #fp, "    si.nMax    = " si.nMax
  Print #fp, "    si.nPos    = " si.nPos
  Print #fp, "  Leaving %WM_HSCROLL Case"
  #EndIf

  fnGridProc_OnHScroll=0
End Function


Function fnGridProc_OnVScroll(Wea As WndEventArgs) As Long
  Local pGridData As GridData Ptr
  Local iScrollPos As Long
  Local si As SCROLLINFO
  Local hCell As Dword
  Register i As Long

  #If %Def(%DEBUG)
  Print #fp,
  Print #fp, "  Entering %WM_VSCROLL Case"
  #EndIf
  pGridData=GetWindowLong(Wea.hWnd,0)
  Call IGrid_FlushData(@pGridData.pComObj)
  si.cbSize = sizeof(SCROLLINFO)   : si.fMask=%SIF_ALL
  Call GetScrollInfo(@pGridData.hGrid,%SB_VERT,si)
  iScrollPos=si.nPos
  #If %Def(%DEBUG)
  Print #fp, "    Before Adjustments"
  Print #fp, "    si.nMin    = " si.nMin
  Print #fp, "    si.nMax    = " si.nMax
  Print #fp, "    si.nPos    = " si.nPos
  Print #fp,
  #EndIf
  Select Case As Long Lowrd(Wea.wParam)
    Case %SB_LINEUP
      #If %Def(%DEBUG)
      Print #fp, "    Got In %SB_LINEUP"
      #EndIf
      If si.nPos > si.nMin Then
         si.nPos=si.nPos-1
      End If
    Case %SB_PAGEUP
      si.nPos = si.nPos - si.nPage
    Case %SB_LINEDOWN
      #If %Def(%DEBUG)
      Print #fp, "    Got In %SB_LINEDOWN"
      #EndIf
      If si.nPos<si.nMax Then
         si.nPos=si.nPos+1
      End If
    Case %SB_PAGEDOWN
      si.nPos = si.nPos + si.nPage
    Case %SB_THUMBTRACK
      si.nPos=si.nTrackPos
  End Select
  si.fMask=%SIF_POS
  Call SetScrollInfo(@pGridData.hGrid,%SB_VERT,si,%TRUE)
  Call GetScrollInfo(@pGridData.hGrid,%SB_VERT,si)
  If iScrollPos<>si.nPos Then
     Local iNum,iLast As Long
     iNum=@pGridData.iCols*(si.nPos-1)
     iLast=(@pGridData.iCols * @pGridData.iVisibleRows) - 1
     For i=0 To iLast
       hCell=@pGridData.@pCellHandles[i]
       Call SetWindowLong(hCell,0,@pGridData.@pGridMemory[iNum])
       Call SetWindowLong(hCell,8,@pGridData.@pTextColor[iNum])
       Call SetWindowLong(hCell,12,@pGridData.@pBackColor[iNum])
       Incr iNum
     Next i
  End If
  Call InvalidateRect(@pGridData.hGrid,Byval %NULL,%TRUE)
  #If %Def(%DEBUG)
  Print #fp, "    After All Adjustments"
  Print #fp, "    si.nMin    = " si.nMin
  Print #fp, "    si.nMax    = " si.nMax
  Print #fp, "    si.nPos    = " si.nPos
  Print #fp, "  Leaving %WM_VSCROLL Case"
  #EndIf

  fnGridProc_OnVScroll=0
End Function


Function fnGridProc_OnCommand(Wea As WndEventArgs) As Long     'from other code
  Local iCellRow,iGridRow,hr As Long
  Local pGridData As GridData Ptr
  Local Vtbl,dwPtr As Dword Ptr
  Local pGrid As CGrid Ptr
  Local si As SCROLLINFO
  Register i As Long

  #If %Def(%DEBUG)
  Print #fp,
  Print #fp, "  Entering fnGridProc_OnCommand()"
  Prnt ""
  Prnt "Entering fnGridProc_OnCommand()"
  Print #fp, "    Lowrd(Wea.wParam) = " Lowrd(Wea.wParam)
  #EndIf
  If Lowrd(Wea.wParam)>20000 Then
     pGridData=GetWindowLong(Wea.hWnd,0)
     pGrid=@pGridData.pComObj
     #If %Def(%DEBUG)
     Prnt "  pGridData          = " & Str$(pGridData)
     Prnt "  @pGridData.pComObj = " & Str$(@pGridData.pComObj)
     Prnt "  pGrid              = " & Str$(pGrid)
     Prnt ""
     Prnt "  i     pGrid.@pISink[i]  @pGrid.@pISink[i]"
     Prnt "  ========================================="
     For i=0 To %MAX_CONNECTIONS-1
       Prnt " " & Str$(i) & "    " & Str$(Varptr(@pGrid.@pISink[i])) & "              " & Str$(@pGrid.@pISink[i])
     Next i
     #EndIf
     Call IGrid_FlushData(@pGridData.pComObj)
     si.cbSize = sizeof(SCROLLINFO)
     si.fMask=%SIF_POS
     Call GetScrollInfo(@pGridData.hGrid,%SB_VERT,si)
     iCellRow=Lowrd(Wea.wParam)-20000
     iGridRow=si.nPos+iCellRow-1
     #If %Def(%DEBUG)
     Prnt "  Lowrd(Wea.wParam) = " & Str$(Lowrd(Wea.wParam))
     Prnt "  iGridRow          = " & Str$(iGridRow)
     #endIf
     If @pGridData.blnRowSelected Then
        #If %Def(%DEBUG)
        Print #fp, "  We Got In Where @pGridData.blnSelected = %True!"
        Prnt "  We Got In Where @pGridData.blnSelected = %True!"
        #EndIf
        If iGridRow=@pGridData.iSelectedRow Then    'Same button clicked twice, i.e., toggled, or user wishes to unselect a row
           #If %Def(%DEBUG)
           Print #fp, "  We Got In Where iGridRow = @pGridData.iSelectedRow!"
           Prnt "  We Got In Where iGridRow = @pGridData.iSelectedRow!"
           #EndIf
           For i=1 To @pGridData.iCols
             Call IGrid_SetCellAttributes(@pGridData.pComObj,@pGridData.iSelectedRow,i,&H00FFFFFF,0)       '''Here
           Next i
           @pGridData.iSelectedRow=0 : @pGridData.blnRowSelected=%False
        Else
           #If %Def(%DEBUG)
           Print #fp, "  We Got In Where iGridRow <> @pGridData.iSelectedRow!"
           Prnt "  We Got In Where iGridRow <> @pGridData.iSelectedRow!"
           #EndIf
           For i=1 To @pGridData.iCols
             Call IGrid_SetCellAttributes(@pGridData.pComObj,@pGridData.iSelectedRow,i,&H00FFFFFF,0)        '''Here
           Next i
           @pGridData.iSelectedRow=iGridRow
           For i=1 To @pGridData.iCols
             Call IGrid_SetCellAttributes(@pGridData.pComObj,iGridRow,i,@pGridData.iSelectionBackColor,@pGridData.iSelectionTextColor) '''Here
           Next i
        End If
     Else
        #If %Def(%DEBUG)
        Prnt "  We Got In Where @pGridData.blnSelected = %False!"
        Print #fp, "  We Got In Where @pGridData.blnSelected = %False!"
        Print #fp, "  @pGridData.iSelectionBackColor         = " Hex$(@pGridData.iSelectionBackColor)
        Print #fp, "  @pGridData.iSelectionTextColor         = " Hex$(@pGridData.iSelectionTextColor)
        #EndIf
        For i=1 To @pGridData.iCols
          'Call IGrid_SetCellAttributes(@pGridData.pComObj,iGridRow,i,%Red,%White)                            '''Here
          Call IGrid_SetCellAttributes(@pGridData.pComObj,iGridRow,i,@pGridData.iSelectionBackColor,@pGridData.iSelectionTextColor)
        Next i
        @pGridData.blnRowSelected=%True
        @pGridData.iSelectedRow=iGridRow
        #If %Def(%DEBUG)
           Prnt "  @pGridData.iSelectedRow   = " & Str$(@pGridData.iSelectedRow)
           Prnt "  @pGridData.blnRowSelected = " & Str$(@pGridData.blnRowSelected)
        #EndIf
     End If
     Call IGrid_Refresh(@pGridData.pComObj)
     'Declare Function ptrRowSelection(Byval this As Dword Ptr, Byval iRow As Long, Byval iAction As Long) As Long
     For i=0 To %MAX_CONNECTIONS-1
        If @pGrid.@pISink[i] Then
           dwPtr=@pGrid.@pISink[i]
           VTbl=@dwPtr
           Call Dword @Vtbl[8] Using ptrRowSelection(dwPtr, iGridRow, @pGridData.blnRowSelected) To hr
           #If %Def(%DEBUG)
           If SUCCEEDED(hr) Then
              Prnt "  Call Dword @Vtbl[8] Using ptrRowSelection() Succeeded!"
              Prnt "  @pGridData.blnRowSelected = " & Str$(@pGridData.blnRowSelected)
           End If
           #EndIf
        End If
      Next i
      Call SetFocus(Wea.hWnd)
  End If
  #If %Def(%DEBUG)
  Print #fp, "  Leaving fnGridProc_OnCommand()"
  Prnt "Leaving fnGridProc_OnCommand()"
  Prnt ""
  Print #fp,
  #EndIf

  Function=0
End Function


Function fnGridProc_OnKeyDown(Wea As WndEventArgs) As Long
  Local pGridData As GridData Ptr
  Local dwPtr,VTbl As Dword Ptr
  Local pGrid As CGrid Ptr
  Register i As Long
  Local hr As Long

  If Wea.wParam=%VK_DELETE Then
     pGridData=GetWindowLong(Wea.hWnd,0)
     pGrid=@pGridData.pComObj
     #If %Def(%DEBUG)
     Prnt "Entering fnGridProc_OnKeyDown()"
     #EndIf
     If @pGridData.blnRowSelected=%True Then
        #If %Def(%DEBUG)
        Prnt "  A Row Is Selected!  The Selected Row Is " & Str$(@pGridData.iSelectedRow)
        #EndIf
        For i=0 To %MAX_CONNECTIONS-1
          If @pGrid.@pISink[i] Then
             dwPtr=@pGrid.@pISink[i]
             VTbl=@dwPtr
             Call Dword @Vtbl[9] Using ptrDelete(dwPtr, @pGridData.iSelectedRow) To hr
          End If
        Next i
        Call IGrid_Refresh(@pGridData.pComObj)
     Else
        #If %Def(%DEBUG)
        Prnt "  No Row Is Selected!"
        #EndIf
     End If
     #If %Def(%DEBUG)
     Prnt "Leaving fnGridProc_OnKeyDown()"
     #EndIf
  End If

  Function=0
End Function


Function fnGridProc_OnDestroy(Wea As WndEventArgs) As Long
  Local pGridData As GridData Ptr
  Local blnFree,iCtr As Long
  Local pMem As ZStr Ptr
  Register i As Long
  Register j As Long

  #If %Def(%DEBUG)
  Print #fp,
  Print #fp, "  Entering fnGridProc_OnDestroy()"
  #EndIf
  pGridData=GetWindowLong(Wea.hWnd,0)
  If pGridData Then
     #If %Def(%DEBUG)
     Print #fp, "    @pGridData.iCols           = " @pGridData.iCols
     Print #fp, "    @pGridData.iRows           = " @pGridData.iRows
     Print #fp, "    @pGridData.pColWidths      = " @pGridData.pColWidths
     Print #fp, "    @pGridData.pCellCtrlTypes  = " @pGridData.pCellCtrlTypes

     'Grid Row Memory
     Print #fp,
     Print #fp, "     i         j            iCtr          strCoordinate                 pMem       pBackColor[i]   pTextColor[i]"
     Print #fp, "    ============================================================================================================"
     iCtr=0
     For i=1 To @pGridData.iRows
       For j=1 To @pGridData.iCols
         pMem=@pGridData.@pGridMemory[iCtr]
         Print #fp, "    " i,j,iCtr,@pMem Tab(72) pMem, Hex$(@pGridData.@pBackColor[iCtr]), Hex$(@pGridData.@pTextColor[iCtr])
         Incr iCtr
        Next j
     Next i
     #EndIf

     blnFree=GlobalFree(@pGridData.pColWidths)
     #If %Def(%DEBUG)
     Print #fp,
     Print #fp, "    blnFree(pColWidths)        = " blnFree
     #EndIf

     If @pGridData.pCellCtrlTypes Then
        blnFree=GlobalFree(@pGridData.pCellCtrlTypes)
        #If %Def(%DEBUG)
        Print #fp, "    blnFree(pCellCtrlTypes)    = " blnFree
        #EndIf
     End If

     If @pGridData.pCtrlHdls Then
        blnFree=GlobalFree(@pGridData.pCtrlHdls)
        #If %Def(%DEBUG)
        Print #fp, "    blnFree(pCtrlHdls)         = " blnFree
        #EndIf
     End If

     If @pGridData.hFont Then
        blnFree=DeleteObject(@pGridData.hFont)
        #If %Def(%DEBUG)
        Print #fp, "    blnFree(hFont)             = " blnFree
        #EndIf
     End If

     #If %Def(%DEBUG)
         Print #fp,
         Print #fp,
         Print #fp, "     i         j            iCtr        blnFree"
         Print #fp, "    ==========================================="
     #EndIf
     iCtr=0
     For i=1 To @pGridData.iRows
       For j=1 To @pGridData.iCols
         pMem=@pGridData.@pGridMemory[iCtr]
         If pMem Then
            blnFree=GlobalFree(pMem)
            #If %Def(%DEBUG)
                Print #fp, "    " i,j,iCtr,blnFree
            #EndIf
         End If
         Incr iCtr
        Next j
     Next i

     blnFree=GlobalFree(@pGridData.pTextColor)
     #If %Def(%DEBUG)
     Print #fp,
     Print #fp, "    blnFree(@pGridData.pTextColor)      = " blnFree
     #EndIf
     blnFree=GlobalFree(@pGridData.pBackColor)
     #If %Def(%DEBUG)
     Print #fp, "    blnFree(@pGridData.pBackColor)      = " blnFree
     #EndIf

     #If %Def(%DEBUG)
     Print #fp,
     Print #fp, "    @pGridData.@pCreatedBrushes[0]      = " @pGridData.@pCreatedBrushes[0]
     Print #fp, "    @pGridData.@pCreatedColors[0]       = " @pGridData.@pCreatedColors[0]
     Print #fp,
     Print #fp, "    i          DeleteObject(i)"
     Print #fp, "    =========================="
     #EndIf
     For i=1 To @pGridData.@pCreatedBrushes[0]
       If @pGridData.@pCreatedBrushes[i] Then
          blnFree=DeleteObject(@pGridData.@pCreatedBrushes[i])
          #If %Def(%DEBUG)
          Print #fp, "    " i, blnFree
          #EndIf
       End If
     Next i
     blnFree=GlobalFree(@pGridData.pCreatedColors)
     #If %Def(%DEBUG)
     Print #fp,
     Print #fp, "    blnFree(@pGridData.pCreatedColors)  = " blnFree
     #EndIf

     blnFree=GlobalFree(@pGridData.pCreatedBrushes)
     #If %Def(%DEBUG)
     Print #fp,
     Print #fp, "    blnFree(@pGridData.pCreatedBrushes) = " blnFree
     #EndIf

     blnFree=GlobalFree(@pGridData.pGridMemory)
     #If %Def(%DEBUG)
     Print #fp,
     Print #fp, "    blnFree(@pGridData.pGridMemory)     = " blnFree
     #EndIf
     blnFree = GlobalFree(pGridData)
     #If %Def(%DEBUG)
     Print #fp, "    blnFree                             = " blnFree
     #EndIf
  End If
  #If %Def(%DEBUG)
  Print #fp, "  Leaving fnGridProc_OnDestroy()"
  #EndIf

  Function=0
End Function


Function fnGridProc(ByVal hWnd As Long,ByVal wMsg As Long,ByVal wParam As Long,ByVal lParam As Long) As Long
  Local wea As WndEventArgs
  Register iReturn As Long
  Register i As Long

  For i=0 To 6
    If wMsg=MsgHdlr(i).wMessage Then
       wea.hWnd=hWnd: wea.wParam=wParam: wea.lParam=lParam
       Call Dword MsgHdlr(i).dwFnPtr Using FnPtr(wea) To iReturn
       fnGridProc=iReturn
       Exit Function
    End If
  Next i

  fnGridProc=DefWindowProc(hWnd,wMsg,wParam,lParam)
End Function


Sub AttachMessageHandlers()
  ReDim MsgHdlr(6) As MessageHandler   'Associate Windows Message With Message Handlers
  MsgHdlr(3).wMessage=%WM_CREATE   :   MsgHdlr(3).dwFnPtr=CodePtr(fnGridProc_OnCreate)
  MsgHdlr(2).wMessage=%WM_SIZE     :   MsgHdlr(2).dwFnPtr=CodePtr(fnGridProc_OnSize)
  MsgHdlr(1).wMessage=%WM_HSCROLL  :   MsgHdlr(1).dwFnPtr=CodePtr(fnGridProc_OnHScroll)
  MsgHdlr(0).wMessage=%WM_VSCROLL  :   MsgHdlr(0).dwFnPtr=CodePtr(fnGridProc_OnVScroll)
  MsgHdlr(6).wMessage=%WM_KEYDOWN  :   MsgHdlr(6).dwFnPtr=CodePtr(fnGridProc_OnKeyDown)
  MsgHdlr(5).wMessage=%WM_COMMAND  :   MsgHdlr(5).dwFnPtr=CodePtr(fnGridProc_OnCommand)
  MsgHdlr(4).wMessage=%WM_DESTROY  :   MsgHdlr(4).dwFnPtr=CodePtr(fnGridProc_OnDestroy)
End Sub


Sub Initialize()
  Local uCC As INIT_COMMON_CONTROLSEX
  Local szClassName As ZStr*16
  Local wc As WNDCLASSEX

  #If %Def(%DEBUG)
      Prnt "    Entering Initialize() -- Initialize()"
  #EndIf
  uCC.dwSize = SizeOf(uCC)
  uCC.dwICC  = %ICC_LISTVIEW_CLASSES
  Call InitCommonControlsEx(uCC)
 
  szClassName="Cell"
  wc.lpszClassName=VarPtr(szClassName)             : wc.lpfnWndProc=CodePtr(fnCellProc)
  wc.cbSize=SizeOf(wc)                             : wc.style=0
  wc.cbClsExtra=0                                  : wc.cbWndExtra=16
  wc.hInstance=g_hModule                           : wc.hIcon=LoadIcon(%NULL, ByVal %IDI_APPLICATION)
  wc.hCursor=LoadCursor(%NULL, ByVal %IDC_ARROW)   : wc.hbrBackground=GetStockObject(%WHITE_BRUSH)
  wc.lpszMenuName=%NULL
  Call RegisterClassEx(wc)

  szClassName="Pane"
  wc.lpszClassName=VarPtr(szClassName)             : wc.lpfnWndProc=CodePtr(fnPaneProc)
  wc.cbSize=SizeOf(wc)                             : wc.style=0
  wc.cbClsExtra=0                                  : wc.cbWndExtra=4
  wc.hInstance=g_hModule                           : wc.hIcon=LoadIcon(%NULL, ByVal %IDI_APPLICATION)
  wc.hCursor=LoadCursor(%NULL, ByVal %IDC_ARROW)   : wc.hbrBackground=GetStockObject(%WHITE_BRUSH)
  wc.lpszMenuName=%NULL
  Call RegisterClassEx(wc)

  szClassName="Base"
  wc.lpszClassName=VarPtr(szClassName)             : wc.lpfnWndProc=CodePtr(fnBaseProc)
  wc.cbSize=SizeOf(wc)                             : wc.style=0
  wc.cbClsExtra=0                                  : wc.cbWndExtra=0
  wc.hInstance=g_hModule                           : wc.hIcon=LoadIcon(%NULL, ByVal %IDI_APPLICATION)
  wc.hCursor=LoadCursor(%NULL, ByVal %IDC_ARROW)   : wc.hbrBackground=GetStockObject(%GRAY_BRUSH)
  wc.lpszMenuName=%NULL
  Call RegisterClassEx(wc)

  szClassName="Grid"
  wc.lpszClassName=VarPtr(szClassName)             : wc.lpfnWndProc=CodePtr(fnGridProc)
  wc.cbSize=SizeOf(wc)                             : wc.style=0
  wc.cbClsExtra=0                                  : wc.cbWndExtra=4
  wc.hInstance=g_hModule                           : wc.hIcon=LoadIcon(%NULL, ByVal %IDI_APPLICATION)
  wc.hCursor=LoadCursor(%NULL, ByVal %IDC_ARROW)   : wc.hbrBackground=GetStockObject(%DKGRAY_BRUSH)
  wc.lpszMenuName=%NULL
  #If %Def(%DEBUG)
  Prnt "      GetModuleHandle()        = " & Str$(wc.hInstance)
  #EndIf
  Call RegisterClassEx(wc)

  Call AttachMessageHandlers()
  #If %Def(%DEBUG)
      Prnt "    Leaving Initialize()"
  #EndIf
End Sub


Function IConnectionPointContainer_QueryInterface(ByVal this As IConnectionPointContainer1 Ptr, ByRef iid As Guid, ByVal ppv As Dword Ptr) As Long
  #If %Def(%DEBUG)
  Prnt "    Entering IConnectionPointContainer_QueryInterface()"
  #EndIf
  @ppv=%NULL
  Select Case iid
    Case $IID_IUnknown
      #If %Def(%DEBUG)
      Prnt "      Looking For IID_IUnknown"
      #EndIf
      Decr this : @ppv=this
      Call IGrid_AddRef(this)
      #If %Def(%DEBUG)
      Prnt "    Leaving IConnectionPointContainer_QueryInterface()"
      #EndIf
      Function=%S_OK : Exit Function
    Case $IID_IFHGrid
      #If %Def(%DEBUG)
      Prnt "      Looking For IID_IFJHGrid"
      #EndIf
      Decr this : @ppv=this
      Call IGrid_AddRef(this)
      #If %Def(%DEBUG)
      Prnt "    Leaving IConnectionPointContainer_QueryInterface()"
      #EndIf
      Function=%S_OK : Exit Function
    Case $IID_IConnectionPointContainer
      #If %Def(%DEBUG)
      Prnt "      Looking For IID_IConnectionPointContainer"
      #EndIf
      Call IConnectionPointContainer_AddRef(this)
      #If %Def(%DEBUG)
      Prnt "    Leaving IConnectionPointContainer_QueryInterface()"
      #EndIf
      @ppv=this : Function=%S_OK : Exit Function
    Case $IID_IConnectionPoint
      #If %Def(%DEBUG)
      Prnt "      Looking For IID_IConnectionPoint"
      #EndIf
      Incr this : @ppv=this
      Call IConnectionPoint_AddRef(this)
      #If %Def(%DEBUG)
      Prnt "    Leaving IConnectionPointContainer_QueryInterface()"
      #EndIf
      Function=%S_OK : Exit Function
    Case Else
      #If %Def(%DEBUG)
      Prnt "        Looking For Something I Ain't Got!"
      Prnt "      Leaving IConnectionPointContainer_QueryInterface()"
      #EndIf
  End Select

  Function=%E_NOINTERFACE
End Function


Function IConnectionPointContainer_AddRef(ByVal this As IConnectionPointContainer1 Ptr) As Long
  Local pGrid As CGrid Ptr

  #If %Def(%DEBUG)
  Prnt "    Entering IConnectionPointContainer_AddRef()"
  #EndIf
  Decr this
  pGrid=this
  #If %Def(%DEBUG)
  Prnt "      @pGrid.m_cRef = " & Str$(@pGrid.m_cRef) & "  << Before"
  #EndIf
  Incr @pGrid.m_cRef
  #If %Def(%DEBUG)
  Prnt "      @pGrid.m_cRef = " & Str$(@pGrid.m_cRef) & "  << After"
  Prnt "    Leaving IConnectionPointContainer_AddRef()"
  #EndIf

  Function=@pGrid.m_cRef
End Function


Function IConnectionPointContainer_Release(ByVal this As IConnectionPointContainer1 Ptr) As Long
  Local pGrid As CGrid Ptr
  Register i As Long

  #If %Def(%DEBUG)
  Prnt "  Entering IConnectionPointContainer_Release()"
  #EndIf
  Decr this : pGrid=this
  #If %Def(%DEBUG)
  Prnt "    @pGrid.m_cRef = " & Str$(@pGrid.m_cRef) & "  << Before"
  #EndIf
  Decr @pGrid.m_cRef
  If @pGrid.m_cRef=0 Then
     #If %Def(%DEBUG)
     For i=0 To %MAX_CONNECTIONS-1
       Prnt "    " & Str$(i) & "    " & Str$(Varptr(@pGrid.@pISink[i])) & "    " & Str$(@pGrid.@pISink[i])
     Next i
     #EndIf
     Call DestroyWindow(@pGrid.hWndCtrl)
     #If %Def(%DEBUG)
     Prnt "    @pGrid.m_cRef = 0 And Will Now Delete pGrid!"
     #EndIf
     Call CoTaskMemFree(@pGrid.@pISink)  ' Or, Less Insane ... Call CoTaskMemFree(Byval @pGrid.pISink)
     Call CoTaskMemFree(@this)           ' Or, Less Insane ... Call CoTaskMemFree(Byval this)
     Call InterlockedDecrement(g_lObjs)
     Function=0
  Else
     #If %Def(%DEBUG)
     Prnt "    @pGrid.m_cRef = " & Str$(@pGrid.m_cRef) & "  << After"
     #EndIf
     Function=@pGrid.m_cRef
  End If
  #If %Def(%DEBUG)
  Prnt "  Leaving IConnectionPointContainer_Release()"
  #EndIf
End Function

continued ...

[Frederick J. Harris]

Code: [Select]

Function IConnectionPointContainer_EnumConnectionPoints(ByVal this As Dword, Byval ppEnum As Dword) As Long
  Function=%E_NOTIMPL
End Function


Function IConnectionPointContainer_FindConnectionPoint(ByVal this As IConnectionPointContainer1 Ptr, ByRef iid As Guid, ByVal ppCP As Dword Ptr) As Long
  #If %Def(%DEBUG)
  Prnt "  Entering IConnectionPointContainer_FindConnectionPoint()"
  #EndIf
  If iid=$IID_IFHGrid_Events Then
     #If %Def(%DEBUG)
     Prnt "    this  = " & Str$(this)
     Prnt "    @ppCP = " & Str$(@ppCP)
     #EndIf
     Function=IConnectionPointContainer_QueryInterface(this, $IID_IConnectionPoint, ppCP)
     #If %Def(%DEBUG)
     Prnt "    @ppCP = " & Str$(@ppCP)
     Prnt "  Leaving IConnectionPointContainer_FindConnectionPoint()" : Prnt ""
     #EndIf
  Else
     #If %Def(%DEBUG)
     Prnt "  Got Where I Shouldn't Have Gotten!!!"
     Prnt "  Leavinging IConnectionPointContainer_FindConnectionPoint()"
     #EndIf
     Function=%E_NOINTERFACE
  End If
End Function


Function IConnectionPoint_QueryInterface(ByVal this As IConnectionPoint1 Ptr, ByRef iid As Guid, ByVal ppv As Dword Ptr) As Long
  #If %Def(%DEBUG)
  Prnt "    Entering IConnectionPoint_QueryInterface()"
  #EndIf
  @ppv=%NULL
  Select Case iid
    Case $IID_IUnknown
      Decr this : Decr this
      @ppv=this
      Call IGrid_AddRef(this)
      #If %Def(%DEBUG)
      Prnt "      Looking For IID_IUnknown"
      Prnt "    Leaving IConnectionPoint_QueryInterface()"
      #EndIf
      Function=%S_OK : Exit Function
    Case $IID_IFHGrid
      Decr this : Decr this
      @ppv=this
      Call IGrid_AddRef(this)
      #If %Def(%DEBUG)
      Prnt "      Looking For IID_IFHGrid"
      Prnt "    Leaving IConnectionPoint_QueryInterface()"
      #EndIf
      Function=%S_OK : Exit Function
    Case $IID_IConnectionPointContainer
      Decr this
      @ppv=this
      Call IConnectionPointContainer_AddRef(this)
      #If %Def(%DEBUG)
      Prnt "      Looking For IID_IConnectionPointContainer"
      Prnt "    Leaving IConnectionPoint_QueryInterface()"
      #EndIf
      Function=%S_OK : Exit Function
    Case $IID_IConnectionPoint
      @ppv=this
      Call IConnectionPoint_AddRef(this)
      #If %Def(%DEBUG)
      Prnt "      Looking For IID_IConnectionPoint"
      Prnt "    Leaving IConnectionPoint_QueryInterface()"
      #EndIf
      Function=%S_OK : Exit Function
    Case Else
      #If %Def(%DEBUG)
      Prnt "        Looking For Something I Ain't Got!"
      Prnt "      Leaving IConnectionPoint_QueryInterface()"
      #EndIf
  End Select

  Function=%E_NOINTERFACE
End Function


Function IConnectionPoint_AddRef(ByVal this As IConnectionPoint1 Ptr) As Long
  Local pGrid As CGrid Ptr

  #If %Def(%DEBUG)
  Prnt "      Entering IConnectionPoint_AddRef()"
  #EndIf
  Decr this : Decr this
  pGrid=this
  #If %Def(%DEBUG)
  Prnt "        @pGrid.m_cRef = " & Str$(@pGrid.m_cRef) & "  << Before"
  #EndIf
  Incr @pGrid.m_cRef
  #If %Def(%DEBUG)
  Prnt "        @pGrid.m_cRef = " & Str$(@pGrid.m_cRef) & "  << After"
  Prnt "      Leaving IConnectionPoint_AddRef()"
  #EndIf

  Function=@pGrid.m_cRef
End Function


Function IConnectionPoint_Release(ByVal this As IConnectionPoint1 Ptr) As Long
  Local pGrid As CGrid Ptr
  Register i As Long

  #If %Def(%DEBUG)
  Prnt "  Entering IConnectionPoint_Release()"
  #EndIf
  Decr this : Decr this
  pGrid=this
  #If %Def(%DEBUG)
  Prnt "    @pGrid.m_cRef = " & Str$(@pGrid.m_cRef) & "    << Before"
  #EndIf
  Decr @pGrid.m_cRef
  If @pGrid.m_cRef=0 Then
     #If %Def(%DEBUG)
     For i=0 To %MAX_CONNECTIONS-1
       Prnt "    " & Str$(i) & "    " & Str$(Varptr(@pGrid.@pISink[i])) & "    " & Str$(@pGrid.@pISink[i])
     Next i
     #EndIf
     Call DestroyWindow(@pGrid.hWndCtrl)
     #If %Def(%DEBUG)
     Prnt "    @pGrid.m_cRef = 0 And Will Now Delete pGrid!"
     #EndIf
     Call CoTaskMemFree(@pGrid.@pISink)  ' Or, Less Insane ... Call CoTaskMemFree(Byval @pGrid.pISink)
     Call CoTaskMemFree(@this)           ' Or, Less Insane ... Call CoTaskMemFree(Byval this)
     Call InterlockedDecrement(g_lObjs)
     #If %Def(%DEBUG)
     Prnt "  Leaving IConnectionPoint_Release()"
     #EndIf
     Function=0
  Else
     #If %Def(%DEBUG)
     Prnt "    @pGrid.m_cRef = " & Str$(@pGrid.m_cRef) & "    << After"
     Prnt "  Leaving IConnectionPoint_Release()"
     #EndIf
     Function=@pGrid.m_cRef
  End If
End Function


Function IConnectionPoint_GetConnectionInterface(Byval this As Dword, Byref iid As Dword) As Long
  Function=%E_NOTIMPL
End Function


Function IConnectionPoint_GetConnectionPointContainer(Byval this As Dword, Byval ppCPC As Dword) As Long
  Function=%E_NOTIMPL
End Function


Function IConnectionPoint_Advise(Byval this As IConnectionPoint1 Ptr, Byval pUnkSink As Dword Ptr, Byval pdwCookie As Dword Ptr) As Long
  Local blnFoundOpenSlot As Long
  Local Vtbl,dwPtr As Dword Ptr
  Local pGrid As CGrid Ptr
  Register i As Long
  Local hr As Long

  #If %Def(%DEBUG)
  Prnt "  Entering IConnectionPoint_Advise()!  Grab Your Hardhat And Hang On Tight!"
  Prnt "    this               = " & Str$(this)
  #EndIf
  Decr this : Decr this
  pGrid=this
  #If %Def(%DEBUG)
  Prnt "    pGrid              = " & Str$(pGrid)
  Prnt "    @pGrid.hControl    = " & Str$(@pGrid.hWndCtrl)
  Prnt "    pUnkSink           = " & Str$(pUnkSink)
  #EndIf
  Vtbl=@pUnkSink
  #If %Def(%DEBUG)
  Prnt "    Vtbl               = " & Str$(Vtbl)
  Prnt "    @Vtbl[0]           = " & Str$(@Vtbl[0])
  #EndIf
  Call Dword @Vtbl[0] Using ptrQueryInterface(pUnkSink,$IID_IFHGrid_Events,Varptr(dwPtr)) To hr
  #If %Def(%DEBUG)
  Prnt "    dwPtr              = " & Str$(dwPtr)
  #EndIf
  If SUCCEEDED(hr) Then
     #If %Def(%DEBUG)
     Prnt "    Call Dword Succeeded!"
     #EndIf
     For i=0 To %MAX_CONNECTIONS-1
       If @pGrid.@pISink[i]=0 Then
          blnFoundOpenSlot=%True
          #If %Def(%DEBUG)
          Prnt "    " & Str$(i) & "    " & Str$(Varptr(@pGrid.@pISink[i])) & "    " & Str$(@pGrid.@pISink[i]) & "  Found Open Slot!"
          #EndIf
          Exit For
       Else
          #If %Def(%DEBUG)
          Prnt "    " & Str$(i) & "    " & Str$(Varptr(@pGrid.@pISink[i])) & "    " & Str$(@pGrid.@pISink[i])
          #EndIf
       End If
     Next i
     If blnFoundOpenSlot Then
        #If %Def(%DEBUG)
        Prnt "    Will Be Able To Store Connection Point!"
        #EndIf
        @pGrid.@pISink[i]=dwPtr
        @pdwCookie=i
        hr=%S_Ok
     Else
        @pdwCookie=0
        hr=%CONNECT_E_ADVISELIMIT
     End If
  End If
  #If %Def(%DEBUG)
  Prnt "  Leaving IConnectionPoint_Advise() And Still In One Piece!" : Prnt ""
  #EndIf

  Function=hr
End Function


Function IConnectionPoint_Unadvise(Byval this As IConnectionPoint1 Ptr, Byval dwCookie As Dword) As Long
  Local Vtbl,dwPtr As Dword Ptr
  Local pGrid As CGrid Ptr
  Local iReturn As Long

  #If %Def(%DEBUG)
  Prnt "  Entering IConnectionPoint_Unadvise()"
  Prnt "    this            = " & Str$(this)
  Prnt "    dwCookie        = " & Str$(dwCookie)
  #EndIf
  Decr this : Decr this
  pGrid=this
  #If %Def(%DEBUG)
  Prnt "    @pGrid.hWndCtrl = " & Str$(@pGrid.hWndCtrl)
  #EndIf
  dwPtr=@pGrid.@pISink[dwCookie]
  Vtbl=@dwPtr
  #If %Def(%DEBUG)
  Prnt "    dwPtr           = " & Str$(dwPtr)
  #EndIf
  Call Dword @Vtbl[2] Using ptrRelease(dwPtr) To iReturn
  If SUCCEEDED(iReturn) Then
     @pGrid.@pISink[dwCookie]=0
     #If %Def(%DEBUG)
     Prnt "    IGrid_Events::Release() Succeeded!"
     #EndIf
  End If
  #If %Def(%DEBUG)
  Prnt "    Release() Returned " & Str$(iReturn)
  Prnt "  Leaving IConnectionPoint_Unadvise()" : Prnt ""
  #EndIf

  Function=%NOERROR
End Function


Function IConnectionPoint_EnumConnections(Byval this As Dword, Byval ppEnum As Dword) As Long
  Function=%E_NOTIMPL
End Function


Function IClassFactory_AddRef(ByVal this As IClassFactory1 Ptr) As Long
  #If %Def(%DEBUG)
  Prnt "      Entering IClassFactory_AddRef()"
  #EndIf
  Call InterlockedIncrement(g_lObjs)
  #If %Def(%DEBUG)
  Prnt "        g_lObjs = " & Str$(g_lObjs)
  Prnt "      Leaving IClassFactory_AddRef()"
  #EndIf

  IClassFactory_AddRef=g_lObjs
End Function


Function IClassFactory_Release(ByVal this As IClassFactory1 Ptr) As Long
  #If %Def(%DEBUG)
  Prnt "    Entering IClassFactory_Release()"
  #EndIf
  Call InterlockedDecrement(g_lObjs)
  #If %Def(%DEBUG)
  Prnt "      g_lObjs = " & Str$(g_lObjs)
  Prnt "    Leaving IClassFactory_Release()"
  #EndIf

  IClassFactory_Release=g_lObjs
End Function


Function IClassFactory_QueryInterface(ByVal this As IClassFactory1 Ptr, ByRef RefIID As Guid, ByVal pCF As Dword Ptr) As Long
  #If %Def(%DEBUG)
  Prnt "    Entering IClassFactory_QueryInterface()"
  #EndIf
  @pCF=0
  If RefIID=$IID_IUnknown Or RefIID=$IID_IClassFactory Then
     Call IClassFactory_AddRef(this)
     @pCF=this
     #If %Def(%DEBUG)
     Prnt "      this = " & Str$(this)
     Prnt "    Leaving IClassFactory_QueryInterface()"
     #EndIf
     Function=%NOERROR : Exit Function
  End If
  #If %Def(%DEBUG)
  Prnt "    Leaving IClassFactory_QueryInterface() Empty Handed!"
  #EndIf

  Function=%E_NoInterface
End Function


Function IClassFactory_CreateInstance(ByVal this As IClassFactory1 Ptr, ByVal pUnknown As Dword, ByRef RefIID As Guid, Byval ppv As Dword Ptr) As Long
  Local pIGrid As IGrid Ptr
  Local pGrid As CGrid Ptr
  Local hr As Long

  #If %Def(%DEBUG)
  Prnt "  Entering IClassFactory_CreateInstance()"
  #EndIf
  @ppv=%NULL
  If pUnknown Then
     hr=%CLASS_E_NOAGGREGATION
  Else
     pGrid=CoTaskMemAlloc(SizeOf(CGrid))
     #If %Def(%DEBUG)
     Prnt "    pGrid                      = " & Str$(pGrid)
     #EndIf
     If pGrid Then
        @pGrid.pISink=CoTaskMemAlloc(%MAX_CONNECTIONS * %SIZEOF_PTR)
        If @pGrid.pISink Then
           Poke Dword, @pGrid.pISink, 0, 0, 0, 0    'Call memset(Byval @pGrid.pISink,0,%MAX_CONNECTIONS*%SIZEOF_PTR)
           @pGrid.lpIGridVtbl = VarPtr(IGrid_Vtbl)
           @pGrid.lpICPCVtbl  = VarPtr(IConnPointContainer_Vtbl)
           @pGrid.lpICPVtbl   = Varptr(IConnPoint_Vtbl)
           #If %Def(%DEBUG)
           Prnt "    Varptr(@pGrid.lpIGridVtbl) = " & Str$(Varptr(@pGrid.lpIGridVtbl))
           Prnt "    Varptr(@pGrid.lpICPCVtbl)  = " & Str$(Varptr(@pGrid.lpICPCVtbl))
           Prnt "    Varptr(@pGrid.lpICPVtbl)   = " & Str$(Varptr(@pGrid.lpICPVtbl))
           Prnt "    @pGrid.pISink              = " & Str$(@pGrid.pISink)
           #EndIf
           @pGrid.m_cRef=0 : @pGrid.hWndCtrl=0
           pIGrid=pGrid
           #If %Def(%DEBUG)
           Prnt "    @ppv                       = " & Str$(@ppv) & "  << Before QueryInterface() Call"
           #EndIf
           hr= IGrid_QueryInterface(pIGrid,RefIID,ppv)
           #If %Def(%DEBUG)
           Prnt "    @ppv                       = " & Str$(@ppv) & "  << After QueryInterface() Call"
           #EndIf
           If SUCCEEDED(hr) Then
              Call InterlockedIncrement(g_lObjs)
           Else
              Call CoTaskMemFree(Byval pGrid)
           End If
        Else
           Call CoTaskMemFree(Byval pGrid)
           hr=%E_OutOfMemory
        End If
     Else
        hr=%E_OutOfMemory
     End If
  End If
  #If %Def(%DEBUG)
  Prnt "  Leaving IClassFactory_CreateInstance()"
  Prnt ""
  #EndIf

  IClassFactory_CreateInstance=hr
End Function


Function IClassFactory_LockServer(ByVal this As IClassFactory1 Ptr, Byval flock As Long) As Long
  If flock Then
     Call InterlockedIncrement(g_lLocks)
  Else
     Call InterlockedDecrement(g_lLocks)
  End If

  IClassFactory_LockServer=%NOERROR
End Function


Function DllCanUnloadNow Alias "DllCanUnloadNow" () Export As Long
  #If %Def(%DEBUG)
  Prnt "Entering DllCanUnloadNow()"
  #EndIf
  If g_lObjs = 0 And g_lLocks = 0 Then
     #If %Def(%DEBUG)
     Prnt "  I'm Outta Here! (dll is unloaded)"
     #EndIf
     Function=%S_OK
  Else
     #If %Def(%DEBUG)
     Prnt "  The System Wants Rid Of Me But I Won't Go!"
     #EndIf
     Function=%S_FALSE
  End If
  #If %Def(%DEBUG)
  Prnt "Leaving DllCanUnloadNow()"
  #EndIf
End Function


Function DllGetClassObjectImpl Alias "DllGetClassObject" (ByRef RefClsid As Guid, ByRef iid As Guid, ByVal pClassFactory As Dword Ptr) Export As Long
  Local hr As Long

  #If %Def(%DEBUG)
  Prnt "" : Prnt "  Entering DllGetClassObjectImpl()"
  #EndIf
  If RefClsid=$CLSID_FHGrid Then
     hr=IClassFactory_QueryInterface(VarPtr(CDClassFactory),iid,pClassFactory)
     If FAILED(hr) Then
        pClassFactory=0
        hr=%CLASS_E_CLASSNOTAVAILABLE
     Else
        Call Initialize()
        #If %Def(%DEBUG)
        Prnt "    IClassFactory_QueryInterface() For iid Succeeded!"
        #EndIf
     End If
  End If
  #If %Def(%DEBUG)
  Prnt "  Leaving DllGetClassObjectImpl()" : Prnt ""
  #EndIf

  Function=hr
End Function


Function SetKeyAndValue(Byref szKey As ZStr, Byref szSubKey As ZStr, Byref szValue As ZStr) As Long   'Original
  Local szKeyBuf As ZStr*1024
  Local lResult As Long
  Local hKey As Dword

  If szKey <> "" Then
     szKeyBuf = szKey
     If szSubKey <> "" Then
        szKeyBuf = szKeyBuf + "\" + szSubKey
     End If
     lResult=RegCreateKeyEx(%HKEY_CLASSES_ROOT, szKeyBuf, 0 ,Byval %NULL, %REG_OPTION_NON_VOLATILE, %KEY_ALL_ACCESS, Byval %NULL, hKey, %NULL)
     If lResult<>%ERROR_SUCCESS Then
        Function=%FALSE : Exit Function
     End If
     If szValue<>"" Then
        Call RegSetValueEx(hKey, Byval %NULL, Byval 0, %REG_SZ, szValue, Len(szValue) * %SIZEOF_CHAR + %SIZEOF_CHAR)
     End If
     Call RegCloseKey(hKey)
  Else
     Function=%FALSE : Exit Function
  End If

  Function=%TRUE
End Function


Function RecursiveDeleteKey(Byval hKeyParent As Dword, Byref lpszKeyChild As ZStr) As Long          'Original
  Local dwSize,hKeyChild As Dword
  Local szBuffer As ZStr*256
  Local time As FILETIME
  Local lRes As Long

  dwSize=256
  lRes=RegOpenKeyEx(hKeyParent,lpszKeyChild,0,%KEY_ALL_ACCESS,hKeyChild)
  If lRes<>%ERROR_SUCCESS Then
     Function=lRes
     Exit Function
  End If
  While(RegEnumKeyEx(hKeyChild, 0, szBuffer, dwSize, Byval 0, Byval 0, Byval 0, time)=%S_OK)
    lRes=RecursiveDeleteKey(hKeyChild,szBuffer)  'Delete the decendents of this child.
    If lRes<>%ERROR_SUCCESS Then
       Call RegCloseKey(hKeyChild)
       Function=lRes
       Exit Function
    End If
    dwSize=256
  Loop
  Call RegCloseKey(hKeyChild)

  Function=RegDeleteKey(hKeyParent,lpszKeyChild)  'Delete this child.
End Function


Function RegisterServer(Byref szFileName As ZStr, Byref ClassId As Guid, Byref LibId As Guid, Byref szFriendlyName As ZStr, Byref szVerIndProgID As ZStr, Byref szProgID As ZStr) As Long
  Local szClsid As ZStr*96, szLibid As ZStr*96, szKey As ZStr*128
  Local iReturn As Long

  #If %Def(%DEBUG)
  Print #fp, "    Entering RegisterServer()"
  Print #fp, "      szFileName      = " szFileName
  Print #fp, "      szFriendlyName  = " szFriendlyName
  Print #fp, "      szVerIndProgID  = " szVerIndProgID
  Print #fp, "      szProgID        = " szProgID
  #EndIf
  szClsid=GuidTxt$(ClassId)
  szLibid=GuidTxt$(LibId)
  #If %Def(%DEBUG)
  Print #fp, "      szClsid = " szClsid
  Print #fp, "      szLibid = " szLibid
  #EndIf
  If szClsid <> "" And szLibid <> "" Then
     szKey="CLSID\" & szClsid
     If IsFalse(SetKeyAndValue(szKey, Byval %NULL, szFriendlyName)) Then
        #If %Def(%DEBUG)
        Print #fp, "      szFriendlyName = " szFriendlyName
        Print #fp, "    Leaving RegisterServer() Early!"
        #EndIf
        Function=%E_FAIL : Exit Function
     End If
     If IsFalse(SetKeyAndValue(szKey, "InprocServer32", szFileName)) Then
        #If %Def(%DEBUG)
        Print #fp, "      szFileName     = " szFileName
        Print #fp, "    Leaving RegisterServer() Early!"
        #EndIf
        Function=%E_FAIL : Exit Function
     End If
     If IsFalse(SetKeyAndValue(szKey, "ProgID", szProgID)) Then
        #If %Def(%DEBUG)
        Print #fp, "      szProgID       = " szProgID
        Print #fp, "    Leaving RegisterServer() Early!"
        #EndIf
        Function=%E_FAIL : Exit Function
     End If
     If IsFalse(SetKeyAndValue(szKey, "VersionIndependentProgID", szVerIndProgID)) Then
        #If %Def(%DEBUG)
        Print #fp, "      szVerIndProgID = " szVerIndProgID
        Print #fp, "    Leaving RegisterServer() Early!"
        #EndIf
        Function=%E_FAIL : Exit Function
     End If
     If IsFalse(SetKeyAndValue(szKey, "TypeLib", szLibid)) Then
        #If %Def(%DEBUG)
        Print #fp, "      szLibid        = " szLibid
        Print #fp, "    Leaving RegisterServer() Early!"
        #EndIf
        Function=%E_FAIL : Exit Function
     End If
     If IsFalse(SetKeyAndValue(szVerIndProgID,Byval %NULL, szFriendlyName)) Then
        #If %Def(%DEBUG)
        Print #fp, "      szVerIndProgID = " szVerIndProgID
        Print #fp, "      szFriendlyName = " szFriendlyName
        Print #fp, "    Leaving RegisterServer() Early!"
        #EndIf
        Function=%E_FAIL : Exit Function
     End If
     If IsFalse(SetKeyAndValue(szVerIndProgID, "CLSID", szClsid)) Then
        #If %Def(%DEBUG)
        Print #fp, "      szClsid        = " szClsid
        Print #fp, "    Leaving RegisterServer() Early!"
        #EndIf
        Function=%E_FAIL : Exit Function
     End If
     If IsFalse(SetKeyAndValue(szVerIndProgID, "CurVer", szProgID)) Then
        #If %Def(%DEBUG)
        Print #fp, "      szProgID       = " szProgID
        Print #fp, "    Leaving RegisterServer() Early!"
        #EndIf
        Function=%E_FAIL : Exit Function
     End If
     If IsFalse(SetKeyAndValue(szProgID, Byval %NULL, szFriendlyName)) Then
        #If %Def(%DEBUG)
        Print #fp, "      szFriendlyName = " szFriendlyName
        Print #fp, "    Leaving RegisterServer() Early!"
        #EndIf
        Function=%E_FAIL : Exit Function
     End If
     If IsFalse(SetKeyAndValue(szProgID, "CLSID", szClsid)) Then
        #If %Def(%DEBUG)
        Print #fp, "      szClsid        = " szClsid
        Print #fp, "    Leaving RegisterServer() Early!"
        #EndIf
        Function=%E_FAIL : Exit Function
     End If
     #If %Def(%DEBUG)
     Print #fp, "      RegisterServer = %S_OK!
     Print #fp, "    Leaving RegisterServer()"
     #EndIf
     Function=%S_OK      : Exit Function
  Else
     #If %Def(%DEBUG)
     Print #fp, "      RegisterServer  = %E_FAIL!"
     Print #fp, "    Leaving RegisterServer() Early!"
     #EndIf
     Function=%E_FAIL    : Exit Function
  End If
End Function


Function UnregisterServer(Byref ClassId As Guid, Byref szVerIndProgID As ZStr, Byref szProgID As ZStr) As Long
  Local szClsid As ZStr*48, szKey As ZStr*64
  Local lResult As Long

  #If %Def(%DEBUG)
  Print #fp, "    Entering UnRegisterServer()"
  Print #fp, "      szVerIndProgID = " szVerIndProgID
  Print #fp, "      szProgID       = " szProgID
  #EndIf
  szClsid=GuidTxt$(ClassId)
  If szClsid<>"" Then
     szKey="CLSID\"+szClsid
     lResult=RecursiveDeleteKey(%HKEY_CLASSES_ROOT,szKey)
     If lResult<>%ERROR_SUCCESS Then
        #If %Def(%DEBUG)
        Print #fp, "    Got In Where RecursiveDeleteKey() Failed!"
        Print #fp, "  Leaving UnregisterServer()"
        #EndIf
        Function=%E_FAIL
        Exit Function
     End If
     lResult=RecursiveDeleteKey(%HKEY_CLASSES_ROOT, szVerIndProgID)    'Delete the version-independent ProgID Key.
     If lResult<>%ERROR_SUCCESS Then
        Function=%E_FAIL
        Exit Function
     End If
     lResult=recursiveDeleteKey(%HKEY_CLASSES_ROOT, szProgID)          'Delete the ProgID key.
     If lResult<>%ERROR_SUCCESS Then
        Function=%E_FAIL
        Exit Function
     End If
     #If %Def(%DEBUG)
     Print #fp, "    Leaving UnregisterServer()"
     #EndIf
  Else
     Function=%E_FAIL
     Exit Function
  End If

  Function=%S_OK
End Function


Function DllRegisterServer Alias "DllRegisterServer" () Export As Long
  Local szFriendlyName As ZStr*64, szVerIndProgID As ZStr*32, szProgID As ZStr*32
  Local strAsciPath,strWideCharPath,strPath As BStr
  Local pTypeLib,Vtbl As Dword Ptr
  Local hr,iBytesReturned As Long
  Local szPath As ZStr*256

  #If %Def(%DEBUG)
  Print #fp, "  Entering DllRegisterServer()"
  #EndIf
  If GetModuleFileName(g_hModule, szPath, 256) Then
     #If %Def(%DEBUG)
     Print #fp, "    szPath = " szPath
     #EndIf
     #If %Def(%UNICODE)
         strWideCharPath=szPath
     #Else
         strAsciPath=szPath
         strWideCharPath=UCode$(strAsciPath & $Nul)
     #EndIf
     hr=LoadTypeLibEx(Byval Strptr(strWideCharPath), %REGKIND_REGISTER, pTypeLib)
     If SUCCEEDED(hr) Then
        #If %Def(%DEBUG)
        Print #fp, "    LoadTypeLib() Succeeded!"
        #EndIf
        Vtbl=@pTypeLib
        Call Dword @Vtbl[2] Using ptrRelease(pTypeLib)
        szFriendlyName  =  "Fred Harris Grid Control v8"
        szVerIndProgID  =  "FHGrid8.Grid"
        szProgID        =  "FHGrid8.Grid.1"
        #If %Def(%DEBUG)
        Print #fp, "    szFriendlyName = " szFriendlyName
        Print #fp, "    szVerIndProgID = " szVerIndProgID
        Print #fp, "    szProgID       = " szProgID
        #EndIf
        hr=RegisterServer(szPath, $CLSID_FHGrid, $IID_LIBID_FHGrid, szFriendlyName, szVerIndProgID, szProgID)
        #If %Def(%DEBUG)
        If SUCCEEDED(hr) Then
           Print #fp, "    RegisterServer() Succeeded!"
        Else
           Print #fp, "    RegisterServer() Failed!"
        End If
        #EndIf
     Else
        #If %Def(%DEBUG)
        Print #fp, "    LoadTypeLib() Failed!"
        #EndIf
     End If
  End If
  #If %Def(%DEBUG)
  Print #fp, "  Leaving DllRegisterServer()"
  #EndIf

  Function=hr
End Function


Function DllUnregisterServer Alias "DllUnregisterServer" () Export As Long
  Local szVerIndProgID As ZStr*32, szProgID As ZStr*32
  Local hr As Long

  #If %Def(%DEBUG)
  Print #fp, "  Entering DllUnrrgisterServer()"
  #EndIf
  hr=UnRegisterTypeLib($IID_LIBID_FHGrid, 1, 0, %LANG_NEUTRAL, %SYS_WIN32)
  If SUCCEEDED(hr) Then
     szVerIndProgID  =  "FHGrid8.Grid"
     szProgID        =  "FHGrid8.Grid.1"
     hr=UnregisterServer($CLSID_FHGrid, szVerIndProgID, szProgID)
     #If %Def(%DEBUG)
     Print #fp, "    Got In Where UnRegisterTypeLib() Succeeded!"
     #EndIf
  Else
     #If %Def(%DEBUG)
     Print #fp, "    Got In Where UnRegisterTypeLib() Failed!"
     #EndIf
  End If
  #If %Def(%DEBUG)
  Print #fp, "  Leaving DllUnrrgisterServer()"
  #EndIf

  Function=hr
End Function


Function DllMain(ByVal hInstance As Long, ByVal fwdReason As Long, ByVal lpvReserved As Long) Export As Long
  Select Case As Long fwdReason
    Case %DLL_PROCESS_ATTACH
      #If %Def(%DEBUG)
      fp=Freefile
      Open "C:\Code\PwrBasic\PBWin10\COM\Grids\v8\Output.txt" For Output As #fp
      Print #fp, "Entering DllMain() -- %DLL_PROCESS_ATTACH"
      #EndIf
      Call DisableThreadLibraryCalls(hInstance)
      g_hModule         =  hInstance
      g_CtrlId          =  1500

      IClassFactory_Vtbl.QueryInterface               = CodePtr(IClassFactory_QueryInterface)
      IClassFactory_Vtbl.AddRef                       = CodePtr(IClassFactory_AddRef)
      IClassFactory_Vtbl.Release                      = CodePtr(IClassFactory_Release)
      IClassFactory_Vtbl.CreateInstance               = CodePtr(IClassFactory_CreateInstance)
      IClassFactory_Vtbl.LockServer                   = CodePtr(IClassFactory_LockServer)
      CDClassFactory.lpVtbl                           = VarPtr(IClassFactory_Vtbl)

      IGrid_Vtbl.QueryInterface                       = CodePtr(IGrid_QueryInterface)
      IGrid_Vtbl.AddRef                               = CodePtr(IGrid_AddRef)
      IGrid_Vtbl.Release                              = CodePtr(IGrid_Release)
      IGrid_Vtbl.CreateGrid                           = CodePtr(IGrid_CreateGrid)
      IGrid_Vtbl.SetRowCount                          = CodePtr(IGrid_SetRowCount)
      IGrid_Vtbl.SetData                              = CodePtr(IGrid_SetData)
      IGrid_Vtbl.GetData                              = CodePtr(IGrid_GetData)
      IGrid_Vtbl.FlushData                            = CodePtr(IGrid_FlushData)
      IGrid_Vtbl.Refresh                              = CodePtr(IGrid_Refresh)
      IGrid_Vtbl.GetCtrlId                            = CodePtr(IGrid_GetCtrlId)
      IGrid_Vtbl.GethGrid                             = CodePtr(IGrid_GethGrid)
      IGrid_Vtbl.GethComboBox                         = CodePtr(IGrid_GethComboBox)
      IGrid_Vtbl.SetCellAttributes                    = CodePtr(IGrid_SetCellAttributes)
      IGrid_Vtbl.DeleteRow                            = Codeptr(IGrid_DeleteRow)

      IConnPointContainer_Vtbl.QueryInterface         = CodePtr(IConnectionPointContainer_QueryInterface)
      IConnPointContainer_Vtbl.AddRef                 = CodePtr(IConnectionPointContainer_AddRef)
      IConnPointContainer_Vtbl.Release                = CodePtr(IConnectionPointContainer_Release)
      IConnPointContainer_Vtbl.EnumConnectionPoints   = CodePtr(IConnectionPointContainer_EnumConnectionPoints)
      IConnPointContainer_Vtbl.FindConnectionPoint    = CodePtr(IConnectionPointContainer_FindConnectionPoint)

      IConnPoint_Vtbl.QueryInterface                  = CodePtr(IConnectionPoint_QueryInterface)
      IConnPoint_Vtbl.AddRef                          = CodePtr(IConnectionPoint_AddRef)
      IConnPoint_Vtbl.Release                         = CodePtr(IConnectionPoint_Release)
      IConnPoint_Vtbl.GetConnectionInterface          = CodePtr(IConnectionPoint_GetConnectionInterface)
      IConnPoint_Vtbl.GetConnectionPointContainer     = CodePtr(IConnectionPoint_GetConnectionPointContainer)
      IConnPoint_Vtbl.Advise                          = CodePtr(IConnectionPoint_Advise)
      IConnPoint_Vtbl.Unadvise                        = CodePtr(IConnectionPoint_Unadvise)
      IConnPoint_Vtbl.EnumConnections                 = CodePtr(IConnectionPoint_EnumConnections)
    Case %DLL_PROCESS_DETACH
      #If %Def(%DEBUG)
      Print #fp, "Leaving DllMain() -- %DLL_PROCESS_DETACH"
      Close #fp
      #EndIf
  End Select

  DllMain=%TRUE
End Function

Here is the FHGrid8.idl file which the midl compiler needs to create the type library file FHGrid8.tlb ...

Code: [Select]

// fhGrid8.idl
import "unknwn.idl";

[object, uuid(20000000-0000-0000-0000-000000000085), oleautomation] interface IGrid : IUnknown
{
 HRESULT CreateGrid
 (
  [in] int  hParent,
  [in] BSTR strSetup,
  [in] int  x,
  [in] int  y,
  [in] int  cx,
  [in] int  cy,
  [in] int  iRows,
  [in] int  iCols,
  [in] int  iRowHt,
  [in] int  iSelectionBackColor,
  [in] int  iSelectionTextColor,
  [in] BSTR strFontName,
  [in] int  iFontSize,
  [in] int  iFontWeight
 );
 HRESULT SetRowCount([in] int iRowCount, [in] int blnForce);
 HRESULT SetData([in] int iRow, [in] int iCol, [in] BSTR strData);
 HRESULT GetData([in] int iRow, [in] int iCol, [out, retval] BSTR* strData);
 HRESULT FlushData();
 HRESULT Refresh();
 HRESULT GetCtrlId([out, retval] int* iCtrlId);
 HRESULT GethGrid([out, retval] int* hWnd);
 HRESULT GethComboBox([in] int iCol, [out, retval] int* hCombo);
 HRESULT SetCellAttributes([in] int iRow, [in] int iCol, [in] int iBackColor, [in] int iTextColor);
 HRESULT DeleteRow([in] int iRow);
};

[object, uuid(20000000-0000-0000-0000-000000000086), oleautomation] interface IGridEvents : IUnknown
{
 HRESULT Grid_OnKeyPress([in] int iKeyCode, [in] int iKeyData, [in] int iRow, [in] int iCol, [out] int* blnCancel);
 HRESULT Grid_OnKeyDown([in] int KeyCode, [in] int iKeyData, [in] int iRow, [in] int iCol, [out] int* blnCancel);
 HRESULT Grid_OnLButtonDown([in] int iCellRow, [in] int iGridRow, [in] int iCol);
 HRESULT Grid_OnLButtonDblClk([in] int iCellRow, [in] int iGridRow, [in] int iCol);
 HRESULT Grid_OnPaste([in] int iCellRow, [in] int iGridRow, [in] int iCol);
 HRESULT Grid_OnRowSelection([in] int iRow, [in] int iAction);
 HRESULT Grid_OnDelete([in] int iRow);
};

[uuid(20000000-0000-0000-0000-000000000087), helpstring("FHGrid8 TypeLib"), version(1.0)] library FHGrid8Library
{
 importlib("stdole32.tlb");
 interface IGrid;
 interface IGridEvents;
 [uuid(20000000-0000-0000-0000-000000000084)] coclass FHGrid8
 {
           interface IGrid;
  [source] interface IGridEvents;
 }
};

I'll attach the FHGrid8.tlb file.

If you want to create the dll to follow along here you'll need the FHGrid8.tlb file, because the 16th line of the dll's code references it as follows ...

Code: [Select]

#Resource Typelib, 1, "FHGrid8.tlb"

That line causes the type library to be written into the dll itself.  After compiling the dll you'll have to register it with RegSvr32.

[Frederick J. Harris]

Code: [Select]

' PBClient1.bas
'
' The program below creates an instance of the grid and uses PowerBASIC's WithEvents methodology
' to set up the event handling class and sink.  There is a button on the form that retrieves
' whatever is in cell 3, 2.  Another button colors several rows in the grid several different
' colors.  You select a row by clicking one of the small vertical aligned buttons at far left
' in the grid adjacent to the row you want to select.  Clicking the same button de-selects it.
' Clicking a different button changes the selection.  When a row is selected you can delete
' the row by using the [Delete] key.  In this example a combo box with several strings in it
' were added to the 5th row.
'
#Compile                      Exe  "PBClient1.exe"
#Dim                          All
%UNICODE                      = 1
#If %Def(%UNICODE)
    Macro ZStr                = WStringz
    Macro BStr                = WString
    %SIZEOF_CHAR              = 2
#Else
    Macro ZStr                = Asciiz
    Macro BStr                = String
    %SIZEOF_CHAR              = 1
#EndIf
$CLSID_FHGrid                 = GUID$("{20000000-0000-0000-0000-000000000084}")
$IID_IFHGrid                  = GUID$("{20000000-0000-0000-0000-000000000085}")
$IID_IGridEvents              = GUID$("{20000000-0000-0000-0000-000000000086}")
%IDC_RETRIEVE                 = 1500
%IDC_COLOR                    = 1505
%IDC_UNLOAD_GRID              = 1510
%IDC_GET_SELECTED_ROW         = 1515
#Include                      "Win32Api.inc"           ' Using PowerBASIC Includes.

Type WndEventArgs
  wParam                      As Long
  lParam                      As Long
  hWnd                        As Dword
  hInst                       As Dword
End Type

Declare Function FnPtr(wea As WndEventArgs) As Long

Type MessageHandler
  wMessage                    As Long
  dwFnPtr                     As Dword
End Type

Global MsgHdlr()              As MessageHandler


Sub Prnt(strLn As BStr)
  Local iLen, iWritten As Long
  Local hStdOutput As Dword
  Local strNew As BStr
  hStdOutput=GetStdHandle(%STD_OUTPUT_HANDLE)
  strNew=strLn + $CrLf
  iLen = Len(strNew)
  WriteConsole(hStdOutput, Byval Strptr(strNew), iLen, iWritten, Byval 0)
End Sub


Interface IGrid $IID_IFHGrid  : Inherit IAutomation    ' This is the Grid's Interface (a standard incoming Interface, i.e.,
  Method CreateGrid _                                  ' method calls are coming into the grid from the client).
  ( _
    Byval hParent             As Long, _
    Byval strSetup            As BStr, _
    Byval x                   As Long, _
    Byval y                   As Long, _
    Byval cx                  As Long, _
    Byval cy                  As Long, _
    Byval iRows               As Long, _
    Byval iCols               As Long, _
    Byval iRowHt              As Long, _
    Byval iSelectionBackColor As Long, _
    Byval iSelectionTextColor As Long, _
    Byval strFontName         As BStr, _
    Byval iFontSize           As Long, _
    Byval iFontWeight         As Long _
  )
  Method SetRowCount(Byval iRowCount As Long, Byval blnForce As Long)
  Method SetData(Byval iRow As Long, Byval iCol As Long, Byval strData As WString)
  Method GetData(Byval iRow As Long, Byval iCol As Long) As WString
  Method FlushData()
  Method Refresh()
  Method GetCtrlId() As Long
  Method GethGrid() As Long
  Method GethComboBox(Byval iCol As Long) As Long
  Method SetCellAttributes(Byval iRow As Long, Byval iCol As Long, Byval iBackColor As Long, Byval iTextColor As Long) As Long
  Method DeleteRow(Byval iRow As Long)
End Interface


Class CGridEvents  As Event
  Instance hMain As Dword

  Class Method Create()
    Prnt "  Called Class Method Create()!"
    hMain=FindWindow("PBClient1","PBClient1")
    Prnt "    hMain = " & Str$(hMain)
    Prnt "  Leaving Class Method Create()
  End Method

  Interface IGridEvents $IID_IGridEvents : Inherit IAutomation
    Method Grid_OnKeyPress(Byval iKeyCode As Long, Byval iKeyData As Long, Byval iRow As Long, Byval iCol As Long, Byref blnCancel As Long)
      Prnt "Got KeyPress From CGridEvents1!" & Str$(iKeyCode) & "=" & Chr$(iKeyCode)
    End Method

    Method Grid_OnKeyDown(Byval iKeyCode As Long, Byval iKeyData As Long, Byval iRow As Long, Byval iCol As Long, Byref blnCancel As Long)
      Prnt "Got KeyDown From CGridEvents1!" & Str$(iKeyCode) & "=" & Chr$(iKeyCode)
    End Method

    Method Grid_OnLButtonDown(Byval iCellRow As Long, Byval iGridRow As Long, Byval iCol As Long)
      Prnt "Got WM_LBUTTONDOWN In Grid Cell From CGridEvents1" & "(" & Trim$(Str$(iGridRow)) & "," & Trim$(Str$(iCol)) & ")"
    End Method

    Method Grid_OnLButtonDblClk(Byval iCellRow As Long, Byval iGridRow As Long, Byval iCol As Long)
      ' Insert your code here
    End Method

    Method Grid_OnPaste(Byval iCellRow As Long, Byval iGridRow As Long, Byval iCol As Long)
      ' Insert your code here
    End Method

    Method Grid_OnRowSelection(Byval iRow As Long, Byval iAction As Long)
      Prnt "  Entering Grid_OnRowSelection(GridEvents)"
      Prnt "    iRow    = " & Str$(iRow)
      Prnt "    iAction = " & Str$(iAction)
      If iAction Then
         Call SetWindowLong(hMain,8,iRow)
      Else
         Call SetWindowLong(hMain,8,0)
      End If
      Prnt "  Leaving Grid_OnRowSelection(GridEvents)"
    End Method

    Method Grid_OnDelete(Byval iRow As Long)
      Local pVnt As Variant Ptr
      Local pGrid As IGrid
      Prnt "  Entering Grid_OnDelete()"
      Prnt "    iRow = " & Str$(iRow)
      pVnt=GetWindowLong(hMain,0)
      pGrid=@pVnt
      Call pGrid.DeleteRow(iRow)
      Call pGrid.Refresh()
      Set pGrid=Nothing
      Prnt "  Leaving Grid_OnDelete()"
    End Method
  End Interface
End Class


Function fnWndProc_OnCreate(Wea As WndEventArgs) As Long  ' Offset      Item
  Local pCreateStruct As CREATESTRUCT Ptr                 ' =======================================
  Local strSetup,strCoordinate As BStr                    ' 0  -  3     IGrid Ptr        - pGrid
  Local pSink As IGridEvents                              ' 4  -  7     IGridEvents Ptr  - pSink
  Local pVnt As Variant Ptr                               ' 8  -  11    Store Current Selected Row
  Local szName As ZStr*16
  Local pGrid As IGrid                                    ' In your typical Windows GUI program its certainly not necessary or desirable to
  Local hCtl As Dword                                     ' store the Window Handles of child window controls at global scope.  Afterall,
  Register i As Long                                      ' one can always obtain the window handle ( HWND ) of a child window control through
  Register j As Long                                      ' its control id using the GetDlgItem() function, whose only parameters are the parent
                                                          ' window handle and the control id of the desired child window control.  What you don't
  Call AllocConsole()                                     ' need to worry about when you adorn your GUI programs with child window controls is
  Prnt "Entering fnWndProc_OnCreate()"                    ' that Windows will prematurely and randomly destroy them for you after their creation.
  pCreateStruct=wea.lParam                                ' If you decide to include ActiveX Controls in your program though, excrutiating
  wea.hInst=@pCreateStruct.hInstance                      ' difficulties can arise if you attempt to deal with them in as caviliar a fashion as you
  Let pGrid = NewCom "FHGrid8.Grid"                       ' might with a standard Windows control such a a text box or combo box - or even a
  Prnt "  Objptr(pGrid) = " & Str$(Objptr(pGrid))         ' Common Control such as a Progress Bar or Calendar Control. The problem is that these
  pVnt=GlobalAlloc(%GPTR, 16)                             ' things are 'reference counted' within your client program code, and if you don't
  @pVnt=pGrid 'assign interface to variant                ' declare their object variables at global scope, you risk having the compiler's garbage
  Call SetWindowLong(Wea.hWnd,0,pVnt)                     ' collection code deallocate and destroy these things as local stack based objects.  For
  strSetup= _                                             ' example, just left PowerBASIC's NewCom statement is used in this WM_CREATE handler to
  "120:Column 1:^:edit," & _                              ' instantiate a my grid control.  However, note that the pGrid variable of type IGrid
  "130:Column 2:^:edit," & _                              ' is declared as a local in this procedure.  In fact this whole program has no global
  "140:Column 3:^:edit," & _                              ' variables, aside from possibly MsgHdlr(), which actually doesn't hold variables, but
  "150:Column 4:^:edit," & _                              ' rather constants, i.e., names of Windows Messages, and the addresses of the message
  "160:Column 5:^:combo"                                  ' handling function which handles each respective message.  So, getting back to pGrid,
  pGrid.CreateGrid _                                      ' which is actually a local interface pointer, if NewCom() succeeds in creating the
  ( _                                                     ' grid control, QueryInterface() code within the grid dll will call AddRef() on the
    Wea.hWnd, _  ' HWND of Parent                         ' pointer before it is returned to this code here, and that will set the reference count
    strSetup, _  ' Setup String For Grid                  ' to one.  However, being as pGrid is a local object variable, the PowerBASIC compiler
    190, _       ' Top Left Corner x                      ' will call a Release() on the pointer at procedure termination in its effort to prevent
    10, _        ' Top Left Corner y                      ' memory leaks.  What it will do here with this object variable isn't conceptually any
    570, _       ' Grid Width                             ' different than what it would do with a locally allocated String or WString object.
    218, _       ' Grid Height                            ' Any memory it allocated to store a local string would be released after the procedure
    12, _        ' # Rows Data In Grid                    ' exits.  It really has to do this or your program would 'eat' memory until it crashed
    5, _         ' # Columns In Grid                      ' the system.  The problem with that behavior here is that a Release() call on the local
    28, _        ' Row Ht In Pixels                       ' IGrid pointer pGrid will cause our reference count of one ( 1 ) to fall to zero ( 0 ),
    0, _         ' Cell Back Color                        ' and when that happens COM objects automatically deallocate and destroy themselves!  So
    0, _         ' Cell Text Color                        ' what would happen here in that case is that the grid would be successfully created in
    "Times New Roman", _ ' Font Name                      ' this WM_CREATE handler, but the user of this program would never see it, as nothing
    18, _        ' Font Size                              ' that takes place during or immediately after a WM_CREATE call is visible to the user.
    %FW_DONTCARE _  ' Font Weight                         ' Only after WM_PAINT does a window/app become visible to the user, and by that time, in
  )                                                       ' relative computer time terms, the grid would have been long dead.  The only answer
  Let pSink = Class  "CGridEvents"                        ' to this dilema, other than making the COM based control a global, is to store the valid
  Events From pGrid Call pSink                            ' interface pointer somewhere, and 'artifically' increment its reference count so that
  pVnt=GlobalAlloc(%GPTR, 16)                             ' PowerBASIC's garbage collection of local stack based objects won't allow the reference
  @pVnt=pSink                                             ' count to fall to zero, which condition causes the object to destroy itself.  That is
  Call SetWindowLong(Wea.hWnd,4,pVnt)                     ' exactly what you are seeing take place in this code upper left where a Variant Ptr object
  For i=1 To 12                                           ' named pVnt is pointed at a dynamically allocated 16 byte chunk of memory where a Variant
    For j=1 To 5                                          ' can be stored.  Into that variant memory our pGrid interface pointer is stored with the
      strCoordinate= _                                    ' statement @pVnt=pGrid.  This line has a very interesting side effect.  PowerBASIC
      "(" & Trim$(Str$(i)) & _                            ' interprets the equal operator ( = ) as a QueryInterface() call on the object for in this
      "," & Trim$(Str$(j)) & ")"                          ' case the IUnknown of the object.  This will cause a second AddRef() call on the object,
      pGrid.SetData(i, j, strCoordinate)                  ' and that will bump the reference count to two ( 2 ).  If you create the grid dll and
    Next j                                                ' compile and run this code, you'll easily see this in the voluminous console output
  Next i                                                  ' produced by a run of the code.  The net effect of this is that the compiler's clean up
  pGrid.Refresh()                                         ' of the local IGrid object pGrid at procedure termination will only cause the reference
  hCtl=CreateWindow _                                     ' count on the object to fall to one ( 1 ) - not zero ( 0 ).  The grid will keep itself
  ( _                                                     ' in memory and you'll see and be able to use it.  While its address held in pGrid will
    "button", _                                           ' go out of scope, you'll note above that it was saved in the WNDCLASSEX::cbWndExtra bytes
    "Retrieve Cell (3,2)", _                              ' by a call to SetWindowLong() right after the variant assignment.
    %WS_CHILD Or %WS_VISIBLE, _
    10, _                                                 ' The remainder of this procedure attaches the event sink to the grid, and creates some
    20, _                                                 ' buttons which exercise the grid in various self-explanatory ways.  Also, the combo box
    150, _                                                ' established in the fifth column of the grid is loaded with a few strings.  One of the
    30, _                                                 ' grid methods returns a handle to the combo box the grid created within itself if you
    Wea.hWnd, _                                           ' pass into the call the column ( 5 ) of the grid where the handle is you want.
    %IDC_RETRIEVE, _
    Wea.hInst, _
    ByVal 0 _
  )
  hCtl=CreateWindow("button","Color Some Rows",%WS_CHILD Or %WS_VISIBLE,10,70,150,30,Wea.hWnd,%IDC_COLOR,Wea.hInst,ByVal 0)
  hCtl=CreateWindow("button","Get Selected Row",%WS_CHILD Or %WS_VISIBLE,10,120,150,30,Wea.hWnd,%IDC_GET_SELECTED_ROW,Wea.hInst,ByVal 0)
  hCtl=CreateWindow("button","Unload Grid",%WS_CHILD Or %WS_VISIBLE,10,170,150,30,Wea.hWnd,%IDC_UNLOAD_GRID,Wea.hInst,ByVal 0)
  hCtl=pGrid.GethComboBox(5)
  Prnt "  hCtl = " & Str$(hCtl)
  szName="Frederick" : Call SendMessage(hCtl,%CB_INSERTSTRING,-1,Varptr(szName))
  szName="Elsie"     : Call SendMessage(hCtl,%CB_INSERTSTRING,-1,Varptr(szName))
  szName="Scott"     : Call SendMessage(hCtl,%CB_INSERTSTRING,-1,Varptr(szName))
  szName="Lorrie"    : Call SendMessage(hCtl,%CB_INSERTSTRING,-1,Varptr(szName))
  szName="Joseph"    : Call SendMessage(hCtl,%CB_INSERTSTRING,-1,Varptr(szName))
  szName="Frank"     : Call SendMessage(hCtl,%CB_INSERTSTRING,-1,Varptr(szName))
  Prnt "Leaving fnWndProc_OnCreate()"

  fnWndProc_OnCreate=0
End Function


Sub DestroyGrid(Wea As WndEventArgs)              '  Entering fnWndProc_OnDestroy()         ' DestroyGrid() is called by either clicking the 'Unload Grid'
  Local pSink As IGridEvents                      '    Entering DestroyGrid()               ' button on the main form, or by 'x' ing out from the Title Bar.
  Local pVnt As Variant Ptr                       '      pSink =  2896540                   ' The output just left is from a program run where I just
  Local pGrid As IGrid                            '                                         ' started the program, then immediately x'ed out to get the
  Local iCnt As Long                              '      Entering IGrid_QueryInterface()    ' debug console output.  At this point I don't have too much to
                                                  '        Trying To Get IFHGrid            ' say about Release() 'ing the sink.  Let's move down to the
  Prnt "  Entering DestroyGrid()"                 '        Entering IGrid_AddRef()          ' Release() of the grid pointer stored at offset zero ( 0 ) in
  ' First, Release Sink ...                       '          @pGrid.m_cRef =  1  << Before  ' the WNDCLASSEX::cbWndExtra bytes.
  pVnt=GetWindowLong(Wea.hWnd,4)                  '          @pGrid.m_cRef =  2  << After
  If pVnt Then                                    '        Leaving IGrid_AddRef()           ' First, a GetWindowLong() call retrieves the pointer to the
     pSink=@pVnt                                  '        this =  6815312                  ' varient stored at offset zero in the .cbWndExtra bytes.  Then
     Prnt "    pSink = " & Str$(ObjPtr(pSink))    '      Leaving IGrid_QueryInterface()     ' the object stored in the Variant is copied to an IGrid pointer
     If IsObject(pSink) Then                      '                                         ' pGrid.  That's what caused the 'Entering IGrid_QueryInterface()'
        Events End pSink                          '      pGrid =  6815312                   ' call just a few lines up from here just left.  Notice that from
        Set pSink=Nothing                         '                                         ' within the dll we are being told that an IGrid pointer is being
     End If                                       '      Entering IGrid_Release()           ' requested.  The grid's QueryInterface() can satisfy that request,
     Call SetWindowLong(Wea.hWnd,4,0)             '        @pGrid.m_cRef =  2  << Before    ' and so the pointer is returned, and an AddRef() is called on the
     Call GlobalFree(pVnt)                        '        @pGrid.m_cRef =  1  << After     ' pointer, which now brings up the reference count on the object
  Else                                            '      Leaving IGrid_Release()            ' up to two ( 2 ).  The first would be the pointer stored in the
     Prnt "    pSink Was Already Released!"       '                                         ' .cbWndExtra bytes up in WM_CREATE, and the second would be the
  End If                                          '      iCnt =  1                          ' local reference just stored in the local pGrid pointer here in
                                                  '     Leaving DestroyGrid()               ' DestroyGrid().  Then, right after the IsObject(pGrid) test on
  ' Then, Release Grid ...                        '                                         ' pGrid we see a Release() call - Call pGrid.Release().  Let's
  pVnt=GetWindowLong(Wea.hWnd,0)                  '     Entering IGrid_Release()            ' consider that call to be a release or undoing of the storage of
  If pVnt Then                                    '       @pGrid.m_cRef =  1  << Before     ' the IGrid pointer up in the WM_CREATE handler where we put it in
     pGrid=@pVnt                                  '       0     6810520     2896540         ' the WNDCLASSEX::cbWndExtra bytes.  That call brings our reference
     Prnt "    pGrid = " & Str$(ObjPtr(pGrid))    '       1     6810524     0               ' count on the grid down to one ( 1 ).  Notice that in the remainder
     If IsObject(pGrid) Then                      '       2     6810528     0               ' of the DestroyGrid() procedure there are no more calls from the
        Call pGrid.Release() To iCnt              '       3     6810532     0               ' pGrid pointer.  Its still valid and the object is still alive;
        Prnt "    iCnt = " & Str$(iCnt)           '       @pGrid.m_cRef = 0   << After      ' but we're just taking care of other housekeeping chores.  The
        Call SetWindowLong(Wea.hWnd,0,0)          '       Grid Was Deleted!                 ' procedure then exits and we get a message to that effect.  But
     End If                                       '     Leaving IGrid_Release()             ' then look what happens immediately!  There is a call from within
     Call GlobalFree(pVnt)                        '                                         ' the grid of 'IGrid_Release().  Now what caused that call?  What
  Else                                            '     Entering DllCanUnloadNow()          ' caused it is the PowerBASIC compiler generated clean up code
     Prnt "    pGrid Was Already Released!"       '       I'm Outta Here! (dll is unloaded) ' cleaning up the local stack variables of the DestroyGrid()
  End If                                          '     Leaving DllCanUnloadNow()           ' function.  One of those locals was an IGrid pointer holding a
  Prnt "  Leaving DestroyGrid()"                  '  Leaving fnWndProc_OnDestroy()          ' valid address.  The compiler calls the Release(), knocking back
End Sub                                                                                     ' the reference count to zero, and the grid destroys itself....


Function fnWndProc_OnCommand(Wea As WndEventArgs) As Long                                   ' ... What is about as interesting if you look down in
  Local pVnt As Variant Ptr                                                                 ' fnWndProc_OnDestroy() is a call to CoFreeUnusedLibraries() right
  Local strData As BStr                                                                     ' after the call to DestroyGrid() which we just exited.  Note that
  Local pGrid As IGrid                                                                      ' we're still in the fnWndProc_OnDestroy() handler tripped by the
  Local dwPtr As Dword                                                                      ' click of the 'x' button the close the window.  Anyway, the
  Local iCnt As Long                                                                        ' CoFreeUnusedLibraries() Api call queries the system for any dlls
  Register i As Long                                                                        ' laying around taking up memory that aren't being used by any
                                                                                            ' program, i.e., they don't have any active clients.  COM Dlls
  Select Case As Long Lowrd(Wea.wParam)                                                     ' maintain a couple internal counters to track this.  There is a
    Case %IDC_RETRIEVE                                                                      ' counter for locks and a counter for live objects.  At this point
      Prnt "Entering fnWndProc_OnCommand()"                                                 ' in the program both are at zero so DllCanUnloadNow() (an exported
      Prnt "  Case %IDC_RETRIEVE"                                                           ' Dll function) returns %S_OK and the system goes ahead and releases
      pVnt=GetWindowLong(Wea.hWnd,0)                                                        ' the COM Dll itself.  If you look inside that function in FHGrid8.bas
      pGrid=@pVnt                                                                           ' you'll see the 'I'm Outta Here!' phrase.
      pGrid.FlushData()
      strData=pGrid.GetData(3,2)
      Prnt "  Cell 3,2 Contains " & strData
      Prnt "Leaving fnWndProc_OnCommand()"
    Case %IDC_COLOR
      If Hiwrd(Wea.wParam)=%BN_CLICKED Then
         Prnt "Entering fnWndProc_OnCommand()"
         Prnt "  Case %IDC_COLOR
         pVnt=GetWindowLong(Wea.hWnd,0)
         pGrid=@pVnt
         pGrid.FlushData()
         For i=1 To 5
           pGrid.SetCellAttributes(3,i,&H000000FF,&H00FFFFFF)
         Next i
         For i=1 To 5
           pGrid.SetCellAttributes(4,i,&H0000FF00,&H00FFFFFF)
         Next i
         For i=1 To 5
           pGrid.SetCellAttributes(5,i,&H00FF0000,&H00FFFFFF)
         Next i
         For i=1 To 5
           pGrid.SetCellAttributes(6,i,RGB(255,255,0),&H00000001)
         Next i
         pGrid.Refresh()
         Prnt "Leaving fnWndProc_OnCommand()"
      End If
    Case %IDC_GET_SELECTED_ROW
      If GetWindowLong(Wea.hWnd,8) Then
         MsgBox("Selected Row = " & Str$(GetWindowLong(Wea.hWnd,8)))
      Else
         MsgBox("No Row Selected!")
      End If
    Case %IDC_UNLOAD_GRID
      Prnt "Entering fnWndProc_OnCommand()"
      Prnt "  Case %IDC_UNLOAD_GRID"
      Call DestroyGrid(Wea)
      Call EnableWindow(GetDlgItem(Wea.hWnd,%IDC_RETRIEVE),%False)
      Call EnableWindow(GetDlgItem(Wea.hWnd,%IDC_UNLOAD_GRID),%False)
      Call EnableWindow(GetDlgItem(Wea.hWnd,%IDC_COLOR),%False)
      Call EnableWindow(GetDlgItem(Wea.hWnd,%IDC_GET_SELECTED_ROW),%False)
      Call InvalidateRect(Wea.hWnd,Byval %Null, %True)
      Prnt "Leaving fnWndProc_OnCommand()"
  End Select

  fnWndProc_OnCommand=0
End Function


Function fnWndProc_OnDestroy(Wea As WndEventArgs) As Long
  Prnt "Entering fnWndProc_OnDestroy()"
  Call DestroyGrid(Wea)
  Call CoFreeUnusedLibraries()
  Call PostQuitMessage(0)
  Prnt "Leaving fnWndProc_OnDestroy()"
  Function=0
End Function


Function fnWndProc(ByVal hWnd As Long,ByVal wMsg As Long,ByVal wParam As Long,ByVal lParam As Long) As Long
  Local wea As WndEventArgs
  Register iReturn As Long
  Register i As Long

  For i=0 To 2
    If wMsg=MsgHdlr(i).wMessage Then
       wea.hWnd=hWnd: wea.wParam=wParam: wea.lParam=lParam
       Call Dword MsgHdlr(i).dwFnPtr Using FnPtr(wea) To iReturn
       fnWndProc=iReturn
       Exit Function
    End If
  Next i

  fnWndProc=DefWindowProc(hWnd,wMsg,wParam,lParam)
End Function


Sub AttachMessageHandlers()
  ReDim MsgHdlr(2) As MessageHandler  'Associate Windows Message With Message Handlers
  MsgHdlr(0).wMessage=%WM_CREATE   :   MsgHdlr(0).dwFnPtr=CodePtr(fnWndProc_OnCreate)
  MsgHdlr(1).wMessage=%WM_COMMAND  :   MsgHdlr(1).dwFnPtr=CodePtr(fnWndProc_OnCommand)
  MsgHdlr(2).wMessage=%WM_DESTROY  :   MsgHdlr(2).dwFnPtr=CodePtr(fnWndProc_OnDestroy)
End Sub


Function WinMain(ByVal hIns As Long,ByVal hPrev As Long,ByVal lpCL As Asciiz Ptr,ByVal iShow As Long) As Long
  Local szAppName As ZStr*16
  Local wc As WndClassEx
  Local hWnd As Dword
  Local Msg As tagMsg

  Call AttachMessageHandlers()                    : szAppName="PBClient1"
  wc.lpszClassName=VarPtr(szAppName)              : wc.lpfnWndProc=CodePtr(fnWndProc)
  wc.cbClsExtra=0                                 : wc.cbWndExtra=12
  wc.style=%CS_HREDRAW Or %CS_VREDRAW             : wc.hInstance=hIns
  wc.cbSize=SizeOf(wc)                            : wc.hIcon=LoadIcon(%NULL, ByVal %IDI_APPLICATION)
  wc.hCursor=LoadCursor(%NULL, ByVal %IDC_ARROW)  : wc.hbrBackground=%COLOR_BTNFACE+1
  wc.lpszMenuName=%NULL
  Call RegisterClassEx(wc)
  hWnd=CreateWindowEx(0,szAppName,szAppName,%WS_OVERLAPPEDWINDOW,200,100,790,280,0,0,hIns,ByVal 0)
  Call ShowWindow(hWnd,iShow)
  While GetMessage(Msg,%NULL,0,0)
    TranslateMessage Msg
    DispatchMessage Msg
  Wend : MsgBox("Last Chance To Get What You Can!")

  Function=msg.wParam
End Function


[Frederick J. Harris]

Code: [Select]

' PBClient2.bas
'
' This version uses the built in IConnectionPointContainer and IConnectionPoint interfaces directly
' to set up the event sink.  This actually seems to simplify the DestroyGrid() code.  Here is the
' DestroyGrid() procedure ...
'
' Sub DestroyGrid(Wea As WndEventArgs)
'   Local pConnectionPoint As IConnectionPoint
'   Local pVnt As Variant Ptr
'   Local dwCookie As Dword
'   Local pGrid As IGrid
'
'   Prnt "  Entering DestroyGrid()"
'   pVnt=GetWindowLong(Wea.hWnd,0)                ' Coming Into This Procedure, The Reference Count Will Be Sitting At
'   If pVnt Then                                  ' One, Due To An IGrid Ptr Being Assigned To A Variant Up in WM_CREATE.
'      pGrid=@pVnt                                ' Reference Count Increments To Two
'      pConnectionPoint=pGrid                     ' Reference Count Increments To Three
'      pGrid.Release()                            ' Reference Count Will Decrement To Two At This Point
'      dwCookie=GetWindowLong(Wea.hWnd,4)
'      Call pConnectionPoint.Unadvise(dwCookie)   ' The Reference Count Of Two Will Be Decremented To Zero After This
'      Call SetWindowLong(Wea.hWnd,0,0)           ' Procedure Exits, because Both pGrid And pConnectionPoint Are Holding
'      Call SetWindowLong(Wea.hWnd,4,0)           ' Valid Local Pointers Yet; PowerBASIC Is Tracking This, And Will Call
'      Call GlobalFree(pVnt)                      ' Releases() On Both Of Them When The Stack For DestroyGrid() Is
'   Else                                          ' Cleaned Up.
'      Prnt "    pGrid Was Already Released!"
'   End If
'   Prnt "  Leaving DestroyGrid()"
' End Sub
'
' What this procedure does is retrieve the stored IGrid inteface pointer from the WNDCLASSEX::cbWndExtra bytes, and uses
' that pointer to query for an IConnectionPoint interface pointer.  These two operations cause the reference count on
' the grid to increase to three.  The first count derives from the initial storage of the IGrid pointer up in
' fnWndProc_OnCreate.  The second derives from the assignment of that pointer to the local pGrid pointer in DestroyGrid().
' The third increment derives from the dynamic cast of the local IGrid pointer to the local IConnectionPoint pointer
' pConnectionPoint.  This is accomplished internally through yet another QueryInterface() call on the grid.  To see how
' this is happening, here is the console output from a run of the program where it was simply started and x'ed out of.
' I'll just show the close out code ...

' Entering fnWndProc_OnDestroy()
'   Entering DestroyGrid()
'     Entering IGrid_QueryInterface()                '  <<< This line caused by this statement ... pGrid=@pVnt
'       Trying To Get IFHGrid                        '  Since the grid can return an IFHGrid interface, AddRef()
'       Entering IGrid_AddRef()                      '  will be called within the grid.  That brings the reference
'         @pGrid.m_cRef =  1  << Before              ' count up to 2.
'         @pGrid.m_cRef =  2  << After
'       Leaving IGrid_AddRef()
'       this =  4849232
'     Leaving IGrid_QueryInterface()
'     Entering IGrid_QueryInterface()                ' <<< This line caused by this statement ...  pConnectionPoint=pGrid
'       Trying To Get IConnectionPoint               ' Since the grid can return an IConnectionPoint interface pointer,
'       this =  4849232                              ' AddRef() will be called yet again within the grid, and our reference
'       Entering IConnectionPoint_AddRef()           ' count now goes up to 3.
'         @pGrid.m_cRef =  2  << Before
'         @pGrid.m_cRef =  3  << After
'       Leaving IConnectionPoint_AddRef()
'       this =  4849240
'     Leaving IGrid_QueryInterface()
'     Entering IGrid_Release()                       ' <<< This line is caused by this statement ... pGrid.Release()
'       @pGrid.m_cRef =  3  << Before                ' Let us assume we're releasing the the IGrid interface pointer
'       @pGrid.m_cRef =  2  << After                 ' we just copied/retrieved from the .cbWndExtra bytes.  That will
'     Leaving IGrid_Release()                        ' of course drop our reference count back to 2, and those 2 are
'     Entering IConnectionPoint_Unadvise()           ' the two local ones we just acquired in this procedure.  We're not
'       this            =  4849240                   ' going to anything with those two interface pointers in this version
'       dwCookie        =  0                         ' of DestroyGrid() other than to use the IConnectionPoint pointer to
'       @pGrid.hWndCtrl =  2753048                   ' call the Unadvise() method of IConnectionPoint, which releases or
'       dwPtr           =  4010652                   ' terminates the advisory relationship between the grid and the sink
'       IGrid_Events::Release() Succeeded!           ' object contained here in the client.  Note we don't make anymore
'       Release() Returned  0                        ' Release() calls on the IGrid pointer pGrid or the IConnectionPoint
'     Leaving IConnectionPoint_Unadvise()            ' pointer pConnectionPoint, even though we still have two outstanding
'   Leaving DestroyGrid()                            ' reference counts on the grid for those two objects.  It almost looks
'   Entering IGrid_Release()                         ' like we're just leaving them hanging, and finally we see a Leaving
'     @pGrid.m_cRef =  2  << Before                  ' DestroyGrid() message.  But then we immediately see two Release()
'     @pGrid.m_cRef =  1  << After                   ' calls; the first for the IGrid interface and the second for the
'   Leaving IGrid_Release()                          ' IConnectionPoint interface.  Try to find in the code where those
'   Entering IConnectionPoint_Release()              ' calls came from.  You won't.  They didn't come from any code in
'     @pGrid.m_cRef =  1    << Before                ' this client.  They were generated by code the PowerBASIC compiler
'     0     4844440     0                            ' generated to clean up the local stack based interface pointers.  Of
'     1     4844444     0                            ' course, after the Release() on pConnectionPoint is called the
'     2     4844448     0                            ' reference count on the grid falls to 0 and the object deletes
'     3     4844452     0                            ' itself (see just left).
'     @pGrid.m_cRef = 0 And Will Now Delete pGrid!
'   Leaving IConnectionPoint_Release()
'   Entering DllCanUnloadNow()
'     I'm Outta Here! (dll is unloaded)
'   Leaving DllCanUnloadNow()
' Leaving fnWndProc_OnDestroy()

' The next line you see in the console output above is 'Entering DllCanUnloadNow()'.  That is a COM Dll export and you'll
' find that procedure in the FHGrid8.bas code.  What triggered it was a call to CoFreeUnusedLibraries() I made down in
' fnWndProc_OnDestroy().  So you won't get too confused here is that procedure from the client app below ...

' Function fnWndProc_OnDestroy(Wea As WndEventArgs) As Long
'   Prnt "Entering fnWndProc_OnDestroy()"
'   Call DestroyGrid(Wea)
'   Call CoFreeUnusedLibraries()
'   Call PostQuitMessage(0)
'   Prnt "Leaving fnWndProc_OnDestroy()"
'   Function=0
' End Function
'
' Don't lose sight of the fact that the reason we were in the DestroyGrid() procedure above is that somebody clicked the
' little "x" button to close out the app, and that triggered a WM_DESTROY message, and fnWndProc_OnDestroy() above is the
' handler for that message.  That's where DestroyGrid() got called, and its also where CoFreeUnusedLibraries() is located.
' CoFreeUnusedLibraries() calls all the Dlls in memory and asks them if they can be unloaded.  It does this by calling
' each Dll's DllCanUnloadNow() exported function.  If that function returns %S_OK, Windows unloads the Dll.  That's what
' happened above.  Here's the whole program listing...

#Compile                  Exe  "PBClient2.exe"
#Dim                      All
%UNICODE                  = 1
#If %Def(%UNICODE)
    Macro ZStr            = WStringz
    Macro BStr            = WString
    %SIZEOF_CHAR          = 2
#Else
    Macro ZStr            = Asciiz
    Macro BStr            = String
    %SIZEOF_CHAR          = 1
#EndIf
$CLSID_FHGrid             = GUID$("{20000000-0000-0000-0000-000000000084}")
$IID_IFHGrid              = GUID$("{20000000-0000-0000-0000-000000000085}")
$IID_IGridEvents          = GUID$("{20000000-0000-0000-0000-000000000086}")
%IDC_RETRIEVE             = 1500
%IDC_COLOR                = 1505
%IDC_UNLOAD_GRID          = 1510
%IDC_GET_SELECTED_ROW     = 1515
#Include                  "Win32Api.inc"  ' Uses PowerBASIC Includes

Type WndEventArgs
  wParam                  As Long
  lParam                  As Long
  hWnd                    As Dword
  hInst                   As Dword
End Type

Declare Function FnPtr(wea As WndEventArgs) As Long

Type MessageHandler
  wMessage                As Long
  dwFnPtr                 As Dword
End Type
Global MsgHdlr()          As MessageHandler


Sub Prnt(strLn As BStr)
  Local iLen, iWritten As Long
  Local hStdOutput As Dword
  Local strNew As BStr
  hStdOutput=GetStdHandle(%STD_OUTPUT_HANDLE)
  strNew=strLn + $CrLf
  iLen = Len(strNew)
  WriteConsole(hStdOutput, Byval Strptr(strNew), iLen, iWritten, Byval 0)
End Sub


Interface IGrid $IID_IFHGrid : Inherit IAutomation    ' This is the Grid's Interface (a standard incoming Interface, i.e.,
  Method CreateGrid _                                 ' method calls are coming into the grid from the client).
  ( _
    Byval hParent             As Long, _
    Byval strSetup            As BStr, _
    Byval x                   As Long, _
    Byval y                   As Long, _
    Byval cx                  As Long, _
    Byval cy                  As Long, _
    Byval iRows               As Long, _
    Byval iCols               As Long, _
    Byval iRowHt              As Long, _
    Byval iSelectionBackColor As Long, _
    Byval iSelectionTextColor As Long, _
    Byval strFontName         As BStr, _
    Byval iFontSize           As Long, _
    Byval iFontWeight         As Long _
  )
  Method SetRowCount(Byval iRowCount As Long, Byval blnForce As Long)
  Method SetData(Byval iRow As Long, Byval iCol As Long, Byval strData As WString)
  Method GetData(Byval iRow As Long, Byval iCol As Long) As WString
  Method FlushData()
  Method Refresh()
  Method GetCtrlId() As Long
  Method GethGrid() As Long
  Method GethComboBox(Byval iCol As Long) As Long
  Method SetCellAttributes(Byval iRow As Long, Byval iCol As Long, Byval iBackColor As Long, Byval iTextColor As Long) As Long
  Method DeleteRow(Byval iRow As Long)
End Interface


Class CGridEvents  As Event
  Instance hMain As Dword

  Class Method Create()
    Prnt "  Called Class Method Create()!"
    hMain=FindWindow("PBClient2","PBClient2")
    Prnt "    hMain = " & Str$(hMain)
    Prnt "  Leaving Class Method Create()
  End Method

  Interface IGridEvents $IID_IGridEvents : Inherit IAutomation
    Method Grid_OnKeyPress(Byval iKeyCode As Long, Byval iKeyData As Long, Byval iRow As Long, Byval iCol As Long, Byref blnCancel As Long)
      Prnt "Got KeyPress From CGridEvents1!" & Str$(iKeyCode) & "=" & Chr$(iKeyCode)
    End Method

    Method Grid_OnKeyDown(Byval iKeyCode As Long, Byval iKeyData As Long, Byval iRow As Long, Byval iCol As Long, Byref blnCancel As Long)
      Prnt "Got KeyDown From CGridEvents1!" & Str$(iKeyCode) & "=" & Chr$(iKeyCode)
    End Method

    Method Grid_OnLButtonDown(Byval iCellRow As Long, Byval iGridRow As Long, Byval iCol As Long)
      Prnt "Got WM_LBUTTONDOWN In Grid Cell From CGridEvents1" & "(" & Trim$(Str$(iGridRow)) & "," & Trim$(Str$(iCol)) & ")"
    End Method

    Method Grid_OnLButtonDblClk(Byval iCellRow As Long, Byval iGridRow As Long, Byval iCol As Long)
      ' Insert your code here
    End Method

    Method Grid_OnPaste(Byval iCellRow As Long, Byval iGridRow As Long, Byval iCol As Long)
      ' Insert your code here
    End Method

    Method Grid_OnRowSelection(Byval iRow As Long, Byval iAction As Long)
      Prnt "  Entering Grid_OnRowSelection(GridEvents)"
      Prnt "    iRow    = " & Str$(iRow)
      Prnt "    iAction = " & Str$(iAction)
      If iAction Then
         Call SetWindowLong(hMain,8,iRow)
      Else
         Call SetWindowLong(hMain,8,0)
      End If
      Prnt "  Leaving Grid_OnRowSelection(GridEvents)"
    End Method

    Method Grid_OnDelete(Byval iRow As Long)
      Local pVnt As Variant Ptr
      Local pGrid As IGrid

      Prnt "  Entering Grid_OnDelete()"
      Prnt "    iRow = " & Str$(iRow)
      pVnt=GetWindowLong(hMain,0)
      pGrid=@pVnt
      Call pGrid.DeleteRow(iRow)
      Call pGrid.Refresh()
      Set pGrid=Nothing
      Prnt "  Leaving Grid_OnDelete()"
    End Method
  End Interface
End Class


Function fnWndProc_OnCreate(Wea As WndEventArgs) As Long          ' Offset      Item
  Local pConnectionPointContainer As IConnectionPointContainer    ' =============================
  Local pConnectionPoint As IConnectionPoint                      ' 0  -  3     IGrid Ptr - pGrid
  Local pCreateStruct As CREATESTRUCT Ptr                         ' 4  -  7     dwCookie
  Local strSetup,strCoordinate As BStr                            ' 8  - 11     iSelectedRow
  Local pSink As IGridEvents
  Local pVnt As Variant Ptr
  Local EventGuid As Guid
  Local dwCookie As Dword
  Local szName As ZStr*16
  Local pGrid As IGrid
  Local hCtl As Dword
  Register i As Long
  Register j As Long

  Call AllocConsole()
  Prnt "Entering fnWndProc_OnCreate()"
  pCreateStruct=wea.lParam
  wea.hInst=@pCreateStruct.hInstance
  Let pGrid = NewCom "FHGrid8.Grid"
  Prnt "  Objptr(pGrid) = " & Str$(Objptr(pGrid))
  pVnt=GlobalAlloc(%GPTR, 16)
  @pVnt=pGrid 'assign interface to variant
  Call SetWindowLong(Wea.hWnd,0,pVnt)
  strSetup="120:Column 1:^:edit,130:Column 2:^:edit,140:Column 3:^:edit,150:Column 4:^:edit,160:Column 5:^:combo"
  pGrid.CreateGrid(Wea.hWnd,strSetup,190,10,570,218,12,5,28,0,0,"Times New Roman",18,%FW_DONTCARE)
  pConnectionPointContainer = pGrid
  EventGuid=$IID_IGridEvents
  Call pConnectionPointContainer.FindConnectionPoint(Byval Varptr(EventGuid),Byval Varptr(pConnectionPoint))
  Let pSink = Class  "CGridEvents"
  Prnt "  Objptr(pSink) = " & Str$(Objptr(pSink))
  Call pConnectionPoint.Advise(Byval Objptr(pSink), dwCookie)
  Call SetWindowLong(Wea.hWnd,4,dwCookie)
  Prnt "  dwCookie      = " & Str$(dwCookie)
  For i=1 To 12
    For j=1 To 5
      strCoordinate="(" & Trim$(Str$(i)) & "," & Trim$(Str$(j)) & ")"
      pGrid.SetData(i, j, strCoordinate)
    Next j
  Next i
  pGrid.Refresh()
  hCtl=CreateWindow("button","Retrieve Cell (3,2)",%WS_CHILD Or %WS_VISIBLE,10,20,150,30,Wea.hWnd,%IDC_RETRIEVE,Wea.hInst,ByVal 0)
  hCtl=CreateWindow("button","Color Some Rows",%WS_CHILD Or %WS_VISIBLE,10,70,150,30,Wea.hWnd,%IDC_COLOR,Wea.hInst,ByVal 0)
  hCtl=CreateWindow("button","Get Selected Row",%WS_CHILD Or %WS_VISIBLE,10,120,150,30,Wea.hWnd,%IDC_GET_SELECTED_ROW,Wea.hInst,ByVal 0)
  hCtl=CreateWindow("button","Unload Grid",%WS_CHILD Or %WS_VISIBLE,10,170,150,30,Wea.hWnd,%IDC_UNLOAD_GRID,Wea.hInst,ByVal 0)
  hCtl=pGrid.GethComboBox(5)
  Prnt "  hCtl = " & Str$(hCtl)
  szName="Frederick" : Call SendMessage(hCtl,%CB_INSERTSTRING,-1,Varptr(szName))
  szName="Elsie"     : Call SendMessage(hCtl,%CB_INSERTSTRING,-1,Varptr(szName))
  szName="Scott"     : Call SendMessage(hCtl,%CB_INSERTSTRING,-1,Varptr(szName))
  szName="Lorrie"    : Call SendMessage(hCtl,%CB_INSERTSTRING,-1,Varptr(szName))
  szName="Joseph"    : Call SendMessage(hCtl,%CB_INSERTSTRING,-1,Varptr(szName))
  szName="Frank"     : Call SendMessage(hCtl,%CB_INSERTSTRING,-1,Varptr(szName))
  Prnt "Leaving fnWndProc_OnCreate()"

  fnWndProc_OnCreate=0
End Function


Sub DestroyGrid(Wea As WndEventArgs)
  Local pConnectionPoint As IConnectionPoint
  Local pVnt As Variant Ptr
  Local dwCookie As Dword
  Local pGrid As IGrid

  Prnt "  Entering DestroyGrid()"
  pVnt=GetWindowLong(Wea.hWnd,0)                ' Coming Into This Procedure, The Reference Count Will Be Sitting At
  If pVnt Then                                  ' One, Due To An IGrid Ptr Being Assigned To A Variant Up in WM_CREATE.
     pGrid=@pVnt                                ' Reference Count Increments To Two
     pConnectionPoint=pGrid                     ' Reference Count Increments To Three
     pGrid.Release()                            ' Reference Count Will Decrement To Two At This Point
     dwCookie=GetWindowLong(Wea.hWnd,4)
     Call pConnectionPoint.Unadvise(dwCookie)   ' The Reference Count Of Two Will Be Decremented To Zero After This
     Call SetWindowLong(Wea.hWnd,0,0)           ' Procedure Exits, because Both pGrid And pConnectionPoint Are Holding
     Call SetWindowLong(Wea.hWnd,4,0)           ' Valid Local Pointers Yet; PowerBASIC Is Tracking This, And Will Call
     Call GlobalFree(pVnt)                      ' Releases() On Both Of Them When The Stack For DestroyGrid() Is
  Else                                          ' Cleaned Up.
     Prnt "    pGrid Was Already Released!"
  End If
  Prnt "  Leaving DestroyGrid()"
End Sub


Function fnWndProc_OnCommand(Wea As WndEventArgs) As Long
  Local pVnt As Variant Ptr
  Local strData As BStr
  Local pGrid As IGrid
  Local iCnt As Long
  Register i As Long

  Select Case As Long Lowrd(Wea.wParam)
    Case %IDC_RETRIEVE
      Prnt "Entering fnWndProc_OnCommand()"
      Prnt "  Case %IDC_RETRIEVE"
      pVnt=GetWindowLong(Wea.hWnd,0)
      pGrid=@pVnt
      Prnt "  iCnt = " & Str$(iCnt)
      pGrid.FlushData()
      strData=pGrid.GetData(3,2)
      Prnt "  Cell 3,2 Contains " & strData
      Prnt "Leaving fnWndProc_OnCommand()"
    Case %IDC_COLOR
      If Hiwrd(Wea.wParam)=%BN_CLICKED Then
         Prnt "Entering fnWndProc_OnCommand()"
         Prnt "  Case %IDC_COLOR
         pVnt=GetWindowLong(Wea.hWnd,0)
         pGrid=@pVnt
         pGrid.FlushData()
         For i=1 To 5
           pGrid.SetCellAttributes(3,i,&H000000FF,&H00FFFFFF)
         Next i
         For i=1 To 5
           pGrid.SetCellAttributes(4,i,&H0000FF00,&H00FFFFFF)
         Next i
         For i=1 To 5
           pGrid.SetCellAttributes(5,i,&H00FF0000,&H00FFFFFF)
         Next i
         For i=1 To 5
           pGrid.SetCellAttributes(6,i,RGB(255,255,0),&H00000001)
         Next i
         pGrid.Refresh()
         Prnt "Leaving fnWndProc_OnCommand()"
      End If
    Case %IDC_GET_SELECTED_ROW
      If GetWindowLong(Wea.hWnd,8) Then
         MsgBox("Selected Row = " & Str$(GetWindowLong(Wea.hWnd,8)))
      Else
         MsgBox("No Row Selected!")
      End If
    Case %IDC_UNLOAD_GRID
      Prnt "Entering fnWndProc_OnCommand()"
      Prnt "  Case %IDC_UNLOAD_GRID"
      Call DestroyGrid(Wea)
      Call EnableWindow(GetDlgItem(Wea.hWnd,%IDC_RETRIEVE),%False)
      Call EnableWindow(GetDlgItem(Wea.hWnd,%IDC_UNLOAD_GRID),%False)
      Call EnableWindow(GetDlgItem(Wea.hWnd,%IDC_COLOR),%False)
      Call EnableWindow(GetDlgItem(Wea.hWnd,%IDC_GET_SELECTED_ROW),%False)
      Call InvalidateRect(Wea.hWnd,Byval %Null, %True)
      Prnt "Leaving fnWndProc_OnCommand()"
  End Select

  fnWndProc_OnCommand=0
End Function


Function fnWndProc_OnDestroy(Wea As WndEventArgs) As Long
  Prnt "Entering fnWndProc_OnDestroy()"
  Call DestroyGrid(Wea)
  Call CoFreeUnusedLibraries()
  Call PostQuitMessage(0)
  Prnt "Leaving fnWndProc_OnDestroy()"
  Function=0
End Function


Function fnWndProc(ByVal hWnd As Long,ByVal wMsg As Long,ByVal wParam As Long,ByVal lParam As Long) As Long
  Local wea As WndEventArgs
  Register iReturn As Long
  Register i As Long

  For i=0 To 2
    If wMsg=MsgHdlr(i).wMessage Then
       wea.hWnd=hWnd: wea.wParam=wParam: wea.lParam=lParam
       Call Dword MsgHdlr(i).dwFnPtr Using FnPtr(wea) To iReturn
       fnWndProc=iReturn
       Exit Function
    End If
  Next i

  fnWndProc=DefWindowProc(hWnd,wMsg,wParam,lParam)
End Function


Sub AttachMessageHandlers()
  ReDim MsgHdlr(2) As MessageHandler  'Associate Windows Message With Message Handlers
  MsgHdlr(0).wMessage=%WM_CREATE   :   MsgHdlr(0).dwFnPtr=CodePtr(fnWndProc_OnCreate)
  MsgHdlr(1).wMessage=%WM_COMMAND  :   MsgHdlr(1).dwFnPtr=CodePtr(fnWndProc_OnCommand)
  MsgHdlr(2).wMessage=%WM_DESTROY  :   MsgHdlr(2).dwFnPtr=CodePtr(fnWndProc_OnDestroy)
End Sub


Function WinMain(ByVal hIns As Long,ByVal hPrev As Long,ByVal lpCL As Asciiz Ptr,ByVal iShow As Long) As Long
  Local szAppName As ZStr*16
  Local wc As WndClassEx
  Local hWnd As Dword
  Local Msg As tagMsg

  Call AttachMessageHandlers()                    : szAppName="PBClient2"
  wc.lpszClassName=VarPtr(szAppName)              : wc.lpfnWndProc=CodePtr(fnWndProc)
  wc.cbClsExtra=0                                 : wc.cbWndExtra=12
  wc.style=%CS_HREDRAW Or %CS_VREDRAW             : wc.hInstance=hIns
  wc.cbSize=SizeOf(wc)                            : wc.hIcon=LoadIcon(%NULL, ByVal %IDI_APPLICATION)
  wc.hCursor=LoadCursor(%NULL, ByVal %IDC_ARROW)  : wc.hbrBackground=%COLOR_BTNFACE+1
  wc.lpszMenuName=%NULL
  Call RegisterClassEx(wc)
  hWnd=CreateWindowEx(0,szAppName,szAppName,%WS_OVERLAPPEDWINDOW,200,100,790,280,0,0,hIns,ByVal 0)
  Call ShowWindow(hWnd,iShow)
  While GetMessage(Msg,%NULL,0,0)
    TranslateMessage Msg
    DispatchMessage Msg
  Wend : MsgBox("Last Chance To Get What You Can!")

  Function=msg.wParam
End Function


[Frederick J. Harris]

Code: [Select]

' PBClient3
'
' In this version of our client program we'll explore PowerBASIC's 'Nothing' keyword and see what
' effects use of this keyword have on the logistics of releasing local references.  If you look
' down in DestroyGrid() in this version of the program (reproduced here) ...

' Sub DestroyGrid(Wea As WndEventArgs)
'   Local pConnectionPoint As IConnectionPoint
'   Local pVnt As Variant Ptr
'   Local dwCookie As Dword
'   Local pGrid As IGrid
'
'   Prnt "  Entering DestroyGrid()"
'   pVnt=GetWindowLong(Wea.hWnd,0)
'   If pVnt Then
'      pGrid=@pVnt
'      pConnectionPoint=pGrid
'      pGrid.Release()
'      dwCookie=GetWindowLong(Wea.hWnd,4)
'      Call pConnectionPoint.Unadvise(dwCookie)
'      pGrid = Nothing                                   ' <<<< here &
'      pConnectionPoint = Nothing                        ' <<<< here
'      Call SetWindowLong(Wea.hWnd,0,0)
'      Call SetWindowLong(Wea.hWnd,4,0)
'      Call GlobalFree(pVnt)
'   Else
'      Prnt "    pGrid Was Already Released!"
'   End If
'   Prnt "  Leaving DestroyGrid()"
' End Sub
'
' ...you'll see that instead of leaving those two reference counts on the grid hang open like we did
' in version 2 of the program, we used the 'Nothing' keyword in assignment statements to set the
' reference to 'Nothing'.  And what effect does that have, in comparison to letting the compiler
' auto-generated garbage collection code release the object in the process of deallocating the
' the DestroyGrid()'s stack?  Here is the console output ...
'
' Entering fnWndProc_OnDestroy()
'   Entering DestroyGrid()
'     Entering IGrid_QueryInterface()
'       Trying To Get IFHGrid
'       Entering IGrid_AddRef()
'         @pGrid.m_cRef =  1  << Before
'         @pGrid.m_cRef =  2  << After
'       Leaving IGrid_AddRef()
'       this =  6028880
'     Leaving IGrid_QueryInterface()
'     Entering IGrid_QueryInterface()
'       Trying To Get IConnectionPoint
'       this =  6028880
'       Entering IConnectionPoint_AddRef()
'         @pGrid.m_cRef =  2  << Before
'         @pGrid.m_cRef =  3  << After
'       Leaving IConnectionPoint_AddRef()
'       this =  6028888
'     Leaving IGrid_QueryInterface()
'     Entering IGrid_Release()
'       @pGrid.m_cRef =  3  << Before
'       @pGrid.m_cRef =  2  << After
'     Leaving IGrid_Release()
'     Entering IConnectionPoint_Unadvise()
'       this            =  6028888
'       dwCookie        =  0
'       @pGrid.hWndCtrl =  3473864
'       dwPtr           =  2896540
'       IGrid_Events::Release() Succeeded!
'       Release() Returned  0
'     Leaving IConnectionPoint_Unadvise()
'     Entering IGrid_Release()                  ' <<< Here is what setting pGrid = Nothing caused ...
'       @pGrid.m_cRef =  2  << Before
'       @pGrid.m_cRef =  1  << After
'     Leaving IGrid_Release()
'     Entering IConnectionPoint_Release()       ' <<< ... and here is what setting pConnectionPoint = Nothing caused.
'       @pGrid.m_cRef =  1    << Before         ' The important point to note in comparison to what we did in PBClient2
'       0     6024088     0                     ' is that we are still in the DestroyGrid() function.  The release of
'       1     6024092     0                     ' the grid achieved by its reference count hitting zero occurred within
'       2     6024096     0                     ' DestroyGrid() - not afterwards by auto garbage collection code.
'       3     6024100     0
'       @pGrid.m_cRef = 0 And Will Now Delete pGrid!
'     Leaving IConnectionPoint_Release()
'   Leaving DestroyGrid()
'   Entering DllCanUnloadNow()
'     I'm Outta Here! (dll is unloaded)
'   Leaving DllCanUnloadNow()
' Leaving fnWndProc_OnDestroy()
'
' What might be particularly instructive at this point might be to ask oneself what would happen or be the
' difference between using the Nothing keyword to diminish the reference count, i.e., it causes a call to
' Release() on the object, or simply calling Release() directly?  Think a moment about that one.  We'll try
' that in the next example, and see what happens!

#Compile                  Exe  "PBClient3.exe"
#Dim                      All
%UNICODE                  = 1
#If %Def(%UNICODE)
    Macro ZStr            = WStringz
    Macro BStr            = WString
    %SIZEOF_CHAR          = 2
#Else
    Macro ZStr            = Asciiz
    Macro BStr            = String
    %SIZEOF_CHAR          = 1
#EndIf
$CLSID_FHGrid             = GUID$("{20000000-0000-0000-0000-000000000084}")
$IID_IFHGrid              = GUID$("{20000000-0000-0000-0000-000000000085}")
$IID_IGridEvents          = GUID$("{20000000-0000-0000-0000-000000000086}")
%IDC_RETRIEVE             = 1500
%IDC_COLOR                = 1505
%IDC_UNLOAD_GRID          = 1510
%IDC_GET_SELECTED_ROW     = 1515
#Include                  "Win32Api.inc"  ' Uses PowerBASIC Includes

Type WndEventArgs
  wParam                  As Long
  lParam                  As Long
  hWnd                    As Dword
  hInst                   As Dword
End Type

Declare Function FnPtr(wea As WndEventArgs) As Long

Type MessageHandler
  wMessage                As Long
  dwFnPtr                 As Dword
End Type
Global MsgHdlr()          As MessageHandler


Sub Prnt(strLn As BStr)
  Local iLen, iWritten As Long
  Local hStdOutput As Dword
  Local strNew As BStr
  hStdOutput=GetStdHandle(%STD_OUTPUT_HANDLE)
  strNew=strLn + $CrLf
  iLen = Len(strNew)
  WriteConsole(hStdOutput, Byval Strptr(strNew), iLen, iWritten, Byval 0)
End Sub


Interface IGrid $IID_IFHGrid : Inherit IAutomation    ' This is the Grid's Interface (a standard incoming Interface, i.e.,
  Method CreateGrid _                                 ' method calls are coming into the grid from the client).
  ( _
    Byval hParent             As Long, _
    Byval strSetup            As BStr, _
    Byval x                   As Long, _
    Byval y                   As Long, _
    Byval cx                  As Long, _
    Byval cy                  As Long, _
    Byval iRows               As Long, _
    Byval iCols               As Long, _
    Byval iRowHt              As Long, _
    Byval iSelectionBackColor As Long, _
    Byval iSelectionTextColor As Long, _
    Byval strFontName         As BStr, _
    Byval iFontSize           As Long, _
    Byval iFontWeight         As Long _
  )
  Method SetRowCount(Byval iRowCount As Long, Byval blnForce As Long)
  Method SetData(Byval iRow As Long, Byval iCol As Long, Byval strData As WString)
  Method GetData(Byval iRow As Long, Byval iCol As Long) As WString
  Method FlushData()
  Method Refresh()
  Method GetCtrlId() As Long
  Method GethGrid() As Long
  Method GethComboBox(Byval iCol As Long) As Long
  Method SetCellAttributes(Byval iRow As Long, Byval iCol As Long, Byval iBackColor As Long, Byval iTextColor As Long) As Long
  Method DeleteRow(Byval iRow As Long)
End Interface


Class CGridEvents  As Event
  Instance hMain As Dword

  Class Method Create()
    Prnt "  Called Class Method Create()!"
    hMain=FindWindow("PBClient3","PBClient3")
    Prnt "    hMain = " & Str$(hMain)
    Prnt "  Leaving Class Method Create()
  End Method

  Interface IGridEvents $IID_IGridEvents : Inherit IAutomation
    Method Grid_OnKeyPress(Byval iKeyCode As Long, Byval iKeyData As Long, Byval iRow As Long, Byval iCol As Long, Byref blnCancel As Long)
      Prnt "Got KeyPress From CGridEvents1!" & Str$(iKeyCode) & "=" & Chr$(iKeyCode)
    End Method

    Method Grid_OnKeyDown(Byval iKeyCode As Long, Byval iKeyData As Long, Byval iRow As Long, Byval iCol As Long, Byref blnCancel As Long)
      Prnt "Got KeyDown From CGridEvents1!" & Str$(iKeyCode) & "=" & Chr$(iKeyCode)
    End Method

    Method Grid_OnLButtonDown(Byval iCellRow As Long, Byval iGridRow As Long, Byval iCol As Long)
      Prnt "Got WM_LBUTTONDOWN In Grid Cell From CGridEvents1" & "(" & Trim$(Str$(iGridRow)) & "," & Trim$(Str$(iCol)) & ")"
    End Method

    Method Grid_OnLButtonDblClk(Byval iCellRow As Long, Byval iGridRow As Long, Byval iCol As Long)
      ' Insert your code here
    End Method

    Method Grid_OnPaste(Byval iCellRow As Long, Byval iGridRow As Long, Byval iCol As Long)
      ' Insert your code here
    End Method

    Method Grid_OnRowSelection(Byval iRow As Long, Byval iAction As Long)
      Prnt "  Entering Grid_OnRowSelection(GridEvents)"
      Prnt "    iRow    = " & Str$(iRow)
      Prnt "    iAction = " & Str$(iAction)
      If iAction Then
         Call SetWindowLong(hMain,8,iRow)
      Else
         Call SetWindowLong(hMain,8,0)
      End If
      Prnt "  Leaving Grid_OnRowSelection(GridEvents)"
    End Method

    Method Grid_OnDelete(Byval iRow As Long)
      Local pVnt As Variant Ptr
      Local pGrid As IGrid

      Prnt "  Entering Grid_OnDelete()"
      Prnt "    iRow = " & Str$(iRow)
      pVnt=GetWindowLong(hMain,0)
      pGrid=@pVnt
      Call pGrid.DeleteRow(iRow)
      Call pGrid.Refresh()
      Set pGrid=Nothing
      Prnt "  Leaving Grid_OnDelete()"
    End Method
  End Interface
End Class


Function fnWndProc_OnCreate(Wea As WndEventArgs) As Long          ' Offset      Item
  Local pConnectionPointContainer As IConnectionPointContainer    ' =============================
  Local pConnectionPoint As IConnectionPoint                      ' 0  -  3     IGrid Ptr - pGrid
  Local pCreateStruct As CREATESTRUCT Ptr                         ' 4  -  7     dwCookie
  Local strSetup,strCoordinate As BStr                            ' 8  - 11     iSelectedRow
  Local pSink As IGridEvents
  Local pVnt As Variant Ptr
  Local EventGuid As Guid
  Local dwCookie As Dword
  Local szName As ZStr*16
  Local pGrid As IGrid
  Local hCtl As Dword
  Register i As Long
  Register j As Long

  Call AllocConsole()
  Prnt "Entering fnWndProc_OnCreate()"
  pCreateStruct=wea.lParam
  wea.hInst=@pCreateStruct.hInstance
  Let pGrid = NewCom "FHGrid8.Grid"
  Prnt "  Objptr(pGrid) = " & Str$(Objptr(pGrid))
  pVnt=GlobalAlloc(%GPTR, 16)
  @pVnt=pGrid 'assign interface to variant
  Call SetWindowLong(Wea.hWnd,0,pVnt)
  strSetup="120:Column 1:^:edit,130:Column 2:^:edit,140:Column 3:^:edit,150:Column 4:^:edit,160:Column 5:^:combo"
  pGrid.CreateGrid(Wea.hWnd,strSetup,190,10,570,218,12,5,28,0,0,"Times New Roman",18,%FW_DONTCARE)
  pConnectionPointContainer = pGrid
  EventGuid=$IID_IGridEvents
  Call pConnectionPointContainer.FindConnectionPoint(Byval Varptr(EventGuid),Byval Varptr(pConnectionPoint))
  Let pSink = Class  "CGridEvents"
  Prnt "  Objptr(pSink) = " & Str$(Objptr(pSink))
  Call pConnectionPoint.Advise(Byval Objptr(pSink), dwCookie)
  Call SetWindowLong(Wea.hWnd,4,dwCookie)
  Prnt "  dwCookie      = " & Str$(dwCookie)
  For i=1 To 12
    For j=1 To 5
      strCoordinate="(" & Trim$(Str$(i)) & "," & Trim$(Str$(j)) & ")"
      pGrid.SetData(i, j, strCoordinate)
    Next j
  Next i
  pGrid.Refresh()
  hCtl=CreateWindow("button","Retrieve Cell (3,2)",%WS_CHILD Or %WS_VISIBLE,10,20,150,30,Wea.hWnd,%IDC_RETRIEVE,Wea.hInst,ByVal 0)
  hCtl=CreateWindow("button","Color Some Rows",%WS_CHILD Or %WS_VISIBLE,10,70,150,30,Wea.hWnd,%IDC_COLOR,Wea.hInst,ByVal 0)
  hCtl=CreateWindow("button","Get Selected Row",%WS_CHILD Or %WS_VISIBLE,10,120,150,30,Wea.hWnd,%IDC_GET_SELECTED_ROW,Wea.hInst,ByVal 0)
  hCtl=CreateWindow("button","Unload Grid",%WS_CHILD Or %WS_VISIBLE,10,170,150,30,Wea.hWnd,%IDC_UNLOAD_GRID,Wea.hInst,ByVal 0)
  hCtl=pGrid.GethComboBox(5)
  Prnt "  hCtl = " & Str$(hCtl)
  szName="Frederick" : Call SendMessage(hCtl,%CB_INSERTSTRING,-1,Varptr(szName))
  szName="Elsie"     : Call SendMessage(hCtl,%CB_INSERTSTRING,-1,Varptr(szName))
  szName="Scott"     : Call SendMessage(hCtl,%CB_INSERTSTRING,-1,Varptr(szName))
  szName="Lorrie"    : Call SendMessage(hCtl,%CB_INSERTSTRING,-1,Varptr(szName))
  szName="Joseph"    : Call SendMessage(hCtl,%CB_INSERTSTRING,-1,Varptr(szName))
  szName="Frank"     : Call SendMessage(hCtl,%CB_INSERTSTRING,-1,Varptr(szName))
  Prnt "Leaving fnWndProc_OnCreate()"

  fnWndProc_OnCreate=0
End Function


Sub DestroyGrid(Wea As WndEventArgs)
  Local pConnectionPoint As IConnectionPoint
  Local pVnt As Variant Ptr
  Local dwCookie As Dword
  Local pGrid As IGrid

  Prnt "  Entering DestroyGrid()"
  pVnt=GetWindowLong(Wea.hWnd,0)
  If pVnt Then
     pGrid=@pVnt
     pConnectionPoint=pGrid
     pGrid.Release()
     dwCookie=GetWindowLong(Wea.hWnd,4)
     Call pConnectionPoint.Unadvise(dwCookie)
     pGrid = Nothing
     pConnectionPoint = Nothing
     Call SetWindowLong(Wea.hWnd,0,0)
     Call SetWindowLong(Wea.hWnd,4,0)
     Call GlobalFree(pVnt)
  Else
     Prnt "    pGrid Was Already Released!"
  End If
  Prnt "  Leaving DestroyGrid()"
End Sub


Function fnWndProc_OnCommand(Wea As WndEventArgs) As Long
  Local pVnt As Variant Ptr
  Local strData As BStr
  Local pGrid As IGrid
  Local iCnt As Long
  Register i As Long

  Select Case As Long Lowrd(Wea.wParam)
    Case %IDC_RETRIEVE
      Prnt "Entering fnWndProc_OnCommand()"
      Prnt "  Case %IDC_RETRIEVE"
      pVnt=GetWindowLong(Wea.hWnd,0)
      pGrid=@pVnt
      Prnt "  iCnt = " & Str$(iCnt)
      pGrid.FlushData()
      strData=pGrid.GetData(3,2)
      Prnt "  Cell 3,2 Contains " & strData
      Prnt "Leaving fnWndProc_OnCommand()"
    Case %IDC_COLOR
      If Hiwrd(Wea.wParam)=%BN_CLICKED Then
         Prnt "Entering fnWndProc_OnCommand()"
         Prnt "  Case %IDC_COLOR
         pVnt=GetWindowLong(Wea.hWnd,0)
         pGrid=@pVnt
         pGrid.FlushData()
         For i=1 To 5
           pGrid.SetCellAttributes(3,i,&H000000FF,&H00FFFFFF)
         Next i
         For i=1 To 5
           pGrid.SetCellAttributes(4,i,&H0000FF00,&H00FFFFFF)
         Next i
         For i=1 To 5
           pGrid.SetCellAttributes(5,i,&H00FF0000,&H00FFFFFF)
         Next i
         For i=1 To 5
           pGrid.SetCellAttributes(6,i,RGB(255,255,0),&H00000001)
         Next i
         pGrid.Refresh()
         Prnt "Leaving fnWndProc_OnCommand()"
      End If
    Case %IDC_GET_SELECTED_ROW
      If GetWindowLong(Wea.hWnd,8) Then
         MsgBox("Selected Row = " & Str$(GetWindowLong(Wea.hWnd,8)))
      Else
         MsgBox("No Row Selected!")
      End If
    Case %IDC_UNLOAD_GRID
      Prnt "Entering fnWndProc_OnCommand()"
      Prnt "  Case %IDC_UNLOAD_GRID"
      Call DestroyGrid(Wea)
      Call EnableWindow(GetDlgItem(Wea.hWnd,%IDC_RETRIEVE),%False)
      Call EnableWindow(GetDlgItem(Wea.hWnd,%IDC_UNLOAD_GRID),%False)
      Call EnableWindow(GetDlgItem(Wea.hWnd,%IDC_COLOR),%False)
      Call EnableWindow(GetDlgItem(Wea.hWnd,%IDC_GET_SELECTED_ROW),%False)
      Call InvalidateRect(Wea.hWnd,Byval %Null, %True)
      Prnt "Leaving fnWndProc_OnCommand()"
  End Select

  fnWndProc_OnCommand=0
End Function


Function fnWndProc_OnDestroy(Wea As WndEventArgs) As Long
  Prnt "Entering fnWndProc_OnDestroy()"
  Call DestroyGrid(Wea)
  Call CoFreeUnusedLibraries()
  Call PostQuitMessage(0)
  Prnt "Leaving fnWndProc_OnDestroy()"
  Function=0
End Function


Function fnWndProc(ByVal hWnd As Long,ByVal wMsg As Long,ByVal wParam As Long,ByVal lParam As Long) As Long
  Local wea As WndEventArgs
  Register iReturn As Long
  Register i As Long

  For i=0 To 2
    If wMsg=MsgHdlr(i).wMessage Then
       wea.hWnd=hWnd: wea.wParam=wParam: wea.lParam=lParam
       Call Dword MsgHdlr(i).dwFnPtr Using FnPtr(wea) To iReturn
       fnWndProc=iReturn
       Exit Function
    End If
  Next i

  fnWndProc=DefWindowProc(hWnd,wMsg,wParam,lParam)
End Function


Sub AttachMessageHandlers()
  ReDim MsgHdlr(2) As MessageHandler  'Associate Windows Message With Message Handlers
  MsgHdlr(0).wMessage=%WM_CREATE   :   MsgHdlr(0).dwFnPtr=CodePtr(fnWndProc_OnCreate)
  MsgHdlr(1).wMessage=%WM_COMMAND  :   MsgHdlr(1).dwFnPtr=CodePtr(fnWndProc_OnCommand)
  MsgHdlr(2).wMessage=%WM_DESTROY  :   MsgHdlr(2).dwFnPtr=CodePtr(fnWndProc_OnDestroy)
End Sub


Function WinMain(ByVal hIns As Long,ByVal hPrev As Long,ByVal lpCL As Asciiz Ptr,ByVal iShow As Long) As Long
  Local szAppName As ZStr*16
  Local wc As WndClassEx
  Local hWnd As Dword
  Local Msg As tagMsg

  Call AttachMessageHandlers()                    : szAppName="PBClient3"
  wc.lpszClassName=VarPtr(szAppName)              : wc.lpfnWndProc=CodePtr(fnWndProc)
  wc.cbClsExtra=0                                 : wc.cbWndExtra=12
  wc.style=%CS_HREDRAW Or %CS_VREDRAW             : wc.hInstance=hIns
  wc.cbSize=SizeOf(wc)                            : wc.hIcon=LoadIcon(%NULL, ByVal %IDI_APPLICATION)
  wc.hCursor=LoadCursor(%NULL, ByVal %IDC_ARROW)  : wc.hbrBackground=%COLOR_BTNFACE+1
  wc.lpszMenuName=%NULL
  Call RegisterClassEx(wc)
  hWnd=CreateWindowEx(0,szAppName,szAppName,%WS_OVERLAPPEDWINDOW,200,100,790,280,0,0,hIns,ByVal 0)
  Call ShowWindow(hWnd,iShow)
  While GetMessage(Msg,%NULL,0,0)
    TranslateMessage Msg
    DispatchMessage Msg
  Wend : MsgBox("Last Chance To Get What You Can!")

  Function=msg.wParam
End Function



[Frederick J. Harris]

Code: [Select]

' PBClient4
'
' Below is our simple alteration of DestroyGrid() where we've now replaced the two Nothing calls on pGrid
' and pConnectionPoint with Release() calls to see what happens ....
'
' Sub DestroyGrid(Wea As WndEventArgs)
'   Local pConnectionPoint As IConnectionPoint
'   Local pVnt As Variant Ptr
'   Local dwCookie As Dword
'   Local pGrid As IGrid
'
'   Prnt "  Entering DestroyGrid()"
'   pVnt=GetWindowLong(Wea.hWnd,0)
'   If pVnt Then
'      pGrid=@pVnt
'      pConnectionPoint=pGrid
'      pGrid.Release()
'      dwCookie=GetWindowLong(Wea.hWnd,4)
'      Call pConnectionPoint.Unadvise(dwCookie)
'      pGrid.Release()                            ' <<< Now calling Release() on pGrid instead of setting to Nothing
'      pConnectionPoint.Release()                 ' <<< Now calling Release() on pConnectionPoint rather than setting to Nothing
'      Call SetWindowLong(Wea.hWnd,0,0)
'      Call SetWindowLong(Wea.hWnd,4,0)
'      Call GlobalFree(pVnt)
'   Else
'      Prnt "    pGrid Was Already Released!"
'   End If
'   Prnt "  Leaving DestroyGrid()"
' End Sub
'
' And below is the console output from starting the program and simply x'ing out, as I've been doing all along here to
' study and elucidate object release and destruction issues ....

' Entering fnWndProc_OnDestroy()
'   Entering DestroyGrid()
'     Entering IGrid_QueryInterface()
'       Trying To Get IFHGrid
'       Entering IGrid_AddRef()
'         @pGrid.m_cRef =  1  << Before
'         @pGrid.m_cRef =  2  << After
'       Leaving IGrid_AddRef()
'       this =  5111376
'     Leaving IGrid_QueryInterface()
'
'     Entering IGrid_QueryInterface()
'       Trying To Get IConnectionPoint
'       this =  5111376
'       Entering IConnectionPoint_AddRef()
'         @pGrid.m_cRef =  2  << Before
'         @pGrid.m_cRef =  3  << After
'       Leaving IConnectionPoint_AddRef()
'       this =  5111384
'     Leaving IGrid_QueryInterface()
'
'     Entering IGrid_Release()
'       @pGrid.m_cRef =  3  << Before
'       @pGrid.m_cRef =  2  << After
'     Leaving IGrid_Release()
'
'     Entering IConnectionPoint_Unadvise()
'       this            =  5111384
'       dwCookie        =  0
'       @pGrid.hWndCtrl =  3343016
'       dwPtr           =  4141724
'       IGrid_Events::Release() Succeeded!
'       Release() Returned  0
'     Leaving IConnectionPoint_Unadvise()
'
'     Entering IGrid_Release()                          ' Here is the Release() call on pGrid ...
'       @pGrid.m_cRef =  2  << Before
'       @pGrid.m_cRef =  1  << After
'     Leaving IGrid_Release()
'
'     Entering IConnectionPoint_Release()               ' ... and here the one on pConnectionPoint, which finally
'       @pGrid.m_cRef  =  1    << Before                ' drops our reference count to zero, and triggers object
'       0     5106584     0                             ' destruction code.
'       1     5106588     0
'       2     5106592     0
'       3     5106596     0
'      @pGrid.m_cRef   = 0 And Will Now Delete pGrid!
'     Leaving IConnectionPoint_Release()
'   Leaving DestroyGrid()                               ' So, just like in the last example ( PBClient3 ), the
'                                                       ' grid is destroyed within the execution of the DestroyGrid()
'   Entering IGrid_Release()                            ' function.  However, take careful note of what happens next ...
'     @pGrid.m_cRef =  0  << Before
'     @pGrid.m_cRef = -1  << After                      '  WOW!!!!
'   Leaving IGrid_Release()
'
'   Entering IConnectionPoint_Release()                 '  WOW!!!
'     @pGrid.m_cRef = -1    << Before
'     @pGrid.m_cRef = -2    << After
'   Leaving IConnectionPoint_Release()
'
'   Entering DllCanUnloadNow()
'     I'm Outta Here! (dll is unloaded)
'   Leaving DllCanUnloadNow()
' Leaving fnWndProc_OnDestroy()
'
' Now I think that's interesting!  Even though the grid's reference count was driven down to zero by the Release() calls,
' and its automatic deallocation and destruction code was correctly executed, the PowerBASIC compiler still made its
' Release() calls on the local IGrid and IConnectionPoint interface pointers.  Since the actual reference counting member
' variable in the grid object was declared as a signed entity, that drove the reference count down to a minus two (-2).
' This didn't cause any problems, but nonetheless, I don't believe its a real good thing to let happen.  The reason it
' didn't cause any problems is because of the way I have my Release() methods coded in my grid.  Other objects could
' possible react to this in a less satisfactory way, and for that reason I'd suggest that care should be taken to see
' that Release() calls are not made on an object after it has already been released.  Here for example, is my
' IConnectionPoint::Release code ...

' Function IConnectionPoint_Release(ByVal this As IConnectionPoint1 Ptr) As Long
'   Local pGrid As CGrid Ptr
'   Register i As Long
'
'   #If %Def(%DEBUG)
'   Prnt "  Entering IConnectionPoint_Release()"
'   #EndIf
'   Decr this : Decr this
'   pGrid=this
'   #If %Def(%DEBUG)
'   Prnt "    @pGrid.m_cRef = " & Str$(@pGrid.m_cRef) & "    << Before"
'   #EndIf
'   Decr @pGrid.m_cRef
'   If @pGrid.m_cRef=0 Then                                       ' <<<< Destruction code only executed when @pGrid.m_cRef
'      #If %Def(%DEBUG)                                           ' hit exactly zero.
'      For i=0 To %MAX_CONNECTIONS-1
'        Prnt "    " & Str$(i) & "    " & _
'        Str$(Varptr(@pGrid.@pISink[i])) & _
'        "    " & Str$(@pGrid.@pISink[i])
'      Next i
'      #EndIf
'      Call DestroyWindow(@pGrid.hWndCtrl)
'      #If %Def(%DEBUG)
'      Prnt "    @pGrid.m_cRef = 0 And Will Now Delete pGrid!"
'      #EndIf
'      Call CoTaskMemFree(Byval @pGrid.pISink)
'      Call CoTaskMemFree(this)
'      Call InterlockedDecrement(g_lObjs)
'      #If %Def(%DEBUG)
'      Prnt "  Leaving IConnectionPoint_Release()"
'      #EndIf
'      Function=0
'   Else
'      #If %Def(%DEBUG)
'      Prnt "    @pGrid.m_cRef = " & Str$(@pGrid.m_cRef) & "    << After"
'      Prnt "  Leaving IConnectionPoint_Release()"
'      #EndIf
'      Function=@pGrid.m_cRef
'   End If
' End Function
'
' So you can see above that the extra Release() calls simply kept decrementing the reference counting member m_cRef
' rather than getting inside the If which would have surely have caused problems if already released memory was
' deallocated more than once.
'
' If you reflect on this I believe it makes it fairly clear what the difference is between Release() calls on an
' object and setting it to Nothing.  They both cause a Release() call on the object, but the Nothing keyword seems
' to tell the compiler not to garbage collect on the object when it goes out of scope.  There really aren't too
' many references to this in the PowerBASIC Help, but I did find this ...

'       The final issue in this topic is how to destroy an object variable. Generally speaking,
'       you do nothing at all.  When an object variable goes out of scope, PowerBASIC will handle
'       all the messy details for you.  For the most part, just forget about it.  However, in the
'       rare case that you need to destroy an object variable at a specific time and place, you
'       can do so with the following statement:
'
'       object1 = NOTHING
'
'       Setting an object variable to NOTHING handles it all for you.
'
' And this ...
'
'       LET objvar = NOTHING
'
'       This destroys an object variable, discontinuing its association with a specific object.
'       This in turn releases all system and memory resources associated with the object when no
'       more object variables refer to it.
'
' For me, that makes sense after I've experimented with this code as I have, but before that it was unclear
' in my mind the difference between Release() calls and setting the object variable to Nothing.
'
' In all these examples so far we've used variants which were dynamically allocated in which we stored
' our interface pointers.  To some, this might have raised the question as to whether it might be possible
' to just store the Objptr of the interface pointer directly in the WNDCLASSEX::cbWndExtra bytes.  As I
' believe I've previously stated (many times), this presents difficulties because PowerBASIC makes it
' difficult to reinstate an object pointer back into an interface variable.  This whole issue is a
' matter of variable 'casting'.
'
' Each programming language it seems has its own technique for converting a variable of one type into
' a variable of another type.  For example, in C or C++ if one had a variable typed as an IGrid pointer, i.e.,
' IGrid* pGrid, one could store that value in the WNDCLASSEX object with a call to SetWindowLong() as
' follows...
'
' SetWindowLong(hWnd, 0, (long)pGrid);
'
' To retrieve the IGrid interface pointer from the Window Class structure one would use this ...
'
' pGrid=(IGrid*)GetWindowLong(hWnd, 0);
'
' In the 1st case above with SetWindowLong(), the entity '(long)' in front of pGrid is known as a 'cast'.
' Its a message to the compiler to tell it that the number held in pGrid, which is an integral address,
' should be considered as a long, which is how the 3rd parameter of SetWindowLong() is typed.  In that case
' the compiler will allow the compilation it otherwise wouldn't.  In the same way with GetWindowLong() the
' entity '(IGrid*)' is prefaced to GetWindowLong(), and that tells the compiler that it should interpret
' the return value from GetWindowLong(), which is a long, as instead a pointer to an IGrid interface.  So
' that's the logic of casting when looking at the world through the eyes of C.
'
' The PowerBASIC compiler looks at the world through different colored glasses.  Instead of casts, which
' are hints to the compiler to treat a quantity in a different way, PowerBASIC uses conversion routines
' such as CInt, CDbl, etc.  There are a lot of them as you would see if you checked the manual.  But there
' isn't any CObj(), which would be a conversion routine to do the opposite of what ObjPtr does, that is, a
' routine which reinstates an integral address back into an object variable.  In the next example we'll
' look at creating our own so we don't have to resort to the awkwardness of using variants to store
' interface pointers.

#Compile                  Exe  "PBClient4.exe"
#Dim                      All
%UNICODE                  = 1
#If %Def(%UNICODE)
    Macro ZStr            = WStringz
    Macro BStr            = WString
    %SIZEOF_CHAR          = 2
#Else
    Macro ZStr            = Asciiz
    Macro BStr            = String
    %SIZEOF_CHAR          = 1
#EndIf
$CLSID_FHGrid             = GUID$("{20000000-0000-0000-0000-000000000084}")
$IID_IFHGrid              = GUID$("{20000000-0000-0000-0000-000000000085}")
$IID_IGridEvents          = GUID$("{20000000-0000-0000-0000-000000000086}")
%IDC_RETRIEVE             = 1500
%IDC_COLOR                = 1505
%IDC_UNLOAD_GRID          = 1510
%IDC_GET_SELECTED_ROW     = 1515
#Include                  "Win32Api.inc"  ' Uses PowerBASIC Includes

Type WndEventArgs
  wParam                  As Long
  lParam                  As Long
  hWnd                    As Dword
  hInst                   As Dword
End Type

Declare Function FnPtr(wea As WndEventArgs) As Long

Type MessageHandler
  wMessage                As Long
  dwFnPtr                 As Dword
End Type
Global MsgHdlr()          As MessageHandler


Sub Prnt(strLn As BStr)
  Local iLen, iWritten As Long
  Local hStdOutput As Dword
  Local strNew As BStr
  hStdOutput=GetStdHandle(%STD_OUTPUT_HANDLE)
  strNew=strLn + $CrLf
  iLen = Len(strNew)
  WriteConsole(hStdOutput, Byval Strptr(strNew), iLen, iWritten, Byval 0)
End Sub


Interface IGrid $IID_IFHGrid : Inherit IAutomation    ' This is the Grid's Interface (a standard incoming Interface, i.e.,
  Method CreateGrid _                                 ' method calls are coming into the grid from the client).
  ( _
    Byval hParent             As Long, _
    Byval strSetup            As BStr, _
    Byval x                   As Long, _
    Byval y                   As Long, _
    Byval cx                  As Long, _
    Byval cy                  As Long, _
    Byval iRows               As Long, _
    Byval iCols               As Long, _
    Byval iRowHt              As Long, _
    Byval iSelectionBackColor As Long, _
    Byval iSelectionTextColor As Long, _
    Byval strFontName         As BStr, _
    Byval iFontSize           As Long, _
    Byval iFontWeight         As Long _
  )
  Method SetRowCount(Byval iRowCount As Long, Byval blnForce As Long)
  Method SetData(Byval iRow As Long, Byval iCol As Long, Byval strData As WString)
  Method GetData(Byval iRow As Long, Byval iCol As Long) As WString
  Method FlushData()
  Method Refresh()
  Method GetCtrlId() As Long
  Method GethGrid() As Long
  Method GethComboBox(Byval iCol As Long) As Long
  Method SetCellAttributes(Byval iRow As Long, Byval iCol As Long, Byval iBackColor As Long, Byval iTextColor As Long) As Long
  Method DeleteRow(Byval iRow As Long)
End Interface


Class CGridEvents  As Event
  Instance hMain As Dword

  Class Method Create()
    Prnt "  Called Class Method Create()!"
    hMain=FindWindow("PBClient4","PBClient4")
    Prnt "    hMain = " & Str$(hMain)
    Prnt "  Leaving Class Method Create()
  End Method

  Interface IGridEvents $IID_IGridEvents : Inherit IAutomation
    Method Grid_OnKeyPress(Byval iKeyCode As Long, Byval iKeyData As Long, Byval iRow As Long, Byval iCol As Long, Byref blnCancel As Long)
      Prnt "Got KeyPress From CGridEvents1!" & Str$(iKeyCode) & "=" & Chr$(iKeyCode)
    End Method

    Method Grid_OnKeyDown(Byval iKeyCode As Long, Byval iKeyData As Long, Byval iRow As Long, Byval iCol As Long, Byref blnCancel As Long)
      Prnt "Got KeyDown From CGridEvents1!" & Str$(iKeyCode) & "=" & Chr$(iKeyCode)
    End Method

    Method Grid_OnLButtonDown(Byval iCellRow As Long, Byval iGridRow As Long, Byval iCol As Long)
      Prnt "Got WM_LBUTTONDOWN In Grid Cell From CGridEvents1" & "(" & Trim$(Str$(iGridRow)) & "," & Trim$(Str$(iCol)) & ")"
    End Method

    Method Grid_OnLButtonDblClk(Byval iCellRow As Long, Byval iGridRow As Long, Byval iCol As Long)
      ' Insert your code here
    End Method

    Method Grid_OnPaste(Byval iCellRow As Long, Byval iGridRow As Long, Byval iCol As Long)
      ' Insert your code here
    End Method

    Method Grid_OnRowSelection(Byval iRow As Long, Byval iAction As Long)
      Prnt "  Entering Grid_OnRowSelection(GridEvents)"
      Prnt "    iRow    = " & Str$(iRow)
      Prnt "    iAction = " & Str$(iAction)
      If iAction Then
         Call SetWindowLong(hMain,8,iRow)
      Else
         Call SetWindowLong(hMain,8,0)
      End If
      Prnt "  Leaving Grid_OnRowSelection(GridEvents)"
    End Method

    Method Grid_OnDelete(Byval iRow As Long)
      Local pVnt As Variant Ptr
      Local pGrid As IGrid

      Prnt "  Entering Grid_OnDelete()"
      Prnt "    iRow = " & Str$(iRow)
      pVnt=GetWindowLong(hMain,0)
      pGrid=@pVnt
      Call pGrid.DeleteRow(iRow)
      Call pGrid.Refresh()
      Set pGrid=Nothing
      Prnt "  Leaving Grid_OnDelete()"
    End Method
  End Interface
End Class


Function fnWndProc_OnCreate(Wea As WndEventArgs) As Long          ' Offset      Item
  Local pConnectionPointContainer As IConnectionPointContainer    ' =============================
  Local pConnectionPoint As IConnectionPoint                      ' 0  -  3     IGrid Ptr - pGrid
  Local pCreateStruct As CREATESTRUCT Ptr                         ' 4  -  7     dwCookie
  Local strSetup,strCoordinate As BStr                            ' 8  - 11     iSelectedRow
  Local pSink As IGridEvents
  Local pVnt As Variant Ptr
  Local EventGuid As Guid
  Local dwCookie As Dword
  Local szName As ZStr*16
  Local pGrid As IGrid
  Local hCtl As Dword
  Register i As Long
  Register j As Long

  Call AllocConsole()
  Prnt "Entering fnWndProc_OnCreate()"
  pCreateStruct=wea.lParam
  wea.hInst=@pCreateStruct.hInstance
  Let pGrid = NewCom "FHGrid8.Grid"
  Prnt "  Objptr(pGrid) = " & Str$(Objptr(pGrid))
  pVnt=GlobalAlloc(%GPTR, 16)
  @pVnt=pGrid 'assign interface to variant
  Call SetWindowLong(Wea.hWnd,0,pVnt)
  strSetup="120:Column 1:^:edit,130:Column 2:^:edit,140:Column 3:^:edit,150:Column 4:^:edit,160:Column 5:^:combo"
  pGrid.CreateGrid(Wea.hWnd,strSetup,190,10,570,218,12,5,28,0,0,"Times New Roman",18,%FW_DONTCARE)
  pConnectionPointContainer = pGrid
  EventGuid=$IID_IGridEvents
  Call pConnectionPointContainer.FindConnectionPoint(Byval Varptr(EventGuid),Byval Varptr(pConnectionPoint))
  Let pSink = Class  "CGridEvents"
  Prnt "  Objptr(pSink) = " & Str$(Objptr(pSink))
  Call pConnectionPoint.Advise(Byval Objptr(pSink), dwCookie)
  Call SetWindowLong(Wea.hWnd,4,dwCookie)
  Prnt "  dwCookie      = " & Str$(dwCookie)
  For i=1 To 12
    For j=1 To 5
      strCoordinate="(" & Trim$(Str$(i)) & "," & Trim$(Str$(j)) & ")"
      pGrid.SetData(i, j, strCoordinate)
    Next j
  Next i
  pGrid.Refresh()
  hCtl=CreateWindow("button","Retrieve Cell (3,2)",%WS_CHILD Or %WS_VISIBLE,10,20,150,30,Wea.hWnd,%IDC_RETRIEVE,Wea.hInst,ByVal 0)
  hCtl=CreateWindow("button","Color Some Rows",%WS_CHILD Or %WS_VISIBLE,10,70,150,30,Wea.hWnd,%IDC_COLOR,Wea.hInst,ByVal 0)
  hCtl=CreateWindow("button","Get Selected Row",%WS_CHILD Or %WS_VISIBLE,10,120,150,30,Wea.hWnd,%IDC_GET_SELECTED_ROW,Wea.hInst,ByVal 0)
  hCtl=CreateWindow("button","Unload Grid",%WS_CHILD Or %WS_VISIBLE,10,170,150,30,Wea.hWnd,%IDC_UNLOAD_GRID,Wea.hInst,ByVal 0)
  hCtl=pGrid.GethComboBox(5)
  Prnt "  hCtl = " & Str$(hCtl)
  szName="Frederick" : Call SendMessage(hCtl,%CB_INSERTSTRING,-1,Varptr(szName))
  szName="Elsie"     : Call SendMessage(hCtl,%CB_INSERTSTRING,-1,Varptr(szName))
  szName="Scott"     : Call SendMessage(hCtl,%CB_INSERTSTRING,-1,Varptr(szName))
  szName="Lorrie"    : Call SendMessage(hCtl,%CB_INSERTSTRING,-1,Varptr(szName))
  szName="Joseph"    : Call SendMessage(hCtl,%CB_INSERTSTRING,-1,Varptr(szName))
  szName="Frank"     : Call SendMessage(hCtl,%CB_INSERTSTRING,-1,Varptr(szName))
  Prnt "Leaving fnWndProc_OnCreate()"

  fnWndProc_OnCreate=0
End Function


Sub DestroyGrid(Wea As WndEventArgs)
  Local pConnectionPoint As IConnectionPoint
  Local pVnt As Variant Ptr
  Local dwCookie As Dword
  Local pGrid As IGrid

  Prnt "  Entering DestroyGrid()"
  pVnt=GetWindowLong(Wea.hWnd,0)
  If pVnt Then
     pGrid=@pVnt
     pConnectionPoint=pGrid
     pGrid.Release()
     dwCookie=GetWindowLong(Wea.hWnd,4)
     Call pConnectionPoint.Unadvise(dwCookie)
     pGrid.Release()
     pConnectionPoint.Release()
     Call SetWindowLong(Wea.hWnd,0,0)
     Call SetWindowLong(Wea.hWnd,4,0)
     Call GlobalFree(pVnt)
  Else
     Prnt "    pGrid Was Already Released!"
  End If
  Prnt "  Leaving DestroyGrid()"
End Sub


Function fnWndProc_OnCommand(Wea As WndEventArgs) As Long
  Local pVnt As Variant Ptr
  Local strData As BStr
  Local pGrid As IGrid
  Local iCnt As Long
  Register i As Long

  Select Case As Long Lowrd(Wea.wParam)
    Case %IDC_RETRIEVE
      Prnt "Entering fnWndProc_OnCommand()"
      Prnt "  Case %IDC_RETRIEVE"
      pVnt=GetWindowLong(Wea.hWnd,0)
      pGrid=@pVnt
      Prnt "  iCnt = " & Str$(iCnt)
      pGrid.FlushData()
      strData=pGrid.GetData(3,2)
      Prnt "  Cell 3,2 Contains " & strData
      Prnt "Leaving fnWndProc_OnCommand()"
    Case %IDC_COLOR
      If Hiwrd(Wea.wParam)=%BN_CLICKED Then
         Prnt "Entering fnWndProc_OnCommand()"
         Prnt "  Case %IDC_COLOR
         pVnt=GetWindowLong(Wea.hWnd,0)
         pGrid=@pVnt
         pGrid.FlushData()
         For i=1 To 5
           pGrid.SetCellAttributes(3,i,&H000000FF,&H00FFFFFF)
         Next i
         For i=1 To 5
           pGrid.SetCellAttributes(4,i,&H0000FF00,&H00FFFFFF)
         Next i
         For i=1 To 5
           pGrid.SetCellAttributes(5,i,&H00FF0000,&H00FFFFFF)
         Next i
         For i=1 To 5
           pGrid.SetCellAttributes(6,i,RGB(255,255,0),&H00000001)
         Next i
         pGrid.Refresh()
         Prnt "Leaving fnWndProc_OnCommand()"
      End If
    Case %IDC_GET_SELECTED_ROW
      If GetWindowLong(Wea.hWnd,8) Then
         MsgBox("Selected Row = " & Str$(GetWindowLong(Wea.hWnd,8)))
      Else
         MsgBox("No Row Selected!")
      End If
    Case %IDC_UNLOAD_GRID
      Prnt "Entering fnWndProc_OnCommand()"
      Prnt "  Case %IDC_UNLOAD_GRID"
      Call DestroyGrid(Wea)
      Call EnableWindow(GetDlgItem(Wea.hWnd,%IDC_RETRIEVE),%False)
      Call EnableWindow(GetDlgItem(Wea.hWnd,%IDC_UNLOAD_GRID),%False)
      Call EnableWindow(GetDlgItem(Wea.hWnd,%IDC_COLOR),%False)
      Call EnableWindow(GetDlgItem(Wea.hWnd,%IDC_GET_SELECTED_ROW),%False)
      Call InvalidateRect(Wea.hWnd,Byval %Null, %True)
      Prnt "Leaving fnWndProc_OnCommand()"
  End Select

  fnWndProc_OnCommand=0
End Function


Function fnWndProc_OnDestroy(Wea As WndEventArgs) As Long
  Prnt "Entering fnWndProc_OnDestroy()"
  Call DestroyGrid(Wea)
  Call CoFreeUnusedLibraries()
  Call PostQuitMessage(0)
  Prnt "Leaving fnWndProc_OnDestroy()"
  Function=0
End Function


Function fnWndProc(ByVal hWnd As Long,ByVal wMsg As Long,ByVal wParam As Long,ByVal lParam As Long) As Long
  Local wea As WndEventArgs
  Register iReturn As Long
  Register i As Long

  For i=0 To 2
    If wMsg=MsgHdlr(i).wMessage Then
       wea.hWnd=hWnd: wea.wParam=wParam: wea.lParam=lParam
       Call Dword MsgHdlr(i).dwFnPtr Using FnPtr(wea) To iReturn
       fnWndProc=iReturn
       Exit Function
    End If
  Next i

  fnWndProc=DefWindowProc(hWnd,wMsg,wParam,lParam)
End Function


Sub AttachMessageHandlers()
  ReDim MsgHdlr(2) As MessageHandler  'Associate Windows Message With Message Handlers
  MsgHdlr(0).wMessage=%WM_CREATE   :   MsgHdlr(0).dwFnPtr=CodePtr(fnWndProc_OnCreate)
  MsgHdlr(1).wMessage=%WM_COMMAND  :   MsgHdlr(1).dwFnPtr=CodePtr(fnWndProc_OnCommand)
  MsgHdlr(2).wMessage=%WM_DESTROY  :   MsgHdlr(2).dwFnPtr=CodePtr(fnWndProc_OnDestroy)
End Sub


Function WinMain(ByVal hIns As Long,ByVal hPrev As Long,ByVal lpCL As Asciiz Ptr,ByVal iShow As Long) As Long
  Local szAppName As ZStr*16
  Local wc As WndClassEx
  Local hWnd As Dword
  Local Msg As tagMsg

  Call AttachMessageHandlers()                    : szAppName="PBClient4"
  wc.lpszClassName=VarPtr(szAppName)              : wc.lpfnWndProc=CodePtr(fnWndProc)
  wc.cbClsExtra=0                                 : wc.cbWndExtra=12
  wc.style=%CS_HREDRAW Or %CS_VREDRAW             : wc.hInstance=hIns
  wc.cbSize=SizeOf(wc)                            : wc.hIcon=LoadIcon(%NULL, ByVal %IDI_APPLICATION)
  wc.hCursor=LoadCursor(%NULL, ByVal %IDC_ARROW)  : wc.hbrBackground=%COLOR_BTNFACE+1
  wc.lpszMenuName=%NULL
  Call RegisterClassEx(wc)
  hWnd=CreateWindowEx(0,szAppName,szAppName,%WS_OVERLAPPEDWINDOW,200,100,790,280,0,0,hIns,ByVal 0)
  Call ShowWindow(hWnd,iShow)
  While GetMessage(Msg,%NULL,0,0)
    TranslateMessage Msg
    DispatchMessage Msg
  Wend : MsgBox("Last Chance To Get What You Can!")

  Function=msg.wParam
End Function

I had posted a bad version and had to re-post the above.

[José Roca]

What happens is that your code is flawed.

Code: [Select]

      pVnt=GetWindowLong(hMain,0)
      pGrid=@pVnt
      Call pGrid.DeleteRow(iRow)
      Call pGrid.Refresh()
      Set pGrid=Nothing

It should be:

Code: [Select]

      pVnt=GetWindowLong(hMain,0)
      pGrid=@pVnt
      pGrid.AddRef
      Call pGrid.DeleteRow(iRow)
      Call pGrid.Refresh()
      Set pGrid=Nothing

You're bypassing PB's automatic reference counting with pGrid=@pVnt, so it needs to be followed by pGrid.AddRef.

[Frederick J. Harris]

Not sure what you are talking about Jose.  I've looked at the PBClient1 and PBClient4 code I posted, and I see no problems with what I've done, other than the fact that I presented PBClient4 as an example of failed code, where reference counting was indeed screwed up.  I have several more clients to post with full discussions written up, but just haven't gotten around to posting them yet.  However, I did take the time to code and test a variant where I added the .AddRef() call you mentioned, and I can say for certain that that is the wrong thing to do.  Here is the out of sequence example (PBClient7) using exactly what you just recommended, and afterwards is the console output which clearly shows the reference counting mischief it caused...

Code: [Select]

' PBClient7.bas               ' !!! Code Fails To Unload Grid!!!
'
#Compile                      Exe  "PBClient7.exe"
#Dim                          All
%UNICODE                      = 1
#If %Def(%UNICODE)
    Macro ZStr                = WStringz
    Macro BStr                = WString
    %SIZEOF_CHAR              = 2
#Else
    Macro ZStr                = Asciiz
    Macro BStr                = String
    %SIZEOF_CHAR              = 1
#EndIf
$CLSID_FHGrid                 = GUID$("{20000000-0000-0000-0000-000000000084}")
$IID_IFHGrid                  = GUID$("{20000000-0000-0000-0000-000000000085}")
$IID_IGridEvents              = GUID$("{20000000-0000-0000-0000-000000000086}")
%IDC_RETRIEVE                 = 1500
%IDC_COLOR                    = 1505
%IDC_UNLOAD_GRID              = 1510
%IDC_GET_SELECTED_ROW         = 1515
#Include                      "Win32Api.inc"           ' Using PowerBASIC Includes.

Type WndEventArgs
  wParam                      As Long
  lParam                      As Long
  hWnd                        As Dword
  hInst                       As Dword
End Type

Declare Function FnPtr(wea As WndEventArgs) As Long

Type MessageHandler
  wMessage                    As Long
  dwFnPtr                     As Dword
End Type

Global MsgHdlr()              As MessageHandler


Sub Prnt(strLn As BStr)
  Local iLen, iWritten As Long
  Local hStdOutput As Dword
  Local strNew As BStr
  hStdOutput=GetStdHandle(%STD_OUTPUT_HANDLE)
  strNew=strLn + $CrLf
  iLen = Len(strNew)
  WriteConsole(hStdOutput, Byval Strptr(strNew), iLen, iWritten, Byval 0)
End Sub


Interface IGrid $IID_IFHGrid  : Inherit IAutomation    ' This is the Grid's Interface (a standard incoming Interface, i.e.,
  Method CreateGrid _                                  ' method calls are coming into the grid from the client).
  ( _
    Byval hParent             As Long, _
    Byval strSetup            As BStr, _
    Byval x                   As Long, _
    Byval y                   As Long, _
    Byval cx                  As Long, _
    Byval cy                  As Long, _
    Byval iRows               As Long, _
    Byval iCols               As Long, _
    Byval iRowHt              As Long, _
    Byval iSelectionBackColor As Long, _
    Byval iSelectionTextColor As Long, _
    Byval strFontName         As BStr, _
    Byval iFontSize           As Long, _
    Byval iFontWeight         As Long _
  )
  Method SetRowCount(Byval iRowCount As Long, Byval blnForce As Long)
  Method SetData(Byval iRow As Long, Byval iCol As Long, Byval strData As WString)
  Method GetData(Byval iRow As Long, Byval iCol As Long) As WString
  Method FlushData()
  Method Refresh()
  Method GetCtrlId() As Long
  Method GethGrid() As Long
  Method GethComboBox(Byval iCol As Long) As Long
  Method SetCellAttributes(Byval iRow As Long, Byval iCol As Long, Byval iBackColor As Long, Byval iTextColor As Long) As Long
  Method DeleteRow(Byval iRow As Long)
End Interface


Class CGridEvents  As Event
  Instance hMain As Dword

  Class Method Create()
    Prnt "  Called Class Method Create()!"
    hMain=FindWindow("PBClient7","PBClient7")
    Prnt "    hMain = " & Str$(hMain)
    Prnt "  Leaving Class Method Create()
  End Method

  Interface IGridEvents $IID_IGridEvents : Inherit IAutomation
    Method Grid_OnKeyPress(Byval iKeyCode As Long, Byval iKeyData As Long, Byval iRow As Long, Byval iCol As Long, Byref blnCancel As Long)
      Prnt "Got KeyPress From CGridEvents1!" & Str$(iKeyCode) & "=" & Chr$(iKeyCode)
    End Method

    Method Grid_OnKeyDown(Byval iKeyCode As Long, Byval iKeyData As Long, Byval iRow As Long, Byval iCol As Long, Byref blnCancel As Long)
      Prnt "Got KeyDown From CGridEvents1!" & Str$(iKeyCode) & "=" & Chr$(iKeyCode)
    End Method

    Method Grid_OnLButtonDown(Byval iCellRow As Long, Byval iGridRow As Long, Byval iCol As Long)
      Prnt "Got WM_LBUTTONDOWN In Grid Cell From CGridEvents1" & "(" & Trim$(Str$(iGridRow)) & "," & Trim$(Str$(iCol)) & ")"
    End Method

    Method Grid_OnLButtonDblClk(Byval iCellRow As Long, Byval iGridRow As Long, Byval iCol As Long)
      ' Insert your code here
    End Method

    Method Grid_OnPaste(Byval iCellRow As Long, Byval iGridRow As Long, Byval iCol As Long)
      ' Insert your code here
    End Method

    Method Grid_OnRowSelection(Byval iRow As Long, Byval iAction As Long)
      Prnt "  Entering Grid_OnRowSelection(GridEvents)"
      Prnt "    iRow    = " & Str$(iRow)
      Prnt "    iAction = " & Str$(iAction)
      If iAction Then
         Call SetWindowLong(hMain,8,iRow)
      Else
         Call SetWindowLong(hMain,8,0)
      End If
      Prnt "  Leaving Grid_OnRowSelection(GridEvents)"
    End Method

    Method Grid_OnDelete(Byval iRow As Long)
      Local pVnt As Variant Ptr
      Local pGrid As IGrid
      Prnt "  Entering Grid_OnDelete()"
      Prnt "    iRow = " & Str$(iRow)
      pVnt=GetWindowLong(hMain,0)
      pGrid=@pVnt
      pGrid.AddRef()                          '  <<< Here is the line Jose wants to see
      Call pGrid.DeleteRow(iRow)
      Call pGrid.Refresh()
      Set pGrid=Nothing
      Prnt "  Leaving Grid_OnDelete()"
    End Method
  End Interface
End Class


Function fnWndProc_OnCreate(Wea As WndEventArgs) As Long  ' Offset      Item
  Local pCreateStruct As CREATESTRUCT Ptr                 ' =======================================
  Local strSetup,strCoordinate As BStr                    ' 0  -  3     IGrid Ptr        - pGrid
  Local pSink As IGridEvents                              ' 4  -  7     IGridEvents Ptr  - pSink
  Local pVnt As Variant Ptr                               ' 8  -  11    Store Current Selected Row
  Local szName As ZStr*16
  Local pGrid As IGrid                                    ' In your typical Windows GUI program its certainly not necessary or desirable to
  Local hCtl As Dword                                     ' store the Window Handles of child window controls at global scope.  Afterall,
  Register i As Long                                      ' one can always obtain the window handle ( HWND ) of a child window control through
  Register j As Long                                      ' its control id using the GetDlgItem() function, whose only parameters are the parent
                                                          ' window handle and the control id of the desired child window control.  What you don't
  Call AllocConsole()                                     ' need to worry about when you adorn your GUI programs with child window controls is
  Prnt "Entering fnWndProc_OnCreate()"                    ' that Windows will prematurely and randomly destroy them for you after their creation.
  pCreateStruct=wea.lParam                                ' If you decide to include ActiveX Controls in your program though, excrutiating
  wea.hInst=@pCreateStruct.hInstance                      ' difficulties can arise if you attempt to deal with them in as caviliar a fashion as you
  Let pGrid = NewCom "FHGrid8.Grid"                       ' might with a standard Windows control such a a text box or combo box - or even a
  Prnt "  Objptr(pGrid) = " & Str$(Objptr(pGrid))         ' Common Control such as a Progress Bar or Calendar Control. The problem is that these
  pVnt=GlobalAlloc(%GPTR, 16)                             ' things are 'reference counted' within your client program code, and if you don't
  @pVnt=pGrid 'assign interface to variant                ' declare their object variables at global scope, you risk having the compiler's garbage
  Call SetWindowLong(Wea.hWnd,0,pVnt)                     ' collection code deallocate and destroy these things as local stack based objects.  For
  strSetup= _                                             ' example, just left PowerBASIC's NewCom statement is used in this WM_CREATE handler to
  "120:Column 1:^:edit," & _                              ' instantiate a my grid control.  However, note that the pGrid variable of type IGrid
  "130:Column 2:^:edit," & _                              ' is declared as a local in this procedure.  In fact this whole program has no global
  "140:Column 3:^:edit," & _                              ' variables, aside from possibly MsgHdlr(), which actually doesn't hold variables, but
  "150:Column 4:^:edit," & _                              ' rather constants, i.e., names of Windows Messages, and the addresses of the message
  "160:Column 5:^:combo"                                  ' handling function which handles each respective message.  So, getting back to pGrid,
  pGrid.CreateGrid _                                      ' which is actually a local interface pointer, if NewCom() succeeds in creating the
  ( _                                                     ' grid control, QueryInterface() code within the grid dll will call AddRef() on the
    Wea.hWnd, _  ' HWND of Parent                         ' pointer before it is returned to this code here, and that will set the reference count
    strSetup, _  ' Setup String For Grid                  ' to one.  However, being as pGrid is a local object variable, the PowerBASIC compiler
    190, _       ' Top Left Corner x                      ' will call a Release() on the pointer at procedure termination in its effort to prevent
    10, _        ' Top Left Corner y                      ' memory leaks.  What it will do here with this object variable isn't conceptually any
    570, _       ' Grid Width                             ' different than what it would do with a locally allocated String or WString object.
    218, _       ' Grid Height                            ' Any memory it allocated to store a local string would be released after the procedure
    12, _        ' # Rows Data In Grid                    ' exits.  It really has to do this or your program would 'eat' memory until it crashed
    5, _         ' # Columns In Grid                      ' the system.  The problem with that behavior here is that a Release() call on the local
    28, _        ' Row Ht In Pixels                       ' IGrid pointer pGrid will cause our reference count of one ( 1 ) to fall to zero ( 0 ),
    0, _         ' Cell Back Color                        ' and when that happens COM objects automatically deallocate and destroy themselves!  So
    0, _         ' Cell Text Color                        ' what would happen here in that case is that the grid would be successfully created in
    "Times New Roman", _ ' Font Name                      ' this WM_CREATE handler, but the user of this program would never see it, as nothing
    18, _        ' Font Size                              ' that takes place during or immediately after a WM_CREATE call is visible to the user.
    %FW_DONTCARE _  ' Font Weight                         ' Only after WM_PAINT does a window/app become visible to the user, and by that time, in
  )                                                       ' relative computer time terms, the grid would have been long dead.  The only answer
  Let pSink = Class  "CGridEvents"                        ' to this dilema, other than making the COM based control a global, is to store the valid
  Events From pGrid Call pSink                            ' interface pointer somewhere, and 'artifically' increment its reference count so that
  pVnt=GlobalAlloc(%GPTR, 16)                             ' PowerBASIC's garbage collection of local stack based objects won't allow the reference
  @pVnt=pSink                                             ' count to fall to zero, which condition causes the object to destroy itself.  That is
  Call SetWindowLong(Wea.hWnd,4,pVnt)                     ' exactly what you are seeing take place in this code upper left where a Variant Ptr object
  For i=1 To 12                                           ' named pVnt is pointed at a dynamically allocated 16 byte chunk of memory where a Variant
    For j=1 To 5                                          ' can be stored.  Into that variant memory our pGrid interface pointer is stored with the
      strCoordinate= _                                    ' statement @pVnt=pGrid.  This line has a very interesting side effect.  PowerBASIC
      "(" & Trim$(Str$(i)) & _                            ' interprets the equal operator ( = ) as a QueryInterface() call on the object for in this
      "," & Trim$(Str$(j)) & ")"                          ' case the IUnknown of the object.  This will cause a second AddRef() call on the object,
      pGrid.SetData(i, j, strCoordinate)                  ' and that will bump the reference count to two ( 2 ).  If you create the grid dll and
    Next j                                                ' compile and run this code, you'll easily see this in the voluminous console output
  Next i                                                  ' produced by a run of the code.  The net effect of this is that the compiler's clean up
  pGrid.Refresh()                                         ' of the local IGrid object pGrid at procedure termination will only cause the reference
  hCtl=CreateWindow _                                     ' count on the object to fall to one ( 1 ) - not zero ( 0 ).  The grid will keep itself
  ( _                                                     ' in memory and you'll see and be able to use it.  While its address held in pGrid will
    "button", _                                           ' go out of scope, you'll note above that it was saved in the WNDCLASSEX::cbWndExtra bytes
    "Retrieve Cell (3,2)", _                              ' by a call to SetWindowLong() right after the variant assignment.
    %WS_CHILD Or %WS_VISIBLE, _
    10, _                                                 ' The remainder of this procedure attaches the event sink to the grid, and creates some
    20, _                                                 ' buttons which exercise the grid in various self-explanatory ways.  Also, the combo box
    150, _                                                ' established in the fifth column of the grid is loaded with a few strings.  One of the
    30, _                                                 ' grid methods returns a handle to the combo box the grid created within itself if you
    Wea.hWnd, _                                           ' pass into the call the column ( 5 ) of the grid where the handle is you want.
    %IDC_RETRIEVE, _
    Wea.hInst, _
    ByVal 0 _
  )
  hCtl=CreateWindow("button","Color Some Rows",%WS_CHILD Or %WS_VISIBLE,10,70,150,30,Wea.hWnd,%IDC_COLOR,Wea.hInst,ByVal 0)
  hCtl=CreateWindow("button","Get Selected Row",%WS_CHILD Or %WS_VISIBLE,10,120,150,30,Wea.hWnd,%IDC_GET_SELECTED_ROW,Wea.hInst,ByVal 0)
  hCtl=CreateWindow("button","Unload Grid",%WS_CHILD Or %WS_VISIBLE,10,170,150,30,Wea.hWnd,%IDC_UNLOAD_GRID,Wea.hInst,ByVal 0)
  hCtl=pGrid.GethComboBox(5)
  Prnt "  hCtl = " & Str$(hCtl)
  szName="Frederick" : Call SendMessage(hCtl,%CB_INSERTSTRING,-1,Varptr(szName))
  szName="Elsie"     : Call SendMessage(hCtl,%CB_INSERTSTRING,-1,Varptr(szName))
  szName="Scott"     : Call SendMessage(hCtl,%CB_INSERTSTRING,-1,Varptr(szName))
  szName="Lorrie"    : Call SendMessage(hCtl,%CB_INSERTSTRING,-1,Varptr(szName))
  szName="Joseph"    : Call SendMessage(hCtl,%CB_INSERTSTRING,-1,Varptr(szName))
  szName="Frank"     : Call SendMessage(hCtl,%CB_INSERTSTRING,-1,Varptr(szName))
  Prnt "Leaving fnWndProc_OnCreate()"

  fnWndProc_OnCreate=0
End Function


Sub DestroyGrid(Wea As WndEventArgs)              '  Entering fnWndProc_OnDestroy()         ' DestroyGrid() is called by either clicking the 'Unload Grid'
  Local pSink As IGridEvents                      '    Entering DestroyGrid()               ' button on the main form, or by 'x' ing out from the Title Bar.
  Local pVnt As Variant Ptr                       '      pSink =  2896540                   ' The output just left is from a program run where I just
  Local pGrid As IGrid                            '                                         ' started the program, then immediately x'ed out to get the
  Local iCnt As Long                              '      Entering IGrid_QueryInterface()    ' debug console output.  At this point I don't have too much to
                                                  '        Trying To Get IFHGrid            ' say about Release() 'ing the sink.  Let's move down to the
  Prnt "  Entering DestroyGrid()"                 '        Entering IGrid_AddRef()          ' Release() of the grid pointer stored at offset zero ( 0 ) in
  ' First, Release Sink ...                       '          @pGrid.m_cRef =  1  << Before  ' the WNDCLASSEX::cbWndExtra bytes.
  pVnt=GetWindowLong(Wea.hWnd,4)                  '          @pGrid.m_cRef =  2  << After
  If pVnt Then                                    '        Leaving IGrid_AddRef()           ' First, a GetWindowLong() call retrieves the pointer to the
     pSink=@pVnt                                  '        this =  6815312                  ' varient stored at offset zero in the .cbWndExtra bytes.  Then
     Prnt "    pSink = " & Str$(ObjPtr(pSink))    '      Leaving IGrid_QueryInterface()     ' the object stored in the Variant is copied to an IGrid pointer
     If IsObject(pSink) Then                      '                                         ' pGrid.  That's what caused the 'Entering IGrid_QueryInterface()'
        Events End pSink                          '      pGrid =  6815312                   ' call just a few lines up from here just left.  Notice that from
        Set pSink=Nothing                         '                                         ' within the dll we are being told that an IGrid pointer is being
     End If                                       '      Entering IGrid_Release()           ' requested.  The grid's QueryInterface() can satisfy that request,
     Call SetWindowLong(Wea.hWnd,4,0)             '        @pGrid.m_cRef =  2  << Before    ' and so the pointer is returned, and an AddRef() is called on the
     Call GlobalFree(pVnt)                        '        @pGrid.m_cRef =  1  << After     ' pointer, which now brings up the reference count on the object
  Else                                            '      Leaving IGrid_Release()            ' up to two ( 2 ).  The first would be the pointer stored in the
     Prnt "    pSink Was Already Released!"       '                                         ' .cbWndExtra bytes up in WM_CREATE, and the second would be the
  End If                                          '      iCnt =  1                          ' local reference just stored in the local pGrid pointer here in
                                                  '     Leaving DestroyGrid()               ' DestroyGrid().  Then, right after the IsObject(pGrid) test on
  ' Then, Release Grid ...                        '                                         ' pGrid we see a Release() call - Call pGrid.Release().  Let's
  pVnt=GetWindowLong(Wea.hWnd,0)                  '     Entering IGrid_Release()            ' consider that call to be a release or undoing of the storage of
  If pVnt Then                                    '       @pGrid.m_cRef =  1  << Before     ' the IGrid pointer up in the WM_CREATE handler where we put it in
     pGrid=@pVnt                                  '       0     6810520     2896540         ' the WNDCLASSEX::cbWndExtra bytes.  That call brings our reference
     Prnt "    pGrid = " & Str$(ObjPtr(pGrid))    '       1     6810524     0               ' count on the grid down to one ( 1 ).  Notice that in the remainder
     If IsObject(pGrid) Then                      '       2     6810528     0               ' of the DestroyGrid() procedure there are no more calls from the
        Call pGrid.Release() To iCnt              '       3     6810532     0               ' pGrid pointer.  Its still valid and the object is still alive;
        Prnt "    iCnt = " & Str$(iCnt)           '       @pGrid.m_cRef = 0   << After      ' but we're just taking care of other housekeeping chores.  The
        Call SetWindowLong(Wea.hWnd,0,0)          '       Grid Was Deleted!                 ' procedure then exits and we get a message to that effect.  But
     End If                                       '     Leaving IGrid_Release()             ' then look what happens immediately!  There is a call from within
     Call GlobalFree(pVnt)                        '                                         ' the grid of 'IGrid_Release().  Now what caused that call?  What
  Else                                            '     Entering DllCanUnloadNow()          ' caused it is the PowerBASIC compiler generated clean up code
     Prnt "    pGrid Was Already Released!"       '       I'm Outta Here! (dll is unloaded) ' cleaning up the local stack variables of the DestroyGrid()
  End If                                          '     Leaving DllCanUnloadNow()           ' function.  One of those locals was an IGrid pointer holding a
  Prnt "  Leaving DestroyGrid()"                  '  Leaving fnWndProc_OnDestroy()          ' valid address.  The compiler calls the Release(), knocking back
End Sub                                                                                     ' the reference count to zero, and the grid destroys itself....


Function fnWndProc_OnCommand(Wea As WndEventArgs) As Long                                   ' ... What is about as interesting if you look down in
  Local pVnt As Variant Ptr                                                                 ' fnWndProc_OnDestroy() is a call to CoFreeUnusedLibraries() right
  Local strData As BStr                                                                     ' after the call to DestroyGrid() which we just exited.  Note that
  Local pGrid As IGrid                                                                      ' we're still in the fnWndProc_OnDestroy() handler tripped by the
  Local dwPtr As Dword                                                                      ' click of the 'x' button the close the window.  Anyway, the
  Local iCnt As Long                                                                        ' CoFreeUnusedLibraries() Api call queries the system for any dlls
  Register i As Long                                                                        ' laying around taking up memory that aren't being used by any
                                                                                            ' program, i.e., they don't have any active clients.  COM Dlls
  Select Case As Long Lowrd(Wea.wParam)                                                     ' maintain a couple internal counters to track this.  There is a
    Case %IDC_RETRIEVE                                                                      ' counter for locks and a counter for live objects.  At this point
      Prnt "Entering fnWndProc_OnCommand()"                                                 ' in the program both are at zero so DllCanUnloadNow() (an exported
      Prnt "  Case %IDC_RETRIEVE"                                                           ' Dll function) returns %S_OK and the system goes ahead and releases
      pVnt=GetWindowLong(Wea.hWnd,0)                                                        ' the COM Dll itself.  If you look inside that function in FHGrid8.bas
      pGrid=@pVnt                                                                           ' you'll see the 'I'm Outta Here!' phrase.
      pGrid.FlushData()
      strData=pGrid.GetData(3,2)
      Prnt "  Cell 3,2 Contains " & strData
      Prnt "Leaving fnWndProc_OnCommand()"
    Case %IDC_COLOR
      If Hiwrd(Wea.wParam)=%BN_CLICKED Then
         Prnt "Entering fnWndProc_OnCommand()"
         Prnt "  Case %IDC_COLOR
         pVnt=GetWindowLong(Wea.hWnd,0)
         pGrid=@pVnt
         pGrid.FlushData()
         For i=1 To 5
           pGrid.SetCellAttributes(3,i,&H000000FF,&H00FFFFFF)
         Next i
         For i=1 To 5
           pGrid.SetCellAttributes(4,i,&H0000FF00,&H00FFFFFF)
         Next i
         For i=1 To 5
           pGrid.SetCellAttributes(5,i,&H00FF0000,&H00FFFFFF)
         Next i
         For i=1 To 5
           pGrid.SetCellAttributes(6,i,RGB(255,255,0),&H00000001)
         Next i
         pGrid.Refresh()
         Prnt "Leaving fnWndProc_OnCommand()"
      End If
    Case %IDC_GET_SELECTED_ROW
      If GetWindowLong(Wea.hWnd,8) Then
         MsgBox("Selected Row = " & Str$(GetWindowLong(Wea.hWnd,8)))
      Else
         MsgBox("No Row Selected!")
      End If
    Case %IDC_UNLOAD_GRID
      Prnt "Entering fnWndProc_OnCommand()"
      Prnt "  Case %IDC_UNLOAD_GRID"
      Call DestroyGrid(Wea)
      Call EnableWindow(GetDlgItem(Wea.hWnd,%IDC_RETRIEVE),%False)
      Call EnableWindow(GetDlgItem(Wea.hWnd,%IDC_UNLOAD_GRID),%False)
      Call EnableWindow(GetDlgItem(Wea.hWnd,%IDC_COLOR),%False)
      Call EnableWindow(GetDlgItem(Wea.hWnd,%IDC_GET_SELECTED_ROW),%False)
      Call InvalidateRect(Wea.hWnd,Byval %Null, %True)
      Prnt "Leaving fnWndProc_OnCommand()"
  End Select

  fnWndProc_OnCommand=0
End Function


Function fnWndProc_OnDestroy(Wea As WndEventArgs) As Long
  Prnt "Entering fnWndProc_OnDestroy()"
  Call DestroyGrid(Wea)
  Call CoFreeUnusedLibraries()
  Call PostQuitMessage(0)
  Prnt "Leaving fnWndProc_OnDestroy()"
  Function=0
End Function


Function fnWndProc(ByVal hWnd As Long,ByVal wMsg As Long,ByVal wParam As Long,ByVal lParam As Long) As Long
  Local wea As WndEventArgs
  Register iReturn As Long
  Register i As Long

  For i=0 To 2
    If wMsg=MsgHdlr(i).wMessage Then
       wea.hWnd=hWnd: wea.wParam=wParam: wea.lParam=lParam
       Call Dword MsgHdlr(i).dwFnPtr Using FnPtr(wea) To iReturn
       fnWndProc=iReturn
       Exit Function
    End If
  Next i

  fnWndProc=DefWindowProc(hWnd,wMsg,wParam,lParam)
End Function


Sub AttachMessageHandlers()
  ReDim MsgHdlr(2) As MessageHandler  'Associate Windows Message With Message Handlers
  MsgHdlr(0).wMessage=%WM_CREATE   :   MsgHdlr(0).dwFnPtr=CodePtr(fnWndProc_OnCreate)
  MsgHdlr(1).wMessage=%WM_COMMAND  :   MsgHdlr(1).dwFnPtr=CodePtr(fnWndProc_OnCommand)
  MsgHdlr(2).wMessage=%WM_DESTROY  :   MsgHdlr(2).dwFnPtr=CodePtr(fnWndProc_OnDestroy)
End Sub


Function WinMain(ByVal hIns As Long,ByVal hPrev As Long,ByVal lpCL As Asciiz Ptr,ByVal iShow As Long) As Long
  Local szAppName As ZStr*16
  Local wc As WndClassEx
  Local hWnd As Dword
  Local Msg As tagMsg

  Call AttachMessageHandlers()                    : szAppName="PBClient7"
  wc.lpszClassName=VarPtr(szAppName)              : wc.lpfnWndProc=CodePtr(fnWndProc)
  wc.cbClsExtra=0                                 : wc.cbWndExtra=12
  wc.style=%CS_HREDRAW Or %CS_VREDRAW             : wc.hInstance=hIns
  wc.cbSize=SizeOf(wc)                            : wc.hIcon=LoadIcon(%NULL, ByVal %IDI_APPLICATION)
  wc.hCursor=LoadCursor(%NULL, ByVal %IDC_ARROW)  : wc.hbrBackground=%COLOR_BTNFACE+1
  wc.lpszMenuName=%NULL
  Call RegisterClassEx(wc)
  hWnd=CreateWindowEx(0,szAppName,szAppName,%WS_OVERLAPPEDWINDOW,200,100,790,280,0,0,hIns,ByVal 0)
  Call ShowWindow(hWnd,iShow)
  While GetMessage(Msg,%NULL,0,0)
    TranslateMessage Msg
    DispatchMessage Msg
  Wend : MsgBox("Last Chance To Get What You Can!")

  Function=msg.wParam
End Function

Here is the console output with comments.  The gist of it is that two AddRefs occur instead of only the one needed, and the object fails to release.  The output below is obtainable by starting PBClient7.bas, highlighting a row and hitting the [DELETE] keyboard button to delete the row, then x'ing out of the app...

next post ...

[Frederick J. Harris]

Output from PBClient7 showing failure to release grid due to extra unneeded AddRef() in delete routine.  Its not needed because QueryInterface automatically AddRefs the returned pointer ...

Code: [Select]

Entering fnWndProc_OnCreate()
  Entering DllGetClassObjectImpl()
    Entering IClassFactory_QueryInterface()
      Entering IClassFactory_AddRef()
        g_lObjs =  1
      Leaving IClassFactory_AddRef()
      this =  9968324
    Leaving IClassFactory_QueryInterface()
    IClassFactory_QueryInterface() For iid Succeeded!
  Leaving DllGetClassObjectImpl()

  Entering IClassFactory_CreateInstance()
    pGrid                      =  1366584
    Varptr(@pGrid.lpIGridVtbl) =  1366584
    Varptr(@pGrid.lpICPCVtbl)  =  1366588
    Varptr(@pGrid.lpICPVtbl)   =  1366592
    @pGrid.pISink              =  1359536
    @ppv                       =  0  << Before QueryInterface() Call
    Entering IGrid_QueryInterface()
      Trying To Get IFHGrid
      Entering IGrid_AddRef()
        @pGrid.m_cRef =  0  << Before
        @pGrid.m_cRef =  1  << After
      Leaving IGrid_AddRef()
      this =  1366584
    Leaving IGrid_QueryInterface()
    @ppv                       =  1366584  << After QueryInterface() Call
    Entering Initialize() -- Initialize()
      GetModuleHandle()        =  9895936
    Leaving Initialize()
  Leaving IClassFactory_CreateInstance()

  Entering IGrid_AddRef()
    @pGrid.m_cRef =  1  << Before
    @pGrid.m_cRef =  2  << After
  Leaving IGrid_AddRef()

  Entering IGrid_Release()
    @pGrid.m_cRef =  2  << Before
    @pGrid.m_cRef =  1  << After
  Leaving IGrid_Release()

  Entering IClassFactory_Release()
    g_lObjs =  1
  Leaving IClassFactory_Release()

  Entering IGrid_QueryInterface()
    Trying To Get IFHGrid
    Entering IGrid_AddRef()
      @pGrid.m_cRef =  1  << Before
      @pGrid.m_cRef =  2  << After
    Leaving IGrid_AddRef()
    this =  1366584
  Leaving IGrid_QueryInterface()

  Entering IGrid_Release()
    @pGrid.m_cRef =  2  << Before
    @pGrid.m_cRef =  1  << After
  Leaving IGrid_Release()

  Objptr(pGrid) =  1366584

  Entering IGrid_QueryInterface()
    Looking For Something I Ain't Got!
  Leaving IGrid_QueryInterface()

  Entering IGrid_QueryInterface()
    Trying To Get IUnknown
    Entering IGrid_AddRef()
      @pGrid.m_cRef =  1  << Before
      @pGrid.m_cRef =  2  << After
    Leaving IGrid_AddRef()
    this =  1366584
  Leaving IGrid_QueryInterface()

  Entering IGrid_CreateGrid()
    this                =  1366584
    hContainer          =  3146208
    strSetup            = 120:Column 1:^:edit,130:Column 2:^:edit,140:Column 3:^:edit,150:Column 4:^:edit,160:Column 5:^:combo
    x                   =  190
    y                   =  10
    cx                  =  570
    cy                  =  218
    iRows               =  12
    iCols               =  5
    iRowHt              =  28
    iSelectionBackColor = 0
    iSelectionTextColor = 0
    strFontName         = Times New Roman
    iFontSize           =  18
    iFontWeight         =  0
    GetLastError() =  0
    hGrid          =  1311260
    pGridData      =  1368120
  Leaving IGrid_CreateGrid()

  Called Class Method Create()!
    hMain =  3146208
  Leaving Class Method Create()

  Entering IGrid_QueryInterface()
    Trying To Get IConnectionPointContainer
    this =  1366584
    Entering IConnectionPointContainer_AddRef()
      @pGrid.m_cRef =  2  << Before
      @pGrid.m_cRef =  3  << After
    Leaving IConnectionPointContainer_AddRef()
    this =  1366588
  Leaving IGrid_QueryInterface()

  Entering IConnectionPointContainer_FindConnectionPoint()
    this  =  1366588
    @ppCP =  0
    Entering IConnectionPointContainer_QueryInterface()
      Looking For IID_IConnectionPoint
      Entering IConnectionPoint_AddRef()
        @pGrid.m_cRef =  3  << Before
        @pGrid.m_cRef =  4  << After
      Leaving IConnectionPoint_AddRef()
    Leaving IConnectionPointContainer_QueryInterface()
    @ppCP =  1366592
  Leaving IConnectionPointContainer_FindConnectionPoint()

  Entering IConnectionPoint_Advise()!  Grab Your Hardhat And Hang On Tight!
    this               =  1366592
    pGrid              =  1366584
    @pGrid.hControl    =  1311260
    pUnkSink           =  1366620
    Vtbl               =  2108757
    @Vtbl[0]           =  2116396
    dwPtr              =  1366620
    Call Dword Succeeded!
    0     1359536     0  Found Open Slot!
    Will Be Able To Store Connection Point!
  Leaving IConnectionPoint_Advise() And Still In One Piece!

  Entering IConnectionPoint_Release()
    @pGrid.m_cRef =  4    << Before
    @pGrid.m_cRef =  3    << After
  Leaving IConnectionPoint_Release()

  Entering IConnectionPointContainer_Release()
    @pGrid.m_cRef =  3  << Before
    @pGrid.m_cRef =  2  << After
  Leaving IConnectionPointContainer_Release()
  hCtl =  590452
Leaving fnWndProc_OnCreate()

Entering IGrid_Release()
  @pGrid.m_cRef =  2  << Before
  @pGrid.m_cRef =  1  << After
Leaving IGrid_Release()

Entering fnGridProc_OnCommand()                               ' Most of this code here is from inside the COM grid dll,
  pGridData          =  1368120                               ' and involves all the nastiness involved in clicking one
  @pGridData.pComObj =  1366584                               ' of the verticle aligned button controls just to the left
  pGrid              =  1366584                               ' of each row of cells in the grid.

  i     pGrid.@pISink[i]  @pGrid.@pISink[i]
  =========================================
  0     1359536               1366620
  1     1359540               0
  2     1359544               0
  3     1359548               0
  Lowrd(Wea.wParam) =  20004
  iGridRow          =  4
  We Got In Where @pGridData.blnSelected = %False!
  @pGridData.iSelectedRow   =  4
  @pGridData.blnRowSelected =  1
  Entering Grid_OnRowSelection(GridEvents)
    iRow    =  4
    iAction =  1
  Leaving Grid_OnRowSelection(GridEvents)
  Call Dword @Vtbl[8] Using ptrRowSelection() Succeeded!
  @pGridData.blnRowSelected =  1
Leaving fnGridProc_OnCommand()

Entering fnGridProc_OnKeyDown()                              ' Most of this code here is likewise from within the grid's WM_KEYDOWN
  A Row Is Selected!  The Selected Row Is  4                 ' handler, and runs when a row is 'Selected', and one presses the [DELETE]
  Entering Grid_OnDelete()                                   ' key. 
    iRow =  4
    Entering IGrid_QueryInterface()                          ' <<< There is the code that executes when this line is encountered in
      Trying To Get IFHGrid                                  ' the client ...
      Entering IGrid_AddRef()
        @pGrid.m_cRef =  1  << Before                        '                             pGrid=@pVnt   
        @pGrid.m_cRef =  2  << After                         '
      Leaving IGrid_AddRef()                                 ' The PowerBASIC compiler fully recognizes that as the assignment of an
      this =  1366584                                        ' IUnknown generic object pointer to an IGrid interface pointer, and does
    Leaving IGrid_QueryInterface()                           ' an automatic QueryInterface() on it.  Within the Dll QueryInterface()
                                                             ' automatically AddRef()'s all pointers returned.  So that line drive the
    Entering IGrid_AddRef()                                  ' reference count to 2.
      @pGrid.m_cRef =  2  << Before                          ' <<< Here <<< the extra AddRef() Jose wants to make is unnecessary and
      @pGrid.m_cRef =  3  << After                           ' drives the reference count up to 3, which is unnecessary, as two (2) is
    Leaving IGrid_AddRef()                                   ' all that is needed - one for the saved interface pointer in the .cbWndExtra
                                                             ' bytes, and one for the IGrid pointer being used in .Grid_OnDelete().  The
    Entering IGrid_DeleteRow()                               ' problem comes in when this procedure exits and pGrid is set to Nothing.
      pGrid     =  1366584                                   ' What happens there is that only one Release() will occur, which drops the
      hGrid     =  1311260                                   ' reference count from 3 to 2.  When you click the x to close the program it
      pGridData =  1368120                                   ' now has an extra reference count it doesn't release, and the grid won't
      iRow      =  4                                         ' unload satisfactorily.
      iSize     =  54
      iStart    =  15
      iCols     =  5
    Leaving IGrid_DeleteRow()

    Entering IGrid_Release()
      @pGrid.m_cRef =  3  << Before
      @pGrid.m_cRef =  2  << After
    Leaving IGrid_Release()
  Leaving Grid_OnDelete()
Leaving fnGridProc_OnKeyDown()

Entering fnWndProc_OnDestroy()
  Entering DestroyGrid()
    pSink =  1366620
    Entering IGrid_QueryInterface()
      Trying To Get IFHGrid
      Entering IGrid_AddRef()
        @pGrid.m_cRef =  2  << Before
        @pGrid.m_cRef =  3  << After
      Leaving IGrid_AddRef()
      this =  1366584
    Leaving IGrid_QueryInterface()
    pGrid =  1366584

    Entering IGrid_Release()
      @pGrid.m_cRef =  3  << Before
      @pGrid.m_cRef =  2  << After
    Leaving IGrid_Release()
    iCnt =  2
  Leaving DestroyGrid()
  Entering IGrid_Release()
    @pGrid.m_cRef =  2  << Before
    @pGrid.m_cRef =  1  << After
  Leaving IGrid_Release()
  Entering DllCanUnloadNow()
    The System Wants Rid Of Me But I Won't Go!            ' <<<<< Its still got that extra AddRef() it can't deal with!!!!!!
  Leaving DllCanUnloadNow()
Leaving fnWndProc_OnDestroy()


[Frederick J. Harris]

Code: [Select]

' PBClient5.bas
'
' So what we'll do here is simply use Objptr(pGrid) to store the address of our IGrid interface pointer
' returned by NewCom to the WNDCLASSEX::cbWndExtra bytes.  If you are still not understanding what the
' commotion is all about, try this little nonsense console program...
'

' #Compile Exe
' #Dim All
'
' Interface IGrid : Inherit IUnknown                 ' just make a dummy interface with a couple methods
'   Method CreateGrid()  As Long
'   Method DestroyGrid() As Long
' End Interface
'
' Function PBMain() As Long
'   Local pGrid As IGrid                             ' declare an IGrid interface variable, which, as with
'                                                    ' all newly declared variables, PowerBASIC sets to null.
'   'Con.Print "pGrid        = " pGrid               ' then just try to print it out.  you can't.  It won't compile.
'   Con.Print "Objptr(pGrid) = " Objptr(pGrid)       ' to get this to compile and output a zero you need to
'   Con.Waitkey$                                     ' comment out the Print pGrid statement.  Note that
'                                                    ' there is no problem outputting the Objptr(pGrid), which
'   PBMain=0                                         ' just gives a zero.
' End Function
'
'
' 'Objptr(pGrid) =  0
'
' As you should be beginning to see, the extent of freedom you have with PowerBASIC object variables is
' carefully constrained by the language.  Of course, having to use Objptr(pGrid) to store an interface pointer
' in the .cbWndExtra bytes isn't terribly onerous.  However, things get considerably trickier when one attempts
' to reuse an interface pointer so stored, as, for example, we must do in our DestroyGrid() routine to
' disconnect the connection point and release the grid.  As you recall, the GetWindowLong() function can be
' used to retrieve our IGrid interface pointer stored using Objptr up in fnWndProc_OnCreate(), but that function
' returns a long, and PowerBASIC won't allow you to take that long and reassign it to a local IGrid interface
' pointer such as pGrid.  If you try, you'll get this compilation error ...
'
'   Error 482 in C:\Code\PwrBasic\PBWin10\COM\Grids\v8\Series\PBClient5.bas(240:009):  Data type mismatch

'   Line 240:   pGrid=GetWindowLong(Wea.hWnd,0)

'
' As I've mentioned before, when PowerBASIC sees an uninitialized object/interface variable, it wants to see
' it initialized either through a NewCom, GetCom, or AnyCom call, or through its retrieval from a variant, which
' has an IUnknown object type as one of its many possible union members.  It manifestly doesn't want to see an
' object variable initialized from a long, dword, integer, pointer variants of the aforementioned, or anything
' like that.  It simply won't allow it.  However, one can go behind PowerBASIC's back, so to speak, and Poke the
' integral address into the quantity referenced by the declared object variable.  I learned this from Steven
' Pringels, who said he may have got it from Jose Roca, but he wasn't completely certain about that.  So what it
' could look like then, that is, our 'hack' to get our IGrid interface pointer stored in the .cbWndExtra bytes
' into a locally declared interface variable, is something like this ...
'
' Macro  CObj(pUnk, dwAddr)                   ' Used to convert an address to an object.  This could
'   Poke Dword, Varptr(pUnk), dwAddr          ' be a new feature suggestion!
'   pUnk.AddRef()
' End Macro
'
' That dasdardly abomination does the job!  Here is the output from starting this program, then immediately
' x'ing out ...
'
' Entering fnWndProc_OnDestroy()
'
'   Entering DestroyGrid()
'     Entering IGrid_AddRef()
'       @pGrid.m_cRef =  1  << Before
'       @pGrid.m_cRef =  2  << After
'     Leaving IGrid_AddRef()
'     Entering IGrid_QueryInterface()
'       Trying To Get IConnectionPoint
'       this =  2096720
'       Entering IConnectionPoint_AddRef()
'         @pGrid.m_cRef =  2  << Before
'         @pGrid.m_cRef =  3  << After
'       Leaving IConnectionPoint_AddRef()
'       this =  2096728
'     Leaving IGrid_QueryInterface()
'     Entering IGrid_Release()
'       @pGrid.m_cRef =  3  << Before
'       @pGrid.m_cRef =  2  << After
'     Leaving IGrid_Release()
'     Entering IConnectionPoint_Unadvise()
'       this            =  2096728
'       dwCookie        =  0
'       @pGrid.hWndCtrl =  1442320
'       dwPtr           =  3678668
'       IGrid_Events::Release() Succeeded!
'       Release() Returned  0
'     Leaving IConnectionPoint_Unadvise()
'   Leaving DestroyGrid()
'
'   Entering IGrid_Release()
'     @pGrid.m_cRef =  2  << Before
'     @pGrid.m_cRef =  1  << After
'   Leaving IGrid_Release()
'
'   Entering IConnectionPoint_Release()
'     @pGrid.m_cRef =  1    << Before
'     0     2091928     0
'     1     2091932     0
'     2     2091936     0
'     3     2091940     0
'     @pGrid.m_cRef = 0 And Will Now Delete pGrid!
'   Leaving IConnectionPoint_Release()
'
'   Entering DllCanUnloadNow()
'     I'm Outta Here! (dll is unloaded)
'   Leaving DllCanUnloadNow()
' Leaving fnWndProc_OnDestroy()
'
' As you can see, as soon as we enter DestroyGrid() we pick up an AddRef() from within our CObj Macro.  Then
' we get another when set pConnectionPoint = pGrid, which causes a QueryInterface in the grid, and another
' AddRef() is called from there, which brings us up to three.  Then we Release() the one we came into the
' procedure with from up in fnWndProc_OnCreate(), and that just leaves us with the two locals in DestroyGrid().
' And PowerBASIC calls auto releases on both of those when DestroyGrid() exits, and the grid unloads itself.
'
' Given what we've learned so far, could't we substitute Nothing calls on those local interface pointes?
' Lets try that in PBClient6.  For now, here is PBClient5 ...

#Compile                  Exe  "PBClient5.exe"
#Dim                      All
%UNICODE                  = 1
#If %Def(%UNICODE)
    Macro ZStr            = WStringz
    Macro BStr            = WString
    %SIZEOF_CHAR          = 2
#Else
    Macro ZStr            = Asciiz
    Macro BStr            = String
    %SIZEOF_CHAR          = 1
#EndIf
$CLSID_FHGrid             = GUID$("{20000000-0000-0000-0000-000000000084}")
$IID_IFHGrid              = GUID$("{20000000-0000-0000-0000-000000000085}")
$IID_IGridEvents          = GUID$("{20000000-0000-0000-0000-000000000086}")
%IDC_RETRIEVE             = 1500
%IDC_COLOR                = 1505
%IDC_UNLOAD_GRID          = 1510
%IDC_GET_SELECTED_ROW     = 1515
#Include                  "Win32Api.inc"    ' Uses PowerBASIC Includes

Type WndEventArgs
  wParam                  As Long
  lParam                  As Long
  hWnd                    As Dword
  hInst                   As Dword
End Type

Declare Function FnPtr(wea As WndEventArgs) As Long

Type MessageHandler
  wMessage                As Long
  dwFnPtr                 As Dword
End Type
Global MsgHdlr()          As MessageHandler


Macro  CObj(pUnk, dwAddr)                   ' Used to convert an address to an object.  This could
  Poke Dword, Varptr(pUnk), dwAddr          ' be a new feature suggestion!
  pUnk.AddRef()
End Macro


Sub Prnt(strLn As BStr)
  Local iLen, iWritten As Long
  Local hStdOutput As Dword
  Local strNew As BStr
  hStdOutput=GetStdHandle(%STD_OUTPUT_HANDLE)
  strNew=strLn + $CrLf
  iLen = Len(strNew)
  WriteConsole(hStdOutput, Byval Strptr(strNew), iLen, iWritten, Byval 0)
End Sub


Interface IGrid $IID_IFHGrid : Inherit IAutomation    ' This is the Grid's Interface (a standard incoming Interface, i.e.,
  Method CreateGrid _                                 ' method calls are coming into the grid from the client).
  ( _
    Byval hParent             As Long, _
    Byval strSetup            As BStr, _
    Byval x                   As Long, _
    Byval y                   As Long, _
    Byval cx                  As Long, _
    Byval cy                  As Long, _
    Byval iRows               As Long, _
    Byval iCols               As Long, _
    Byval iRowHt              As Long, _
    Byval iSelectionBackColor As Long, _
    Byval iSelectionTextColor As Long, _
    Byval strFontName         As BStr, _
    Byval iFontSize           As Long, _
    Byval iFontWeight         As Long _
  )
  Method SetRowCount(Byval iRowCount As Long, Byval blnForce As Long)
  Method SetData(Byval iRow As Long, Byval iCol As Long, Byval strData As WString)
  Method GetData(Byval iRow As Long, Byval iCol As Long) As WString
  Method FlushData()
  Method Refresh()
  Method GetCtrlId() As Long
  Method GethGrid() As Long
  Method GethComboBox(Byval iCol As Long) As Long
  Method SetCellAttributes(Byval iRow As Long, Byval iCol As Long, Byval iBackColor As Long, Byval iTextColor As Long) As Long
  Method DeleteRow(Byval iRow As Long)
End Interface


Class CGridEvents  As Event
  Instance hMain As Dword

  Class Method Create()
    Prnt "  Called Class Method Create()!"
    hMain=FindWindow("PBClient5","PBClient5")
    Prnt "    hMain = " & Str$(hMain)
    Prnt "  Leaving Class Method Create()
  End Method

  Interface IGridEvents $IID_IGridEvents : Inherit IAutomation
    Method Grid_OnKeyPress(Byval iKeyCode As Long, Byval iKeyData As Long, Byval iRow As Long, Byval iCol As Long, Byref blnCancel As Long)
      Prnt "Got KeyPress From CGridEvents1!" & Str$(iKeyCode) & "=" & Chr$(iKeyCode)
    End Method
    Method Grid_OnKeyDown(Byval iKeyCode As Long, Byval iKeyData As Long, Byval iRow As Long, Byval iCol As Long, Byref blnCancel As Long)
      Prnt "Got KeyDown From CGridEvents1!" & Str$(iKeyCode) & "=" & Chr$(iKeyCode)
    End Method
    Method Grid_OnLButtonDown(Byval iCellRow As Long, Byval iGridRow As Long, Byval iCol As Long)
      Prnt "Got WM_LBUTTONDOWN In Grid Cell From CGridEvents1" & "(" & Trim$(Str$(iGridRow)) & "," & Trim$(Str$(iCol)) & ")"
    End Method
    Method Grid_OnLButtonDblClk(Byval iCellRow As Long, Byval iGridRow As Long, Byval iCol As Long)
      ' Insert your code here
    End Method
    Method Grid_OnPaste(Byval iCellRow As Long, Byval iGridRow As Long, Byval iCol As Long)
      ' Insert your code here
    End Method
    Method Grid_OnRowSelection(Byval iRow As Long, Byval iAction As Long)
      Prnt "  Entering Grid_OnRowSelection(GridEvents)"
      Prnt "    iRow    = " & Str$(iRow)
      Prnt "    iAction = " & Str$(iAction)
      If iAction Then
         Call SetWindowLong(hMain,8,iRow)
      Else
         Call SetWindowLong(hMain,8,0)
      End If
      Prnt "  Leaving Grid_OnRowSelection(GridEvents)"
    End Method
    Method Grid_OnDelete(Byval iRow As Long)
      Local pGrid As IGrid
      Local dwPtr As Dword

      Prnt "  Entering Grid_OnDelete()"
      Prnt "    iRow = " & Str$(iRow)
      dwPtr=GetWindowLong(hMain,0)
      CObj(pGrid,dwPtr)
      Call pGrid.AddRef()
      Call pGrid.DeleteRow(iRow)
      Call pGrid.Refresh()
      Prnt "  Leaving Grid_OnDelete()"
    End Method
  End Interface
End Class


Function fnWndProc_OnCreate(Wea As WndEventArgs) As Long          'Offset      Item
  Local pConnectionPointContainer As IConnectionPointContainer    '=====================================================================
  Local pConnectionPoint As IConnectionPoint                      '0  -  3     IGrid Ptr - pGrid
  Local pCreateStruct As CREATESTRUCT Ptr                         '4  -  7     dwCookie
  Local strSetup,strCoordinate As BStr                            '8  - 11     iSelectedRow
  Local pSink As IGridEvents
  Local EventGuid As Guid
  Local dwCookie As Dword
  Local szName As ZStr*16
  Local pGrid As IGrid
  Local hCtl As Dword
  Register i As Long
  Register j As Long

  Call AllocConsole()
  Prnt "Entering fnWndProc_OnCreate()"
  pCreateStruct=wea.lParam : wea.hInst=@pCreateStruct.hInstance
  Let pGrid = NewCom "FHGrid8.Grid"
  Prnt "  Objptr(pGrid) = " & Str$(Objptr(pGrid))
  Call SetWindowLong(Wea.hWnd,0,Objptr(pGrid))
  pGrid.AddRef()
  strSetup="120:Column 1:^:edit,130:Column 2:^:edit,140:Column 3:^:edit,150:Column 4:^:edit,160:Column 5:^:combo"
  pGrid.CreateGrid(Wea.hWnd,strSetup,190,10,570,218,12,5,28,0,0,"Times New Roman",18,%FW_DONTCARE)
  pConnectionPointContainer = pGrid
  EventGuid=$IID_IGridEvents
  Call pConnectionPointContainer.FindConnectionPoint(Byval Varptr(EventGuid),Byval Varptr(pConnectionPoint))
  Let pSink = Class  "CGridEvents"
  Prnt "  Objptr(pSink) = " & Str$(Objptr(pSink))
  Call pConnectionPoint.Advise(Byval Objptr(pSink), dwCookie)
  Prnt "  dwCookie      = " & Str$(dwCookie)
  Call SetWindowLong(Wea.hWnd,4,dwCookie)
  For i=1 To 12
    For j=1 To 5
      strCoordinate="(" & Trim$(Str$(i)) & "," & Trim$(Str$(j)) & ")"
      pGrid.SetData(i, j, strCoordinate)
    Next j
  Next i
  pGrid.Refresh()
  hCtl=CreateWindow("button","Retrieve Cell (3,2)",%WS_CHILD Or %WS_VISIBLE,10,20,150,30,Wea.hWnd,%IDC_RETRIEVE,Wea.hInst,ByVal 0)
  hCtl=CreateWindow("button","Color Some Rows",%WS_CHILD Or %WS_VISIBLE,10,70,150,30,Wea.hWnd,%IDC_COLOR,Wea.hInst,ByVal 0)
  hCtl=CreateWindow("button","Get Selected Row",%WS_CHILD Or %WS_VISIBLE,10,120,150,30,Wea.hWnd,%IDC_GET_SELECTED_ROW,Wea.hInst,ByVal 0)
  hCtl=CreateWindow("button","Unload Grid",%WS_CHILD Or %WS_VISIBLE,10,170,150,30,Wea.hWnd,%IDC_UNLOAD_GRID,Wea.hInst,ByVal 0)
  hCtl=pGrid.GethComboBox(5)     ' this line and method gets the handle to the combo box put in the 5th column of the grid
  Prnt "  hCtl = " & Str$(hCtl)
  szName="Frederick" : Call SendMessage(hCtl,%CB_INSERTSTRING,-1,Varptr(szName))     ' put some strings in the combo box
  szName="Elsie"     : Call SendMessage(hCtl,%CB_INSERTSTRING,-1,Varptr(szName))
  szName="Scott"     : Call SendMessage(hCtl,%CB_INSERTSTRING,-1,Varptr(szName))
  szName="Lorrie"    : Call SendMessage(hCtl,%CB_INSERTSTRING,-1,Varptr(szName))
  szName="Joseph"    : Call SendMessage(hCtl,%CB_INSERTSTRING,-1,Varptr(szName))
  szName="Frank"     : Call SendMessage(hCtl,%CB_INSERTSTRING,-1,Varptr(szName))
  Prnt "Leaving fnWndProc_OnCreate()"

  fnWndProc_OnCreate=0
End Function

Sub DestroyGrid(Wea As WndEventArgs)             ' Instead of using a variant to transfer and/or store the IGrid
  Local pConnectionPoint As IConnectionPoint     ' interface pointer, which is rather roundabout, here we're
  Local dwCookie,dwPtr As Dword                  ' just storing and retrieving the address directly.  However,
  Local pGrid As IGrid                           ' due to PowerBASIC's somewhat protective instinct of trying
                                                 ' to protect us from ourselves, so that we don't shoot ourselves
  Prnt "  Entering DestroyGrid()"                ' in the foot so to speak, it won't let us easily reinstate the
  dwPtr=GetWindowLong(Wea.hWnd,0)                ' address from the GetWindowLong() memory into our object variable
  If dwPtr Then                                  ' pGrid.  So we created our macro CObj() to do that.  That Macro
     CObj(pGrid,dwPtr)                           ' automatically AddRef's the pointer, so all we do here is Release()
     pConnectionPoint=pGrid                      ' the AddRef() we did up in fnWndProc_OnCreate().  When DestroyGrid()
     pGrid.Release()                             ' terminates PowerBASIC's clean up code calls Release() on the two
     dwCookie=GetWindowLong(Wea.hWnd,4)          ' local interface pointers allocated in this procedure.  Apparently,
     Call pConnectionPoint.Unadvise(dwCookie)    ' at that point, its not asking any questions, or casting any
     Call SetWindowLong(Wea.hWnd,0,0)            ' judgement, upon the ledgitimacy of how the interface pointers came
     Call SetWindowLong(Wea.hWnd,4,0)            ' to be initialized with non zero values.  All it apparently sees
  Else                                           ' is that the two pointers are referencing non null memory, and it
     Prnt "    pGrid Was Already Released!"      ' dutuifully calls releases on them and all's well that ends well!
  End If
  Prnt "  Leaving DestroyGrid()"
End Sub


Function fnWndProc_OnCommand(Wea As WndEventArgs) As Long
  Local strData As BStr
  Local pGrid As IGrid
  Local dwPtr As Dword
  Local iCnt As Long
  Register i As Long

  Select Case As Long Lowrd(Wea.wParam)
    Case %IDC_RETRIEVE
      Prnt "Entering fnWndProc_OnCommand()"
      Prnt "  Case %IDC_RETRIEVE"
      dwPtr=GetWindowLong(Wea.hWnd,0)
      Prnt "  dwPtr = " & Str$(dwPtr)
      CObj(pGrid,dwPtr)
      Call pGrid.AddRef() To iCnt
      Prnt "  iCnt = " & Str$(iCnt)
      pGrid.FlushData()
      strData=pGrid.GetData(3,2)
      Prnt "  Cell 3,2 Contains " & strData
      Prnt "Leaving fnWndProc_OnCommand()"
    Case %IDC_COLOR
      If Hiwrd(Wea.wParam)=%BN_CLICKED Then
         Prnt "Entering fnWndProc_OnCommand()"
         Prnt "  Case %IDC_COLOR
         dwPtr=GetWindowLong(Wea.hWnd,0)
         Prnt "  dwPtr = " & Str$(dwPtr)
         CObj(pGrid,dwPtr)
         Call pGrid.AddRef() To iCnt
         Prnt "  iCnt = " & Str$(iCnt)
         pGrid.FlushData()
         For i=1 To 5
           pGrid.SetCellAttributes(3,i,&H000000FF,&H00FFFFFF)
         Next i
         For i=1 To 5
           pGrid.SetCellAttributes(4,i,&H0000FF00,&H00FFFFFF)
         Next i
         For i=1 To 5
           pGrid.SetCellAttributes(5,i,&H00FF0000,&H00FFFFFF)
         Next i
         For i=1 To 5
           pGrid.SetCellAttributes(6,i,RGB(255,255,0),&H00000001)
         Next i
         pGrid.Refresh()
         Prnt "Leaving fnWndProc_OnCommand()"
      End If
    Case %IDC_GET_SELECTED_ROW
      If GetWindowLong(Wea.hWnd,8) Then
         MsgBox("Selected Row = " & Str$(GetWindowLong(Wea.hWnd,8)))
      Else
         MsgBox("No Row Selected!")
      End If
    Case %IDC_UNLOAD_GRID
      Prnt "Entering fnWndProc_OnCommand()"
      Prnt "  Case %IDC_UNLOAD_GRID"
      Call DestroyGrid(Wea)
      Call EnableWindow(GetDlgItem(Wea.hWnd,%IDC_RETRIEVE),%False)
      Call EnableWindow(GetDlgItem(Wea.hWnd,%IDC_UNLOAD_GRID),%False)
      Call EnableWindow(GetDlgItem(Wea.hWnd,%IDC_COLOR),%False)
      Call EnableWindow(GetDlgItem(Wea.hWnd,%IDC_GET_SELECTED_ROW),%False)
      Call InvalidateRect(Wea.hWnd,Byval %Null, %True)
      Prnt "Leaving fnWndProc_OnCommand()"
  End Select

  fnWndProc_OnCommand=0
End Function


Function fnWndProc_OnDestroy(Wea As WndEventArgs) As Long
  Prnt "Entering fnWndProc_OnDestroy()"
  Call DestroyGrid(Wea)
  Call CoFreeUnusedLibraries()
  Call PostQuitMessage(0)
  Prnt "Leaving fnWndProc_OnDestroy()"
  Function=0
End Function


Function fnWndProc(ByVal hWnd As Long,ByVal wMsg As Long,ByVal wParam As Long,ByVal lParam As Long) As Long
  Local wea As WndEventArgs
  Register iReturn As Long
  Register i As Long

  For i=0 To 2
    If wMsg=MsgHdlr(i).wMessage Then
       wea.hWnd=hWnd: wea.wParam=wParam: wea.lParam=lParam
       Call Dword MsgHdlr(i).dwFnPtr Using FnPtr(wea) To iReturn
       fnWndProc=iReturn
       Exit Function
    End If
  Next i

  fnWndProc=DefWindowProc(hWnd,wMsg,wParam,lParam)
End Function


Sub AttachMessageHandlers()
  ReDim MsgHdlr(2) As MessageHandler  'Associate Windows Message With Message Handlers
  MsgHdlr(0).wMessage=%WM_CREATE   :   MsgHdlr(0).dwFnPtr=CodePtr(fnWndProc_OnCreate)
  MsgHdlr(1).wMessage=%WM_COMMAND  :   MsgHdlr(1).dwFnPtr=CodePtr(fnWndProc_OnCommand)
  MsgHdlr(2).wMessage=%WM_DESTROY  :   MsgHdlr(2).dwFnPtr=CodePtr(fnWndProc_OnDestroy)
End Sub


Function WinMain(ByVal hIns As Long,ByVal hPrev As Long,ByVal lpCL As Asciiz Ptr,ByVal iShow As Long) As Long
  Local szAppName As ZStr*16
  Local wc As WndClassEx
  Local hWnd As Dword
  Local Msg As tagMsg

  Call AttachMessageHandlers()                    : szAppName="PBClient5"
  wc.lpszClassName=VarPtr(szAppName)              : wc.lpfnWndProc=CodePtr(fnWndProc)
  wc.cbClsExtra=0                                 : wc.cbWndExtra=12
  wc.style=%CS_HREDRAW Or %CS_VREDRAW             : wc.hInstance=hIns
  wc.cbSize=SizeOf(wc)                            : wc.hIcon=LoadIcon(%NULL, ByVal %IDI_APPLICATION)
  wc.hCursor=LoadCursor(%NULL, ByVal %IDC_ARROW)  : wc.hbrBackground=%COLOR_BTNFACE+1
  wc.lpszMenuName=%NULL
  Call RegisterClassEx(wc)
  hWnd=CreateWindowEx(0,szAppName,szAppName,%WS_OVERLAPPEDWINDOW,200,100,790,280,0,0,hIns,ByVal 0)
  Call ShowWindow(hWnd,iShow)
  While GetMessage(Msg,%NULL,0,0)
    TranslateMessage Msg
    DispatchMessage Msg
  Wend : MsgBox("Last Chance To Get What You Can!")

  Function=msg.wParam
End Function