Grid Custom Control Project - Converting It To COM

[Frederick J. Harris]

Well Dominic, I thought it over and decided to get off my high horse and just implement it as you suggested.  I'll work on it today.  I still think its a feature of dubious value, i.e., a client creating an object, then setting up multiple sinks and calling Advise on the object multiple times, but maybe it would be useful in some other context than with a grid control.

I don't believe I'll do as sophisticated an arrangement as you have, but I'll come up with something as minimal as possible.  I guess the part I wasn't seeing through clearly was the connection between messages coming through the Window Procedure for the grid, and firing event notifications at the correct sinks.  But if I include a pointer to the whole object in my GridData UDT as you suggested, instead of a seperate pointer to the single outgoing interface as I now have it, then that will without the possibility of error allow me to retrieve from some sort of array of sink pointers the data I'll need to pull it off.

[Dominic Mitchell]

Well Dominic, I thought it over and decided to get off my high horse and just implement it as you suggested.
I'll work on it today.  I still think its a feature of dubious value, i.e., a client creating an object, then
setting up multiple sinks and calling Advise on the object multiple times, but maybe it would be useful in some
other context than with a grid control.

It is not dubious. You do have the option of limiting the number of connections to only one sink, but the client
has to be warned of that fact.  You cannot just return S_OK.                     
If you want to limit the outgoing interface to only one connection, then IConnectionPoint::Advise should return
CONNECT_E_ADVISELIMIT when the connection point already has a pointer to a sink or it has reached the limit of the number of connections it can accept.

[Frederick J. Harris]

Maybe I'm being too hard on the concept.  In any case I have it implemented and will likely post it today as Version #4 followed by Version #3.  Out of order perhaps, but I already had Version #3 done when I addressed your concerns about my Advise().  I will admit I had a lot of fun fixing it.  It really works slick, and where I could see it as being of some use is where two forms are visible on the screen, and when the user interacts with one something needs to be updated on the other.  The way I would have handled that might be more awkward than this way.

The other thing you mentioned in your first post about it being a strange setup of mine how a NewCom() call on the part of PowerBASIC fails to actually create a grid, i.e., after that call a CreateGrid() interface call is necessary, the reason for that is it doesn't seem like in the case of grids in particular any default construction would be in any way usable.  If you think about the way a MSFlexGrid works in the Visual Basic visual designer, you could just drag one to your form and click the 'run' button and you would actually get a functioning but non-usable grid with something like one or two rows and one or two columns.  Either at design time or run time you would then need to set the column headings, numbers of columns, numbers of rows, etc.  I didn't feel like adding to my code bulk to allow for the setup of a non-usable grid, and the creation of a usable grid through later Interface calls.  My hope was rather to simply mimic the usage of a custom control where the user would likely create the grid through a CreateWindowEx() call, likely passing into the grid its setup information through the lpCreateParams pointer of the CreateWindowEx() call.  Since I specified in the Idl file that the interface was Automation compatible, and I hoped it would work with Visual Basic, I had to resort to all those parameters in the CreateGrid() interface method.

Putting piles of additional interface members in my IGrid interface to allow setting up the columns, rows, fonts, etc., would have radically changed my base custom control code, which didn't have those features (it was setup to allow for the grid creation to be completed in one fell swoop, rather than peicemeal).  And one of my goals here was to show how a custom control could be converted to a COM based thing.  So thats the reason for that.  To put it simply, in the case of grids there is no default configuration that is in any way usable.  If you were building a clock, for example, that would likely be usable as is, as I think most folks use a 24 hour clock with 60 minutes in an hour, etc.  So you might have a different situation there.

The other thing is I'm extremely conscious of code size.  I'm wanting as minimal and small a grid as possible that is still usable.  Thanks for your input on this.  I appreciate it.

[Dominic Mitchell]

Have you tried embedding your grid in Microsoft Excel/Word, or a web page, or using it from VBScript?

In my opinion, you control is not playing by the activation rules.

[Frederick J. Harris]

No.  I know you are busy working on Phoenix Dominic, so I'm asumming you probably only skimmed my material.  It is a lot - I know.  Or maybe I'm asumming you've read my Version #4 - which I haven't posted yet.  But I did try to make it fairly clear at the outset that my grid won't allow embedding, at least in the sense I understand that term.  That is, no registry entries are being made for it under CLSID such as 'Control', 'Insertable', or 'MiscStatus' bits.  Also, IDispatch isn't implemented.  Nor are...

IOleObject
IOleInPlaceObject
IOleInPlaceActiveObject
IDataObject
IViewObject2
IPersistStream

So it won't show up under the 'Components' tab of Visual Basic's 'Project' menu, nor will it due to that be able to be represented as an icon in Visual Basic's Toolbox.  Rather, it will show up in the 'References' dialog where non-visual com components are shown.   

So you might question, "What good is it?"  I believe I answered that in my first posts where I discussed the issues of using PowerBASIC custom controls in other languages such as C++.  PowerBASIC doesn't create *.lib files that allow a C or C++ coder to easily use PowerBASIC binaries.  On the other hand, its really pretty easy to use this COM based grid in C or C++ - even .NET.  While it won't support drag and drop in a visual designer, its nonetheless a full fledged COM object, and all its methods and events show up perfectly well in .NET's code editor - intellisense, event procedures, object browser, etc. 

So I guess you could say its kind of a hybrid of sorts.  Its a COM object that has a visual interface but without supporting all the interfaces almost exclusively associated with embeddable visual components that were designed to work with visual designers.  Because it doesn't have to carry all the code along with itself to support its 'design mode' functionality, and because it doesn't require an 'ActiveX Control Container', it is quite lightweight.  The grid custom control I posted at the beginning of this thread has close to all the functionality I need in a grid control, and it compiles to only 28K.  When I converted it over to a COM based control that brought it up to around 42K due to the necessary addition of registry and COM infrastructure code.  However, compare 42K with something such as the MSFlexGrid or even other grid custom controls which are in the megabyte range, and you'll have to admit it shows that COM doesn't automatically equate with bloat.   So yes, I'm after something different here.   

[Frederick J. Harris]

     Ok, I believe I've satisfactorily added the necessary capabilities to my Version #2 code to allow multiple Sink Classes to be connected to a single instance of the grid.  So, Version #4 extends Version #2's ability to create multiple grids by allowing multiple connections per grid.

     I've also reconsidered a good bit of all this.  At the time Dominic Mitchell called into question my Connection Point code, I was of the opinion that multiple sink connections weren't worth the trouble.  However, the code I'm now going to post not only solved the problem of handling multiple connections per grid object, but it also removes the need for me to even provide my already finished Version #3.  My version #3 was created to allow the grid to work with Visual Basic .NET.  So what I'm saying is that the changes I made to version #2 to allow for multiple sinks also as an added side bonus allowed the code to now work with .NET.  I had some fuzzy thinking going on in my head about the whole issue that has now become clearer to me.  Let me try to outline the issues.

     The reason my Version #2 Grid wouldn't work with .NET is because in .NET it appears that the loading of the COM object and the setup of the connection point is done simultaneously.  In other words, to use my grid in .NET one would first start up a .NET Windows Forms application, then go to the...

Project >>> Add References

dialog, where one would click on the COM tab.  At that point .NET Visual Studio would search the Windows Registry for registered COM objects, and populate a control listing them.  One would then locate FHGrid4 Typelib and select it.  At that point Visual Studio would read the type library embedded within FHGrid4.dll, and it would learn about all the interfaces and interface methods within the type library.  These would in our case include the IGrid interface methods of the inbound interface, and the event procedures of the IGridEvents outbound interface.  If one were then to go to a code window behind the default Form1 provided, and code the following line at form module scope, which, I believe, is the only place it is allowed in .NET...

Public WithEvents pGrid As New FHGrid4Library.FHGrid4

...then this object will be created and an attempt made to set up the connection point before we've even had a chance to call the CreateGrid() method of the IGrid interface.  The problem with this in terms of the Version #2 code I provided is that in that code, when IConnectionPoint::Advise() is called to set up the connection point, my code is looking for a window handle so as to store the address of the client's sink in the grid's .cbWndExtra bytes.  Here is the Advise() method from Version #2 without the debug stuff...

Code Select Expand


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

  Decr this : Decr this
  pGrid=this
  Vtbl=@pUnkSink
  Call Dword @Vtbl[0] Using ptrQueryInterface(pUnkSink,$IID_IFHGrid_Events,Varptr(dwPtr)) To hr
  Call SetWindowLong(@pGrid.hWndCtrl,4,dwPtr)                                                       '<<<< This Won't Work In .NET!!!!!!
  If SUCCEEDED(hr) Then
     @pdwCookie=1
  Else
     @pdwCookie=0
  End If

  Function=hr
End Function


It worked fine in C++ or PowerBASIC simply because I was setting up the sink code after I had created a grid, e.g.,...

Code Select Expand


Let pGrid = NewCom "FHGrid3.Grid"                                                                           'This calls IClassFactory_CreateInstance() without setting up events
strSetup="120:Column 1:^,130:Column 2:^,140:Column 3:^,150:Column 4:^,160:Column 5:^"                       'Row/column/positioning,font setup info for grid
pGrid.Create(Wea.hWnd, strSetup, 10, 10, 570, 222, 25, 5, 20, "", 18, %FW_DONTCARE)                         'Method call on COM object to create grid; will result in window handle
pConnectionPointContainer = pGrid                                                                           'This causes a QueryInterface() for IConnectionPointContainer
EventGuid=$IID_IGridEvents                                                                                  'This puts a binary Guid in a Guid variable from text representation
Call pConnectionPointContainer.FindConnectionPoint(Byval Varptr(EventGuid), Byval Varptr(pConnectionPoint)) 'This obtains a pointer to the Grid's IConnectionPoint interface
Let pSink = Class  "CEventClass"                                                                            'This instantiates the sink class "CGridEvents"
Call pConnectionPoint.Advise(Byval Objptr(pSink), dwCookie)                                                 'This passes the address of the sink class to the grid


     So you can see the success of my code was dependant on a particular order of call or sequence of operations being followed which .NET didn't honor.  And fixing this as I had done in my Version #3 code was rather nasty.  What I really should have done was to not store the pointer to the sink in the .cbWndExtra bytes of the grid but rather within the "FHGrid4" COM Class.  In all the examples I had seen in C++ what the authors had done was to wrap an array within a class and store a pointer to the class in the COM Class structure.  But being as these were all non GUI worker objects, I thought I knew better with my GUI grid.  I thought I'd store them in the window.  The sink addresses really need to be stored in the COM Class though.  But before I show that code, and in lieu of providing Version #3 which is now defunct, let me briefly describe what I did to solve the problem in terms of that failed paradigm.

     Since my version #2 code's Advise method required a window handle so the client sink could be stored in the .cbWndExtra bytes of the window, I reasoned I'd give it a window handle but only that and nothing more - no grid.  So instead of having the CreateWindowEx() call that creates the grid in IGrid_Create(), I put it in IClassFactory_CreateInstance().  By doing this it allowed my Advise() code to have a valid window handle to work with in the event the object was being used in .NET where the connection point was being set up before the grid GUI object was created.  But if you recall, all the information to set up the grid, i.e., creation of the pane, the cells, the header control, the rows, the columns, etc., were being processed in the WM_CREATE handler for the grid class, and none of this information whatsoever would be available at the time of the premature CreateWindowEx() call in IClassFactory_CreateInstance()!  Quite a dilemma!

     The solution was to create a real zombie window with no functionality besides the ability to furnish a HWND and later create the grid outside the WM_CREATE handler and re-parent and attach it to the zombie window.  Have you ever seen such a poor CreateWindow() call as this...

Code Select Expand


hGrid=CreateWindow("Grid","",0,0,0,0,0,0,0,hInstance,Byval 0)


Believe it or not, that works.  Later in the code I re-parented the window with SetParent() and assigned the other window class attributes with SetWindowLong() and SetWindowPos(), all of which shows the extent to which a failed design can be salvaged with ingenious hacks!

     But all that is pretty much moot at this point.   Lets jump into the changes I made to Version #2 that allows the grid to now support multiple sinks, and work in Visual Studio .NET.  Here is a description of the changes I made.  I added a buffer to my CGrid class to store %MAX_CONNECTIONS sink addresses...

Code Select Expand


%MAX_CONNECTIONS    = 4   'Maximum number of sinks which can be hooked up to connection point

....
....

Code Select Expand


Type CGrid
  lpIGridVtbl  As IGridVtbl Ptr
  lpICPCVtbl   As IConnectionPointContainerVtbl Ptr
  lpICPVtbl    As IConnectionPointVtbl Ptr
  hWndCtrl     As Dword
  pISink       As Dword Ptr                             <<< This addition stores client sink addresses
  m_cRef       As Long
End Type


Following through on this, it will need to be allocated in IClassFactory_CreateInstance()...

Code Select Expand


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

  @ppv=%NULL
  If pUnknown Then
     hr=%CLASS_E_NOAGGREGATION
  Else
     pGrid=CoTaskMemAlloc(SizeOf(CGrid))                                   'Allocate 24 bytes for CGrid
     If pGrid Then
        @pGrid.pISink=CoTaskMemAlloc(%MAX_CONNECTIONS * %SIZEOF_PTR)       'Allocate %MAX_CONNECTIONS x 4 bytes for sink addresses
        If @pGrid.pISink Then
           Call memset(Byval @pGrid.pISink,0,%MAX_CONNECTIONS*%SIZEOF_PTR) 'Zero out buffer
           @pGrid.lpIGridVtbl = VarPtr(IGrid_Vtbl)                         'Attach IGrid VTable
           @pGrid.lpICPCVtbl  = VarPtr(IConnPointContainer_Vtbl)           'Attach IConnectionPointContainer VTable
           @pGrid.lpICPVtbl   = Varptr(IConnPoint_Vtbl)                    'Attach IConnectionPoint VTable
           @pGrid.m_cRef      = 0                                          'Initialize reference count
           @pGrid.hWndCtrl    = 0                                          'Null Window Handle
           pIGrid=pGrid
           hr= IGrid_QueryInterface(pIGrid,RefIID,ppv)
           If SUCCEEDED(hr) Then
              Call InterlockedIncrement(g_lObjs)
           Else
              Call CoTaskMemFree(pGrid)
           End If
           Call Initialize()
        Else
           Call CoTaskMemFree(Byval pGrid)
           hr=%E_OutOfMemory
        End If
     Else
        hr=%E_OutOfMemory
     End If
  End If

  IClassFactory_CreateInstance=hr
End Function


Of course, a major change will be in IConnectionPoint::Advise(), which now will actually use the dwCookie parameter as an [out], and it will actually be the DWORD offset index in the CGrid::pISink buffer...

Code Select Expand


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

  Decr this : Decr this
  pGrid=this
  Vtbl=@pUnkSink
  Call Dword @Vtbl[0] Using ptrQueryInterface(pUnkSink,$IID_IFHGrid_Events,Varptr(dwPtr)) To hr
  If SUCCEEDED(hr) Then
     For i=0 To %MAX_CONNECTIONS-1
       If @pGrid.@pISink[i]=0 Then 'If there is no sink address stored in a slot, then
          blnFoundOpenSlot=%True   'it can be used.  If the loop continues through to
          Exit For                 'the end and no empty spots are found, then return
       End If                      '%CONNECT_E_ADVISELIMIT.  Note that in the Unadvise()
     Next i                        'Method, if a slot is released, it can be nulled out
     If blnFoundOpenSlot Then      'thus freeing up that slot for other use.  This loop
        @pGrid.@pISink[i]=dwPtr    'will find it.
        @pdwCookie=i
        hr=%S_Ok
     Else
        @pdwCookie=0
        hr=%CONNECT_E_ADVISELIMIT
     End If
  End If

  Function=hr
End Function


And the corresponding IConnectionPoint::Unadvise()...

Code Select Expand


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

  Decr this : Decr this
  pGrid=this
  dwPtr=@pGrid.@pISink[dwCookie]
  Vtbl=@dwPtr
  Call Dword @Vtbl[2] Using ptrRelease(dwPtr) To iReturn
  If SUCCEEDED(iReturn) Then
     @pGrid.@pISink[dwCookie]=0   'Null out for possible re-use.
     Function = %S_Ok
  Else
     Function=%E_FAIL
  End If
End Function


Also, I believe this was Dominic's idea, but I added a class object pointer to my GridData UDT...

Code Select Expand


Type GridData
  iCtrlID                             As Long
  hParent                             As Dword
  hGrid                               As Dword
  hBase                               As Dword
  hPane                               As Dword
  hEdit                               As Dword
  cx                                  As Dword
  cy                                  As Dword
  hHeader                             As Dword
  iCols                               As Dword
  iRows                               As Dword
  iVisibleRows                        As Dword
  iRowHeight                          As Dword
  iPaneHeight                         As Dword
  iEditedCellRow                      As Long
  iEditedRow                          As Long
  iEditedCol                          As Long
  pComObj                             As Dword Ptr   ' <<< Added pComObj, i.e., pointer to COM object
  pColWidths                          As Dword Ptr
  pCellHandles                        As Dword Ptr
  pGridMemory                         As Dword Ptr
  pVButtons                           As Dword Ptr
  blnAddNew                           As Long
  iFontSize                           As Long
  iFontWeight                         As Long
  hFont                               As Dword
  szFontName                          As ZStr * 24
End Type


This effectively relates an entity, i.e., a GUI grid - which knows nothing about COM or what is going on in that sphere, to the memory allocation for the COM object which is driving it.  And the flip side of the coin is that the CGrid UDT has a hWndCtrl member which relates COM stuff to a Window.  Right near the very bottom of IGrid_Create() is where the pComObj member in GridData gets set...

Code Select Expand


Function IGrid_CreateGrid _
  ( _
    ByVal this        As IGrid Ptr, _
    Byval hContainer  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 strFontName As BStr, _
    Byval iFontSize   As Long, _
    Byval iFontWeight As Long _
  ) As Long
  Local pGridData As GridData Ptr
  Local hGrid,dwStyle As Dword
  Local pGrid As CGrid Ptr
  Local gd As GridData

  #If %Def(%DEBUG)
  Prnt "  Entering IGrid_CreateGrid()"
  Prnt "    this           = " & Str$(this)
  Prnt "    hContainer     = " & Str$(hContainer)
  Prnt "    strSetup       = " & strSetup
  Prnt "    x              = " & Str$(x)
  Prnt "    y              = " & Str$(y)
  Prnt "    cx             = " & Str$(cx)
  Prnt "    cy             = " & Str$(cy)
  Prnt "    iRows          = " & Str$(iRows)
  Prnt "    iCols          = " & Str$(iCols)
  Prnt "    iRowHt         = " & Str$(iRowHt)
  Prnt "    strFontName    = " & strFontName
  #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
  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 "    GetLastError() = " & Str$(GetLastError())
  Prnt "    hGrid          = " & Str$(hGrid)
  #EndIf
  Incr g_CtrlId
  pGrid=this
  @pGrid.hWndCtrl=hGrid                                 ' <<< Set hGrid into "FHGrid4.Grid" COM Class
  pGridData=GetWindowLong(hGrid,0)
  #If %Def(%DEBUG)
  Prnt "    pGridData      = " & Str$(pGridData)
  #EndIf
  @pGridData.pComObj=this                               ' <<< Set .pComObj into GridData, which is Windowing stuff !
  Call SetFocus(hGrid)
  #If %Def(%DEBUG)
  Prnt "  Leaving IGrid_CreateGrid()" : Prnt ""
  #EndIf

  Function=%S_OK
End Function


There is a CreateWindowEx() call above which actually ties the whole thing together, i.e., the non-GUI COM infrastructure code, and the GUI Windowing machinery.  The memory allocation for GridData is in the WM_CREATE handler for the CreateWindowEx() call that creates the grid.

Most of the calls the grid COM object makes into the client's event sink(s) originate from an edit control subclass procedure in the grid code, i.e., fnEditSubClass, that looks something like this....

Code Select Expand


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 pGrid As CGrid Ptr
  Register i As Long
  Local hr 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
      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.iEditedCellRow, @pGridData.iEditedRow, @pGridData.iEditedCol) To hr
        End If
      Next i
      If wParam=%VK_RETURN Then
         Call blnFlushEditControl(hGrid)
         Call Refresh(hGrid)
         Exit Function
      Else
         @pGridData.hEdit=hEdit
      End If
    Case %WM_KEYDOWN
      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.iEditedCellRow, @pGridData.iEditedRow, @pGridData.iEditedCol) To hr
        End If
      Next i
    Case %WM_PASTE
      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
    Case %WM_LBUTTONDBLCLK
      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
  End Select

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


I think that's close to about it.  I'll now provide a console output run, the client which produces it (which calls Advise() twice with two Sink classes), and finally FHGrid4.bas, which is the source for the COM Dll.  Note this uses different GUIDs and Program IDs from the others.  Here is a console output run...

Code Select Expand


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                      =  5242056
    Varptr(@pGrid.lpIGridVtbl) =  5242056
    Varptr(@pGrid.lpICPCVtbl)  =  5242060
    Varptr(@pGrid.lpICPVtbl)   =  5242064
    @pGrid.pISink              =  5237072
    @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 =  5242056
    Leaving IGrid_QueryInterface()
    @ppv                       =  5242056  << 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 =  5242056
  Leaving IGrid_QueryInterface()

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

  Entering IGrid_CreateGrid()
    this           =  5242056
    hContainer     =  590550
    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          =  787046
    pGridData      =  4204880
  Leaving IGrid_CreateGrid()

  Entering IGrid_QueryInterface()
    Trying To Get IConnectionPointContainer
    this =  5242056
    Entering IConnectionPointContainer_AddRef()
      @pGrid.m_cRef =  1  << Before
      @pGrid.m_cRef =  2  << After
    Leaving IConnectionPointContainer_AddRef()
    this =  5242060
  Leaving IGrid_QueryInterface()

  Entering IConnectionPointContainer_FindConnectionPoint()
    this  =  5242060
    @ppCP =  0
    Entering IConnectionPointContainer_QueryInterface()
      Looking For IID_IConnectionPoint
      Entering IConnectionPoint_AddRef()
        @pGrid.m_cRef =  2  << Before
        @pGrid.m_cRef =  3  << After
      Leaving IConnectionPoint_AddRef()
    Leaving IConnectionPointContainer_QueryInterface()
    @ppCP =  5242064
  Leaving IConnectionPointContainer_FindConnectionPoint()

  Objptr(pSink1) =  4202716

  Entering IConnectionPoint_Advise()!  Grab Your Hardhat And Hang On Tight!
    this               =  5242064
    pGrid              =  5242056
    @pGrid.hControl    =  787046
    pGridData          =  4204880
    @pGridData.pComObj =  5242056
    pUnkSink           =  4202716
    Vtbl               =  2110891
    @Vtbl[0]           =  2117752
    dwPtr              =  4202716
    Call Dword Succeeded!
    0     5237072     0  Found Open Slot!
    Will Be Able To Store Connection Point!
  Leaving IConnectionPoint_Advise() And Still In One Piece!

  dwCookie1      =  0


  Objptr(pSink2) =  4232812

  Entering IConnectionPoint_Advise()!  Grab Your Hardhat And Hang On Tight!
    this               =  5242064
    pGrid              =  5242056
    @pGrid.hControl    =  787046
    pGridData          =  4204880
    @pGridData.pComObj =  5242056
    pUnkSink           =  4232812
    Vtbl               =  2111059
    @Vtbl[0]           =  2117752
    dwPtr              =  4232812
    Call Dword Succeeded!
    0     5237072     4202716
    1     5237076     0  Found Open Slot!
    Will Be Able To Store Connection Point!
  Leaving IConnectionPoint_Advise() And Still In One Piece!

  dwCookie2      =  1
Leaving fnWndProc_OnCreate()


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


Entering fnWndProc_OnCommand()
  Case %IDC_RETRIEVE
  Cell 3,2 Contains fred
Leaving fnWndProc_OnCommand()


Entering fnWndProc_OnCommand()
  Case %IDC_UNLOAD_GRID
  Entering DestroyGrid()
    Entering IConnectionPoint_Unadvise()
      this            =  5242064
      dwCookie        =  0
      @pGrid.hWndCtrl =  787046
      dwPtr           =  4202716
      IGrid_Events::Release() Succeeded!
      Release() Returned  1
    Leaving IConnectionPoint_Unadvise()

    Entering IConnectionPoint_Unadvise()
      this            =  5242064
      dwCookie        =  1
      @pGrid.hWndCtrl =  787046
      dwPtr           =  4232812
      IGrid_Events::Release() Succeeded!
      Release() Returned  1
    Leaving IConnectionPoint_Unadvise()

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

    Entering IGrid_Release()
      @pGrid.m_cRef =  1  << Before
      0     5237072     0
      1     5237076     0
      2     5237080     0
      3     5237084     0
      @pGrid.m_cRef = 0   << After
      Grid Was Deleted!
    Leaving IGrid_Release()
  Leaving DestroyGrid()
Leaving fnWndProc_OnCommand()

Entering DestroyGrid()
  'Everything Already Released!
Leaving DestroyGrid()

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


And here would be PBClient3_v4.bas which produced that output.  Note two sink classes and two Advise() calls in fnWndProc_OnCreate()...

Code Select Expand


'PBClient3_v4.bas    'no include file with this one; its all here.
#Compile                 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

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 CGridEvents1  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

Class CGridEvents2  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 CGridEvents2!" & 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 CGridEvents2!" & 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 CGridEvents2" & "(" & 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 CGridEvents2!"
    End Method
  End Interface
End Class

Global pSink1                    As IGridEvents
Global pSink2                    As IGridEvents
Global pGrid                     As IGrid
Global pConPtCon                 As IConnectionPointContainer
Global pConPt                    As IConnectionPoint
Global dwCookie1                 As Dword
Global dwCookie2                 As Dword


Function fnWndProc_OnCreate(Wea As WndEventArgs) As Long
  Local pCreateStruct As CREATESTRUCT Ptr
  Local strSetup,strCoordinate As BStr
  Local EventGuid As Guid
  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"
  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)
  pConPtCon = pGrid
  EventGuid=$IID_IGridEvents
  Call pConPtCon.FindConnectionPoint(Byval Varptr(EventGuid), Byval Varptr(pConPt))

  'Connect Sink #1
  Let pSink1 = Class  "CGridEvents1"
  Prnt "  Objptr(pSink1) = " & Str$(Objptr(pSink1))
  Call pConPt.Advise(Byval Objptr(pSink1), dwCookie1)
  Prnt "  dwCookie1      = " & Str$(dwCookie1)

  'Connect Sink #2
  Let pSink2 = Class  "CGridEvents2"
  Prnt "  Objptr(pSink2) = " & Str$(Objptr(pSink2))
  Call pConPt.Advise(Byval Objptr(pSink2), dwCookie2)
  Prnt "  dwCookie2      = " & Str$(dwCookie2)

  'Fill Grid
  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()
  Prnt "  Entering DestroyGrid()"
  If IsTrue(IsObject(pConPt)) Then
     Call pConPt.Unadvise(dwCookie1)
     Call pConPt.Unadvise(dwCookie2)
  End If
  If IsTrue(IsObject(pSink1)) Then
     Set pSink1     = Nothing
  End If
  If IsTrue(IsObject(pSink2)) Then
     Set pSink2     = Nothing
  End If
  If IsTrue(IsObject(pConPtCon)) Then
     Set pConPtCon = Nothing
  End If
  If IsTrue(IsObject(pConPt)) Then
     Set pConPt    = Nothing
  End If
  If IsTrue(IsObject(pGrid)) Then
     Set pGrid     = Nothing
  End If
  Prnt "  Leaving DestroyGrid()"
End Sub


Function fnWndProc_OnCommand(Wea As WndEventArgs) As Long
  Local strData As BStr

  Prnt "Entering fnWndProc_OnCommand()"
  Select Case As Long Lowrd(Wea.wParam)
    Case %IDC_RETRIEVE
      Prnt "  Case %IDC_RETRIEVE"
      pGrid.FlushData()
      strData=pGrid.GetData(3,2)
      Prnt "  Cell 3,2 Contains " & strData
    Case %IDC_UNLOAD_GRID
      Prnt "  Case %IDC_UNLOAD_GRID"
      Call DestroyGrid()
      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
  Call DestroyGrid()
  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=0
  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


[Frederick J. Harris]

And here is FHGrid4.bas.  Like with the others, if you want to compile it you had better deal with the path to the output log file in DllMain().  I'll attach the FHGrid4.tlb file after this post...

Code Select Expand


#Compile                              Dll  "FHGrid4.dll"
#Dim                                  All
%DEBUG                                = 1
%UNICODE                              = 1
#If %Def(%UNICODE)
    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                              "Windows.inc"
#Include                              "Commctrl.inc
#Include                              "OleCtl.inc"
#Include                              "HeaderCtrl.inc"
#Include                              "Memory.inc"
#Resource                             Typelib, 1, "FHGrid4.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.
%MAX_CONNECTIONS                      = 4               'Maximum number of sinks which can be hooked up to connection point

Declare Function ptrQueryInterface _
( _
  Byval this                          As Dword Ptr, _
  Byref iid                           As Guid, _
  Byval pUnknown                      As Dword _
) As Long

Declare Function ptrRelease _
( _
  Byval this                          As Dword Ptr _
) As Long

Declare Function ptrKeyPress _
( _
  Byval this                          As Dword Ptr, _
  Byval iKeyCode                      As Long, _
  Byval iKeyData                      As Long, _
  Byval iCellRow                      As Long, _
  Byval iGridRow                      As Long, _
  Byval iCol                          As Long _
) As Long

Declare Function ptrKeyDown _
( _
  Byval this                          As Dword Ptr, _
  Byval iKeyCode                      As Long, _
  Byval iKeyData                      As Long, _
  Byval iCellRow                      As Long, _
  Byval iGridRow                      As Long, _
  Byval iCol                          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 ptrVButtonClick _
( _
  Byval this                          As Dword Ptr, _
  Byval iCellRow                      As Long, _
  Byval iGridRow                      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-000000000070}")
$IID_IFHGrid                          = Guid$("{20000000-0000-0000-0000-000000000071}")
$IID_IFHGrid_Events                   = Guid$("{20000000-0000-0000-0000-000000000072}")
$IID_LIBID_FHGrid                     = Guid$("{20000000-0000-0000-0000-000000000073}")

Type IGridVtbl
  QueryInterface                      As Dword Ptr
  AddRef                              As Dword Ptr
  Release                             As Dword Ptr
  CreateGrid                          As Dword Ptr
  SetRowCount                         As Dword Ptr
  SetData                             As Dword Ptr
  GetData                             As Dword Ptr
  FlushData                           As Dword Ptr
  Refresh                             As Dword Ptr
  GetCtrlId                           As Dword Ptr
  GethGrid                            As Dword Ptr
End Type

Type IGrid
  lpVtbl                              As IGridVtbl Ptr
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
  iCtrlID                             As Long
  hParent                             As Dword
  hGrid                               As Dword
  hBase                               As Dword
  hPane                               As Dword
  hEdit                               As Dword
  cx                                  As Dword
  cy                                  As Dword
  hHeader                             As Dword
  iCols                               As Dword
  iRows                               As Dword
  iVisibleRows                        As Dword
  iRowHeight                          As Dword
  iPaneHeight                         As Dword
  iEditedCellRow                      As Long
  iEditedRow                          As Long
  iEditedCol                          As Long
  pComObj                             As Dword Ptr
  pColWidths                          As Dword Ptr
  pCellHandles                        As Dword Ptr
  pGridMemory                         As Dword Ptr
  pVButtons                           As Dword Ptr
  blnAddNew                           As Long
  iFontSize                           As Long
  iFontWeight                         As Long
  hFont                               As Dword
  szFontName                          As ZStr * 24
End Type


Type CGrid
  lpIGridVtbl                         As IGridVtbl Ptr
  lpICPCVtbl                          As IConnectionPointContainerVtbl Ptr
  lpICPVtbl                           As IConnectionPointVtbl Ptr
  hWndCtrl                            As Dword
  pISink                              As Dword Ptr
  m_cRef                              As Long
End Type


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_OnVButtonClick                 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)*iRange + (c-1)            'Used to index from two dimensional row/col coordinates to zero based linear address space.
Global CDClassFactory                 As IClassFactory1                 'COM class involved in creation of object.  In OOP terminology its a COM Constructor
Global IClassFactory_Vtbl             As IClassFactoryVtbl              'Contains pointers to the five IClassFactory Interface Members
Global IGrid_Vtbl                     As IGridVtbl                      'This obj will hold pointers to all the functions that make up the IGrid interface
Global IConnPointContainer_Vtbl       As IConnectionPointContainerVtbl  'This obj will hold pointers to all the IConnectionPointContainer interface functions (5).
Global IConnPoint_Vtbl                As IConnectionPointVtbl           'This obj will hold pointers to all the IConnectionPoint interface functions (8) (some not implemented).
Global g_hModule                      As Dword                          'Global instance handle initialized in DllMain().
Global g_lLocks                       As Long                           'You can use this to lock this server in memory even if there are no outstanding objects alive.
Global g_lObjs                        As Long                           'This will be a count of how many Grid objects have been created by calls to IClassFactory::CreateInstance().
Global g_CtrlId                       As Long                           'I'm using this to bump a control id count up by one for each Grid created.
Global fnEditWndProc                  As Dword                          'This is for subclassing the edit control and is the address of the original edit control WndProc().

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


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


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 IComCtrl_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.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(Byval @pGrid.pISink)
     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 _
  ( _
    ByVal this        As IGrid Ptr, _
    Byval hContainer  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 strFontName As BStr, _
    Byval iFontSize   As Long, _
    Byval iFontWeight As Long _
  ) As Long
  Local pGridData As GridData Ptr
  Local hGrid,dwStyle As Dword
  Local pGrid As CGrid Ptr
  Local gd As GridData

  #If %Def(%DEBUG)
  Prnt "  Entering IGrid_CreateGrid()"
  Prnt "    this           = " & Str$(this)
  Prnt "    hContainer     = " & Str$(hContainer)
  Prnt "    strSetup       = " & strSetup
  Prnt "    x              = " & Str$(x)
  Prnt "    y              = " & Str$(y)
  Prnt "    cx             = " & Str$(cx)
  Prnt "    cy             = " & Str$(cy)
  Prnt "    iRows          = " & Str$(iRows)
  Prnt "    iCols          = " & Str$(iCols)
  Prnt "    iRowHt         = " & Str$(iRowHt)
  Prnt "    strFontName    = " & strFontName
  #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
  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 "    GetLastError() = " & Str$(GetLastError())
  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
  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 pGrid As CGrid Ptr

  pGrid=this
  If SetRowCount(@pGrid.hWndCtrl, iRowCount, blnForce) Then
     Function=%S_OK
  Else
     Function=%E_FAIL
  End If
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 pGrid As CGrid Ptr

  pGrid=this
  If SetGrid(@pGrid.hWndCtrl,iRow,iCol,strData) Then
     Function=%S_OK
  Else
     Function=%E_FAIL
  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 pGrid As CGrid Ptr

  pGrid=this
  strData=GetGrid(@pGrid.hWndCtrl,iRow,iCol)
  If strData<>"" Then
     Function=%S_OK
  Else
     Function=%E_FAIL
  End If
End Function


Function IGrid_FlushData(Byval this As IGrid Ptr) As Long
  Local pGrid As CGrid Ptr

  pGrid=this
  If blnFlushEditControl(@pGrid.hWndCtrl) Then
     Function=%S_OK
  Else
     Function=%E_FAIL
  End If
End Function


Function IGrid_Refresh(Byval this As IGrid Ptr) As Long
  Local pGrid As CGrid Ptr
  pGrid=this
  Call Refresh(@pGrid.hWndCtrl)
  Function=%S_OK
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 SetRowCount(Byval hGrid As Long, Byval iRowCount As Long, Byval blnForce As Long) Export As Long
  Local pGridData As GridData Ptr
  Local iSize,blnFree As Long
  Local si As SCROLLINFO
  Register i As Long

  #If %Def(%DEBUG)
  Print #fp, "  Entering SetRowCount()"
  Print #fp,
  Print #fp, "    i         blnFree"
  Print #fp, "    ================="
  #EndIf
  pGridData=GetWindowLong(hGrid,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

  'Create New Memory Block
  iSize=iRowCount * @pGridData.iCols
  @pGridData.pGridMemory=GlobalAlloc(%GPTR,iSize*%SIZEOF_PTR)
  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(hGrid,%SB_VERT,si,%TRUE)
     Function=%TRUE : Exit Function
  End If

  #If %Def(%DEBUG)
  Print #fp, "  Leaving SetRowCount()"
  Print #fp,
  #EndIf

  Function=%FALSE
End Function


Sub Refresh(Byval hGrid As Dword) Export
  Local iRows,iCols,iCountCells,iIdx As Long
  Local pGridData As GridData Ptr
  Local pText As ZStr Ptr
  Local si As SCROLLINFO
  Register i As Long

  #If %Def(%DEBUG)
  Print #fp, "  Entering Refresh()"
  #EndIf
  pGridData=GetWindowLong(hGrid,0)
  iRows=@pGridData.iVisibleRows
  iCols=@pGridData.iCols
  iCountCells=iRows*iCols
  si.cbSize = sizeof(SCROLLINFO)
  si.fMask=%SIF_POS
  Call GetScrollInfo(hGrid,%SB_VERT,si)
  #If %Def(%DEBUG)
  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"
  Print #fp, "    ============================================"
  #EndIf
  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 InvalidateRect(@pGridData.@pCellHandles[i], Byval %NULL, %TRUE)
    pText=@pGridData.@pGridMemory[i]
    #If %Def(%DEBUG)
    Print #fp, "    " i, @pGridData.@pCellHandles[i], @pGridData.@pGridMemory[i], @pText
    #EndIf
  Next i
  #If %Def(%DEBUG)
  Print #fp, "  Leaving Refresh()"
  Print #fp,
  #EndIf
End Sub


Function SetGrid(Byval hGrid As Long, Byval iRow As Long, Byval iCol As Long, Byval strData As BStr) Export As Long
  Local iIndex,iRange,blnFree As Long
  Local pGridData As GridData Ptr
  Local pAsciz As ZStr Ptr
  Local hCell As Dword

  pGridData=GetWindowLong(hGrid,0)
  If iRow <= @pGridData.iRows And iCol <=@pGridData.iCols Then
     If iRow>0 And iCol>0 Then
        iRange=@pGridData.iCols
        iIndex=dwIdx(iRow,iCol)
        pAsciz=@pGridData.@pGridMemory[iIndex]
        If @pAsciz<>strData Then
           blnFree=GlobalFree(pAsciz)
           pAsciz=GlobalAlloc(%GPTR, (Len(strData)+1)*%SIZEOF_CHAR )
           @pAsciz=strData
           @pGridData.@pGridMemory[iIndex]=pAsciz
        End If
        SetGrid=%TRUE
        Exit Function
     End If
  End If

  Function=%FALSE
End Function


Function GetGrid(Byval hGrid As Long, Byval iRow As Long, Byval iCol As Long) Export As BStr
  Local pGridData As GridData Ptr
  Local iIndex,iRange As Long
  Local pZStr As ZStr Ptr

  pGridData=GetWindowLong(hGrid,0)
  If iRow <= @pGridData.iRows And iRow > 0 Then
     If iCol<=@pGridData.iCols And iCol>0  Then
        iRange=@pGridData.iCols
        iIndex=dwIdx(iRow,iCol)
        pZStr=@pGridData.@pGridMemory[iIndex]
        GetGrid=@pZStr
        Exit Function
     End If
  End If

  Function=""
End Function


Function blnFlushEditControl(Byval hGrid As Dword) Export As Long
  Local pGridData As GridData Ptr
  Local pZStr As ZStr Ptr
  Local strData As BStr
  Local iLen As Long

  #If %Def(%DEBUG)
  Print #fp,
  Print #fp, "  Entering blnFlushEditControl()"
  #EndIf
  pGridData=GetWindowLong(hGrid,0)
  If @pGridData.hEdit Then
     iLen=GetWindowTextLength(@pGridData.hEdit)
     pZStr=GlobalAlloc(%GPTR,(iLen+1)*%SIZEOF_CHAR)
     If pZStr Then
        Call GetWindowText(@pGridData.hEdit,Byval pZStr,iLen+1)
        strData=@pZStr
        Call SetGrid(hGrid,@pGridData.iEditedRow,@pGridData.iEditedCol,strData)
        Call SetWindowLong(@pGridData.hEdit,%GWL_WNDPROC,fnEditWndProc)
        Call DestroyWindow(@pGridData.hEdit)
        @pGridData.hEdit=0
        Call Refresh(hGrid)
     Else
        #If %Def(%DEBUG)
        Print #fp, "    Function=%FALSE"
        Print #fp, "  Leaving blnFlushEditControl()"
        Print #fp,
        #EndIf
        Function=%FALSE : Exit Function
     End If
  End If
  #If %Def(%DEBUG)
  Print #fp, "    Function=%TRUE"
  Print #fp, "  Leaving blnFlushEditControl()"
  Print #fp,
  #EndIf

  Function=%TRUE
End Function


[Frederick J. Harris]

Code Select Expand


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 pGrid As CGrid Ptr
  Local iReturn,hr As Long
  Register i As Long

  #If %Def(%DEBUG)
  Print #fp, "  Entering fnEditSubClass"
  #EndIf
  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, "    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.iEditedCellRow, @pGridData.iEditedRow, @pGridData.iEditedCol) To hr
        End If
      Next i
      #If %Def(%DEBUG)
      If SUCCEEDED(hr) Then
         Print #fp, "    Call Dword @Vtbl[3] Using ptrKeyPress() Succeeded!"
      End If
      #EndIf
      If FAILED(hr) Then
         Function=0 : Exit Function
      End If
      If wParam=%VK_RETURN Then
         #If %Def(%DEBUG)
         Print #fp, "    Got WM_CHAR Message %VK_RETURN In fnEditSubClass!"
         #EndIf
         Call blnFlushEditControl(hGrid)
         Call Refresh(hGrid)
         #If %Def(%DEBUG)
         Print #fp, "  Leaving fnEditSubClass"
         Print #fp,
         #EndIf
         Exit Function
      Else
         @pGridData.hEdit=hEdit
      End If
    Case %WM_KEYDOWN
      #If %Def(%DEBUG)
      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.iEditedCellRow, @pGridData.iEditedRow, @pGridData.iEditedCol) To hr
        End If
      Next i
      #If %Def(%DEBUG)
      If SUCCEEDED(hr) Then
         Print #fp, "    Call Dword @Vtbl[4] Using ptrKeyDown() Succeeded!"
      End If
      #EndIf
      If FAILED(hr) Then
         Function=0 : Exit Function
      End If
      #If %Def(%DEBUG)
      Print #fp, "    iReturn = " iReturn
      #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
      If FAILED(hr) Then
         Function=0 : Exit Function
      End If
    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
  #If %Def(%DEBUG)
  Print #fp, "  Leaving fnEditSubClass"
  Print #fp,
  #EndIf

  Function=CallWindowProc(fnEditWndProc,hEdit,wMsg,wParam,lParam)
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 iRange,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 blnFlushEditControl(hGrid)
      si.cbSize = sizeof(SCROLLINFO)
      si.fMask=%SIF_POS
      Call GetScrollInfo(hGrid,%SB_VERT,si)
      iRange=@pGridData.iCols
      For i=1 To @pGridData.iVisibleRows
        For j=1 To @pGridData.iCols
          iCellBufferPos = dwIdx(i,j)
          If @pGridData.@pCellHandles[iCellBufferPos]=hCell Then
             iGridMemOffset=iRange*(si.nPos-1)+iCellBufferPos
             pZStr=@pGridData.@pGridMemory[iGridMemOffset]
             iRow=i : iCol=j
             Exit, Exit
          End If
        Next j
      Next i
      @pGridData.hEdit=CreateWindow _
      ( _
        "edit", _
        "", _
        %WS_CHILD Or %WS_VISIBLE Or %ES_AUTOHSCROLL, _
        1, _
        0, _
        @pGridData.@pColWidths[iCol-1]-2, _
        @pGridData.iRowHeight, _
        hCell, _
        %IDC_EDIT, _
        GetModuleHandle(Byval 0), _
        ByVal 0 _
      )
      If @pGridData.hFont Then
         Call SendMessage(@pGridData.hEdit,%WM_SETFONT,@pGridData.hFont,%TRUE)
      End If
      Call SetWindowText(@pGridData.hEdit,@pZStr)
      fnEditWndProc=SetWindowLong(@pGridData.hEdit,%GWL_WNDPROC,CodePtr(fnEditSubClass))
      @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
      Call SetFocus(@pGridData.hEdit)
      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
           Print #fp, "  Leaving fnCellProc - Case WM_LBUTTONDOWN" : Print #fp,
           #EndIf
        End If
      Next i
      #If %Def(%DEBUG)
      Print #fp, "    hGrid = " hGrid
      Print #fp, "    dwPtr = " dwPtr
      Print #fp, "    Vtbl  = " Vtbl
      Print #fp, "  Leaving fnCellProc - Case WM_LBUTTONDOWN" : Print #fp,
      #EndIf
      Function=0 : Exit Function
    Case %WM_PAINT
      Local hDC,hFont,hTmp As Dword
      Local pBuffer As ZStr Ptr
      Local ps As PAINTSTRUCT
      hDC=BeginPaint(hCell,ps)
      pBuffer=GetWindowLong(hCell,0)
      hFont=GetWindowLong(hCell,4)
      If hFont Then
         hTmp=SelectObject(hDC,hFont)
      End If
      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.hEdit Then
             Call blnFlushEditControl(@pGridData.hGrid)
             Call Refresh(@pGridData.hGrid)
          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
  Local iFlds,iHdlCount,iCols,iCtr,iSize As Long
  Local strParseData(),strFieldData() As BStr
  Local pGridData1,pGridData2 As GridData Ptr
  Local dwStyle,hButton,hCell,hDC As Dword
  Local pCreateStruct As CREATESTRUCT Ptr
  Local uCC As INIT_COMMON_CONTROLSEX
  Local szText As ZStr*64
  Local hdrItem As HDITEM
  Local strSetup As BStr
  Local iPos() As Long
  Register i As Long
  Register j As Long
  Local rc As RECT

  #If %Def(%DEBUG)
  Print #fp, "  Entering %WM_CREATE Case"
  #EndIf
  pCreateStruct=Wea.lParam
  Wea.hInst=@pCreateStruct.hInstance
  pGridData1=@pCreateStruct.lpCreateParams
  strSetup=@pCreateStruct.@lpszName
  Call GetClientRect(Wea.hWnd,rc)
  #If %Def(%DEBUG)
  Print #fp, "    %WM_USER                 = " %WM_USER
  Print #fp, "    %WM_APP                  = " %WM_APP
  Print #fp, "    hGrid                    = " Wea.hWnd
  Print #fp, "    pGridData1               = " pGridData1
  Print #fp, "    Wea.hInstance            = " Wea.hInst
  Print #fp, "    @pCreateStruct.cx        = " @pCreateStruct.cx
  Print #fp, "    @pCreateStruct.cy        = " @pCreateStruct.cy
  Print #fp, "    rc.Right                 = " rc.Right
  Print #fp, "    rc.Bottom                = " rc.Bottom
  Print #fp, "    @pGridData1.iFontSize    = " @pGridData1.iFontSize
  Print #fp, "    @pGridData1.iFontWeight  = " @pGridData1.iFontWeight
  Print #fp, "    @pGridData1.szFontName   = " @pGridData1.szFontName
  Print #fp, "    strSetup                 = " strSetup
  #EndIf
  uCC.dwSize = SizeOf(uCC)
  uCC.dwICC  = %ICC_LISTVIEW_CLASSES
  Call InitCommonControlsEx(uCC)
  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
     Function=-1 : Exit Function
  End If
  pGridData2=GlobalAlloc(%GPTR,sizeof(GridData))
  If pGridData2=0 Then
     Function=-1 : Exit Function
  End If
  Call SetWindowLong(Wea.hWnd,0,pGridData2)
  @pGridData2.iCtrlID=@pCreateStruct.hMenu
  @pGridData2.cx=@pCreateStruct.cx
  @pGridData2.cy=@pCreateStruct.cy
  @pGridData2.iCols=iCols
  @pGridData2.iRows=@pGridData1.iRows
  @pGridData2.iRowHeight=@pGridData1.iRowHeight
  @pGridData2.iVisibleRows=Fix((rc.Bottom-@pGridData1.iRowHeight)/@pGridData1.iRowHeight)
  @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(),","
  @pGridData2.pColWidths=GlobalAlloc(%GPTR,(iCols+1)*%SIZEOF_PTR)
  If @pGridData2.pColWidths=0 Then
     Call GlobalFree(pGridData2)
     Function=-1 : Exit Function
  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)
  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)
  #If %Def(%DEBUG)
  Print #fp, "    @pGridData2.hBase   = " @pGridData2.hBase
  Print #fp, "    @pGridData2.hPane   = " @pGridData2.hPane
  Print #fp, "    @pGridData2.hHeader = " @pGridData2.hHeader
  Print #fp,
  Print #fp, "    i     @pColWidths[i]     iPos(i)      szText"
  Print #fp, "    =================================================="
  #EndIf
  hdrItem.mask=%HDI_FORMAT Or %HDI_WIDTH Or %HDI_TEXT
  Redim iPos(iCols) As Long
  For i=0 To iCols-1
    iFlds=ParseCount(strParseData(i),":")
    Redim strFieldData(iFlds-1)
    Parse strParseData(i), strFieldData(), ":"
    @pGridData2.@pColWidths[i]=Val(strFieldData(0))
    @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)
    hdrItem.fmt=%HDF_STRING Or %HDF_CENTER
    '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
    #If %Def(%DEBUG)
    Print #fp, "   " i, @pGridData2.@pColWidths[i], iPos(i), szText
    #EndIf
    Erase strFieldData()
  Next i
  #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
  @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
     Call GlobalFree(@pGridData2.pColWidths)
     Call GlobalFree(pGridData2)
     Function=-1 : Exit Function
  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 Cells
  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
  Else
     Erase strParseData()
     Erase iPos()
     Call GlobalFree(@pGridData2.pColWidths)
     Call GlobalFree(pGridData2)
     Function=-1 : Exit Function
  End If
  Erase strParseData()
  Erase iPos()
  #If %Def(%DEBUG)
  Print #fp,
  Print #fp, "  Leaving %WM_CREATE Case" : Print #fp,
  #EndIf

  Function=0
End Function


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
  Print #fp,
  #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,
  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 blnFlushEditControl(@pGridData.hGrid)
  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,iRange As Long
     iNum=@pGridData.iCols*(si.nPos-1)
     iRange=@pGridData.iCols
     iLast=(iRange * @pGridData.iVisibleRows) - 1
     For i=0 To iLast
       hCell=@pGridData.@pCellHandles[i]
       Call SetWindowLong(hCell,0,@pGridData.@pGridMemory[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 blnFlushEditControl(@pGridData.hGrid)
     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
     dwPtr=@pGrid.@pISink[0]
     Vtbl=@dwPtr
     Call Dword @Vtbl[8] Using ptrVButtonClick(dwPtr, iCellRow, iGridRow) To hr
     #If %Def(%DEBUG)
     If SUCCEEDED(hr) Then
        Print #fp, "    Call Dword @Vtbl[8] Using ptrVButtonClick() Succeeded!"
     End If
     #EndIf
  End If
  #If %Def(%DEBUG)
  Print #fp, "  Leaving fnGridProc_OnCommand()"
  Prnt "Leaving fnGridProc_OnCommand()"
  Prnt ""
  Print #fp,
  #EndIf

  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
     #EndIf
     blnFree=GlobalFree(@pGridData.pColWidths)
     #If %Def(%DEBUG)
     Print #fp, "    blnFree(pColWidths)    = " blnFree
     #EndIf
     If @pGridData.hFont Then
        blnFree=DeleteObject(@pGridData.hFont)
        #If %Def(%DEBUG)
        Print #fp, "    blnFree(hFont)         = " blnFree
        #EndIf
     End If

     'Grid Row Memory
     #If %Def(%DEBUG)
         Print #fp,
         Print #fp, "     i         j            iCtr          strCoordinate                 pMem"
         Print #fp, "    ============================================================================"
     #EndIf
     iCtr=0
     For i=1 To @pGridData.iRows
       For j=1 To @pGridData.iCols
         pMem=@pGridData.@pGridMemory[iCtr]
         #If %Def(%DEBUG)
             Print #fp, "    " i,j,iCtr,@pMem Tab(72) pMem
         #EndIf
         Incr iCtr
        Next j
     Next i
     #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.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 5
    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(5) 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(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 szClassName As ZStr*16
  Local wc As WNDCLASSEX

  #If %Def(%DEBUG)
      Prnt "    Entering Initialize() -- Initialize()"
  #EndIf
  szClassName="Cell"
  wc.lpszClassName=VarPtr(szClassName)             : wc.lpfnWndProc=CodePtr(fnCellProc)
  wc.cbSize=SizeOf(wc)                             : wc.style=0
  wc.cbClsExtra=0                                  : wc.cbWndExtra=8
  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(Byval @pGrid.pISink)
     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


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
  Local hr 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
     hr=IConnectionPointContainer_QueryInterface(this, $IID_IConnectionPoint, ppCP)
     #If %Def(%DEBUG)
     Prnt "    @ppCP = " & Str$(@ppCP)
     Prnt "  Leaving IConnectionPointContainer_FindConnectionPoint()" : Prnt ""
     #EndIf
     Function=hr : Exit Function
  End If

  Function=%E_NOINTERFACE
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)
      Function=%S_OK : Exit Function
    Case $IID_IFHGrid
      Decr this : Decr this
      @ppv=this
      Call IGrid_AddRef(this)
      Function=%S_OK : Exit Function
    Case $IID_IConnectionPointContainer
      Decr this
      @ppv=this
      Call IConnectionPointContainer_AddRef(this)
      Function=%S_OK : Exit Function
    Case $IID_IConnectionPoint
      @ppv=this
      Call IConnectionPoint_AddRef(this)
      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


[Frederick J. Harris]

Code Select Expand


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(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


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
  Prnt "    Release() Returned " & Str$(iReturn)
  Prnt "  Leaving IConnectionPoint_Unadvise()" : Prnt ""
 
  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
           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(pGrid)
           End If
           Call Initialize()
        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
        #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
  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
  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,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

  szClsid=GuidTxt$(ClassId)
  If szClsid<>"" Then
     szKey="CLSID\"+szClsid
     lResult=RecursiveDeleteKey(%HKEY_CLASSES_ROOT,szKey)
     If lResult<>%ERROR_SUCCESS Then
        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
  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 hr,iBytesReturned As Long
  Local pTypeLib As ITypeLib
  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)
         hr=LoadTypeLibEx(szPath, %REGKIND_REGISTER, pTypeLib)
     #Else
         strAsciPath=szPath
         strWideCharPath=UCode$(strAsciPath & $Nul)
         hr=LoadTypeLibEx(Byval Strptr(strWideCharPath), %REGKIND_REGISTER, pTypeLib)
     #EndIf
     If SUCCEEDED(hr) Then
        #If %Def(%DEBUG)
        Print #fp, "    LoadTypeLib() Succeeded!"
        #EndIf
        Set pTypeLib    = Nothing
        szFriendlyName  =  "Fred Harris Grid Control v4"
        szVerIndProgID  =  "FHGrid4.Grid"
        szProgID        =  "FHGrid4.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
        Local dwFlags As Dword
        Local szError As ZStr*256
        Local strError As BStr
        iBytesReturned=FormatMessage(dwFlags,Byval 0,hr,MAKELANGID(%LANG_NEUTRAL,%SUBLANG_DEFAULT),Byval Varptr(szError),256,Byval %NULL)
        If iBytesReturned=0 Then
           iBytesReturned=MsgBox("...And That Is To Use PBTyp.exe To Embed The Type Library In The Exe!", %MB_ICONWARNING, "I Know What You Forgot...")
        End If
        strError=szError
     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

  hr=UnRegisterTypeLib($IID_LIBID_FHGrid, 1, 0, %LANG_NEUTRAL, %SYS_WIN32)
  If SUCCEEDED(hr) Then
     szVerIndProgID  =  "FHGrid4.Grid"
     szProgID        =  "FHGrid4.Grid.1"
     hr=UnregisterServer($CLSID_FHGrid, szVerIndProgID, szProgID)
  Else
     MsgBox("UnRegisterTypeLib() Failed!")
  End If

  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\v4\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)

      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


[Frederick J. Harris]

There were three posts above with the Dll code that will need to be combined.  Attached here is the FHGrid4.tlb file.

I'll provide additional clients and discuss other interesting (at least to me) ideas in a bit.

[Frederick J. Harris]

     Below are directions for trying the COM Grid Control out in Visual Basic .NET.  I imagine C# would be somewhat similar.  I have Visual Studio Professional 2008, just so you know.  I guess yours could be different if you have another version.

1) Open Visual Studio and choose a new Visual Basic Windows Forms project;

2) Create the project wherever you want and you should end up with a default startup Form1;

3) I named the project prjFHGrid4 and the form frmFHGrid4.   That will affect the names of the various procedures shown in the code below.  I used the toolbox to create two buttons near the bottom of the form.  The one on the lower left I named btnRetrieve and the one lower right I named btnDestroyGrid.  The caption on the left one was "Retrieve (3, 2)" and the caption on the right one was "Destroy Grid";

4) Go to the 'Project' main menu item and choose 'Add Reference...'.  A dialog will come up with various tabs.  Select the 'COM' tab.  It will take Visual Studio a bit of time to search through your registry looking for COM objects.  You should be able eventually to find 'FHGrid4 Typelib'.  Select it and click the OK button;

5) Here is the code in my code window behind frmFHGrid4...

Code Select Expand


Public Class frmFHGrid4
  Public WithEvents pGrid As New FHGrid4Library.FHGrid4

  Sub New()
    Dim strSetup As String = "120:Column 1:^,130:Column 2:^,140:Column 3:^,150:Column 4:^,160:Column 5:^"
    Dim strFontName As String = "Times New Roman"
    Dim i As New Int32, j As New Int32
    InitializeComponent()
    pGrid.CreateGrid(MyBase.Handle, strSetup, 10, 10, 570, 218, 12, 5, 28, strFontName, 18, 0)
    For i = 1 To 10
      For j = 1 To 5
        Dim strCoordinate As String = "(" & i.ToString() & "," & j.ToString() & ")"
        pGrid.SetData(i, j, strCoordinate)
      Next
    Next
    pGrid.Refresh()
  End Sub

  Private Sub btnRetrieve_Click( ByVal sender As System.Object,  ByVal e As System.EventArgs) Handles btnRetrieve.Click
    Dim strData As String = ""
    pGrid.FlushData()
    strData = pGrid.GetData(3, 2)
    MsgBox("Row 3, Col 2 Contains " & strData)
  End Sub

  Private Sub pGrid_Grid_OnVButtonClick(ByVal iCellRow As Integer, ByVal iGridRow As Integer) Handles pGrid.Grid_OnVButtonClick
    MsgBox("You Clicked A Verticle Button.  iCellRow=" & iCellRow.ToString() & "  iGridRow=" & iGridRow.ToString() & ".")
  End Sub

  Private Sub btnDestroyGrid_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles btnDestroyGrid.Click
    pGrid = Nothing
  End Sub

  Private Sub frmFHGrid4_FormClosing( ByVal sender As System.Object,  ByVal e As System.Windows.Forms.FormClosingEventArgs) Handles MyBase.FormClosing
    pGrid = Nothing
  End Sub
End Class


I've made a number of these and at times I've had to do various things to get them to run.  Sometimes you need to go to...

Project >>> Properties >>>Application

and set the 'Start Up' object to your main form which in my case is frmFHGrid4.  Also, on that screen I set the 'Application Type' to 'Console Application', even though it isn't a console application, but rather a 'Windows Forms Application'.  The reason I do that is so I get a console window to display all my debug data.

Also, on the 'Compile' tab in the above described 'Properties' window at times I've had to turn 'Option Strict' Off.  Then for 'Warning Configuration' I've turned these warnings off...

Implicit Conversion
Late binding;  Call could fail at runtime
Implicit Type;  Object Assumed

[Frederick J. Harris]

Everybody's Favorite Topic - Global Variables!

     In every client program I've shown so far in this rather lengthy post of mine about grid custom controls and converting them to COM based controls, there has been one rather nasty thing in common - lots of global variables.  Just in the last one, i.e., PBClient3_v4.bas we had these...

Code Select Expand


Global pSink1                    As IGridEvents
Global pSink2                    As IGridEvents
Global pGrid                     As IGrid
Global pConPtCon                 As IConnectionPointContainer
Global pConPt                    As IConnectionPoint
Global dwCookie1                 As Dword
Global dwCookie2                 As Dword


     There are all kinds of opinions on this topic.  Some of the real heavyweight software minds such as Bob Zale himself and Jose Roca have stated at various times in the Forums that globals have their place, just as any other programming construct.  Some see no harm in using them anywhere, and others state they will use them nowhere.  My position is pretty close to the latter, at least in terms of Windows Graphical User Interface Application Programs, and I'd like to take this opportunity to show you how you can rid your GUI programs of them - specifically COM object pointers returned by such PowerBASIC functions as NewCom(), AnyCom(), etc.

     There are two related reasons you might want to do this.  First, only beginners at BASIC or any other language are unknowledgeable enough to know of no other way to structure a program's data than through the use of globals for everything.  Second, one of the principals of both procedural and object oriented programming is that data should be tightly associated with the algorithms that manipulate it.  In other words, data shouldn't just be hanging out all over the place in a program where it is accessible to procedures which have no business messing with it.  In OOP speak, data should be associated with the objects which manipulate that data.  In Windows programs, the most noteworthy objects are windows.  Therefore, what needs to happen is that data needs to be associated with windows. 

     In terms of the Windows operating system itself, all of the foundational ideas of Object Oriented Programming were in place at the time Windows was developed.  C++ was not in widespread use in the early to mid 1980s but C was and that language was used to write Windows.  So the type of object oriented programming used to create an object oriented system was C based - not C++ based.  Therefore, the C struct rather than the C++ class was used to organize objects, and object 'accessors' and 'mutators' took on a C functional look as opposed to C++ isms.  Therefore, Microsoft provided various methods a programmer could use to 'attach' data to Windows objects.  You have the Get/SetProp() functions, and also the ability to store user data within an instantiated class structure itself. 

     This later technique is the one I prefer to use.  Its basis is as follows (experienced coders can just skim this).  When a Window Class is registered with Windows, one of the fields of the WNDCLASSEX User Defined Type (struct in C terminology) is the .cbWndExtra bytes field.  You can set this number to whatever you want as far as I know, but I personally have never used more than 50 to 60 bytes, and generally a lot less.  The reason you don't need much is because typically one stores pointers in this area of memory.  So the typical drill in an application program is to define some type with fields that are useful to some application, then allocate using dynamic memory (a memory allocation function that returns a pointer to memory) one of these types.  One then stores whatever data in the type as is advantageous, then stores the pointer in the .cbWndExtra bytes of memory.

     In this manner data is associated with an instance of a Window, and the amount of data can be as little or as much as the application needs.  Further, one can then instantiate as many instances of such a program or as many instances of such a class in a single program as one needs, and all data will be independent of all other data.  This is a powerful idea.

     I'm usually good for some C or C++ code, so here follows a C++ program showing this technique in use with our now grid COM object.  I developed the program below using the open source MinGW compiler suite and Code::Blocks for an IDE.  I'll discuss the issues involved first with C++ clients, then with several PowerBASIC clients.  The reason I'm starting with a C++ client first is that there are some tricky issues involved with PowerBASIC, and I though showing a C++ client first would help.  If you are at all interested in C++ but don't do it, but might want to follow along with my C++ example, you can download the Code::Blocks IDE and MinGW compiler suite from here...

http://www.codeblocks.org/

     The file you want is this...

codeblocks-10.05mingw-setup.exe

     After installing that, start up Code::Blocks and click on the main screen's 'Create A New Project' icon.  Then from the list of available project types choose 'Win32 GUI Project'.  Then another dialog will come up where you should choose to create a 'Frame Based' project.  You will then be asked for a name for the project, and I choose...

CppClient1_v4

And this is the location I choose.  I had to create a couple folders...

C:\Documents and Settings\freddie\My Documents\Code\CodeBlocks\cppClient1_v4

The full path to the project file name was...

C:\Documents and Settings\freddie\My Documents\Code\CodeBlocks\cppClient1_v4\cppClient1_v4.cbp

     Code::Blocks uses *.cbp for its project filenames.  Another screen you'll see specifies whether or not you want to produce both a Debug and Release configuration.  I always uncheck the Debug configuration because I seldom use them.  After that Code::Blocks will create for you a default Win32 application that will create a blank window.  It'll be basic Win32 Sdk style Api code.  You can click the little gear at top to compile it and the little green icon arrow to run it.  We won't be using that, but you ought to give it a try to see if everything is working.  In the project explorer/manager at left you should see details of your project listed, and you should see you have a file named main.cpp.  You can delete that code and paste the following code into main.cpp...

Code Select Expand


#define    UNICODE       //Main.cpp
#define    _UNICODE
#include   <windows.h>
#include   <tchar.h>
#include   <ocidl.h>
#include   <objbase.h>
#include   "WinTypes.h"
#include   "Strings.h"
#define    IDC_BUTTON1   2000                          //Control ID For Blue' Button
#define    IDC_KILL_CTL1 2005                          //Control ID For Kill COM Ctrl1
extern "C" const CLSID   CLSID_FHGrid                  ={0x20000000,0x0000,0x0000,{0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x70}};
extern "C" const IID     IID_IFHGrid                   ={0x20000000,0x0000,0x0000,{0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x71}};
extern "C" const IID     IID_IFHGrid_Events            ={0x20000000,0x0000,0x0000,{0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x72}};
extern "C" const IID     IID_IUnknown                  ={0x00000000,0x0000,0x0000,{0xC0,0x00,0x00,0x00,0x00,0x00,0x00,0x46}};
extern "C" const IID     IID_IConnectionPointContainer ={0xB196B284,0xBAB4,0x101A,{0xB6,0x9C,0x00,0xAA,0x00,0x34,0x1D,0x07}};


interface  IGrid : IUnknown
{
virtual   HRESULT __stdcall CreateGrid         (int, BSTR,int,int,int,int,int,int,int,BSTR,int,int         )=0;
virtual   HRESULT __stdcall SetRowCount        (int, int                                                   )=0;
virtual   HRESULT __stdcall SetData            (int, int, BSTR                                             )=0;
virtual   HRESULT __stdcall GetData            (int, int, BSTR*                                            )=0;
virtual   HRESULT __stdcall FlushData          (                                                           )=0;
virtual   HRESULT __stdcall Refresh            (                                                           )=0;
virtual   HRESULT __stdcall GetCtrlId          (int*                                                       )=0;
virtual   HRESULT __stdcall GethGrid           (int*                                                       )=0;
};


interface IGridEvents : IUnknown                //Out Going Interface From Grid
{
virtual HRESULT __stdcall Grid_OnKeyPress      (int KeyCode, int KeyData, int CellRow, int GridRow, int Col)=0;
virtual HRESULT __stdcall Grid_OnKeyDown       (int KeyCode, int KeyData, int CellRow, int GridRow, int Col)=0;
virtual HRESULT __stdcall Grid_OnLButtonDown   (int CellRow, int GridRow, int Col                          )=0;
virtual HRESULT __stdcall Grid_OnLButtonDblClk (int CellRow, int GridRow, int Col                          )=0;
virtual HRESULT __stdcall Grid_OnPaste         (int CellRow, int GridRow, int Col                          )=0;
virtual HRESULT __stdcall Grid_OnVButtonClick  (int iCellRow, int iGridRow                                 )=0;
};


class CSink : public IGridEvents                //CSink
{
public:
CSink();
~CSink();
HRESULT __stdcall QueryInterface               (REFIID iid, void** ppv                                     );
ULONG   __stdcall AddRef                       (                                                           );
ULONG   __stdcall Release                      (                                                           );
HRESULT __stdcall Grid_OnKeyPress              (int KeyCode, int KeyData, int CellRow, int GridRow, int Col);
HRESULT __stdcall Grid_OnKeyDown               (int KeyCode, int KeyData, int CellRow, int GridRow, int Col);
HRESULT __stdcall Grid_OnLButtonDown           (int CellRow, int GridRow, int Col                          );
HRESULT __stdcall Grid_OnLButtonDblClk         (int CellRow, int GridRow, int Col                          );
HRESULT __stdcall Grid_OnPaste                 (int CellRow, int GridRow, int Col                          );
HRESULT __stdcall Grid_OnVButtonClick          (int iCellRow, int iGridRow                                 );

private:
long m_cRef;
};


CSink::CSink() : m_cRef(0)
{
//Constructor
}


CSink::~CSink()
{
//Destructor
}


HRESULT CSink::QueryInterface(REFIID riid, void** ppv)
{
if(riid == IID_IUnknown)
    *ppv = (IUnknown*)this;
else if(riid == IID_IFHGrid_Events)
    *ppv = (IGridEvents*)this;
else
{
    *ppv = NULL;
    return E_NOINTERFACE;
}
AddRef();

return S_OK;
}


ULONG CSink::AddRef()
{
return ++m_cRef;
}


ULONG CSink::Release()
{
if(--m_cRef != 0)
    return m_cRef;
else
    delete this;

return 0;
}


HRESULT CSink::Grid_OnKeyPress(int KeyCode, int KeyData, int CellRow, int GridRow, int Col)
{
return S_OK;
}


HRESULT CSink::Grid_OnKeyDown(int KeyCode, int KeyData, int CellRow, int GridRow, int Col)
{
return S_OK;
}


HRESULT CSink::Grid_OnLButtonDown(int iCellRow, int iGridRow, int iCol)
{
return S_OK;
}


HRESULT CSink::Grid_OnLButtonDblClk(int iCellRow, int iGridRow, int iCol  )
{
return S_OK;
}


HRESULT CSink::Grid_OnPaste(int iCellRow, int iGridRow, int iCol  )
{
return S_OK;
}


HRESULT CSink::Grid_OnVButtonClick(int iCellRow, int iGridRow)
{
return S_OK;
}


long fnWndProc_OnCreate(lpWndEventArgs Wea)                                                     //Offset   What's Stored There
{                                                                                               //=======================================
IConnectionPointContainer* pConnectionPointContainer=NULL;                                     //0  -  3  pGrid
IConnectionPoint* pConnectionPoint=NULL;                                                       //4  -  7  pConnectionPointContainer
BSTR strSetup,strFontName,strCoordinate;                                                       //8  - 11  pConnectionPoint
DWORD dwCookie=NULL;                                                                           //12 - 15  dwCookie
CSink* pSink=NULL;
IGrid* pGrid=NULL;
String s1,s2,s3;
HWND hButton;

Wea->hIns=((LPCREATESTRUCT)Wea->lParam)->hInstance;                                            //CoInitialize() is called by PowerBASIC's startup code.
CoInitialize(NULL);                                                                            //CoCreateInstance() is about the closest analog to PB's
CoCreateInstance(CLSID_FHGrid,NULL,CLSCTX_INPROC_SERVER,IID_IFHGrid,(void**)&pGrid);           //NewCom() function.  However, NewCom() returns an interface
SetWindowLong(Wea->hWnd,0,(long)pGrid);                                                        //pointer; CoCreateInstance() returns the interface pointer
strFontName=SysAllocString(L"Times New Roman");                                                //as an [out, retval] parameter of the call itself.  The '&'
strSetup=                                                                                      //business is like PB's Varptr() keyword.  We're passing 'in'
SysAllocString(L"120:Column 1:^,130:Column 2:^,140:Column 3:^,150:Column 4:^,160:Column 5:^"); //the address so the function can return something to us through it.
pGrid->CreateGrid((int)Wea->hWnd,strSetup,10,10,570,218,12,5,28,strFontName,18,FW_DONTCARE);   //Note that we're doing the same thing here with SetWindowLong()
SysFreeString(strSetup);                                                                       //that we'll be doing with our PowerBASIC counterparts, i.e.,
SysFreeString(strFontName);                                                                    //PBClient4_v4.bas and PBClient9_v4.bas.  That is, storing interface
pGrid->QueryInterface(IID_IConnectionPointContainer,(void**)&pConnectionPointContainer);       //pointers in instance memory allocated in the Window Class struct.
SetWindowLong(Wea->hWnd,4,(long)pConnectionPointContainer);                                    //The interesting difference between this and the PowerBASIC programs
pConnectionPointContainer->FindConnectionPoint(IID_IFHGrid_Events, &pConnectionPoint);         //though, is that we're doing something PowerBASIC won't allow us,
SetWindowLong(Wea->hWnd,8,(long)pConnectionPoint);                                             //and that is "Reference Counting Optimization".  In other words,
pSink = new CSink;                                                                             //we're saying, "Hey!  The Rules Don't Apply To Us!  We Know Better
pConnectionPoint->Advise((IUnknown*)pSink, &dwCookie);                                         //Than The Rules!  When We Were Awarded An Interface Pointer Through
SetWindowLong(Wea->hWnd,12,(long)dwCookie);                                                    //Either Our CoCreateInstance() Call Or Our Various QueryInterface()
for(unsigned int i=1; i<=10; i++)                                                              //Calls, Those Interface Pointers Were AddRef()'ed, And We're Leaving
{                                                                                              //It Just Like That And Not Releasing Them!  And Being As This Is
     s1=i;                                                                                      //C++ And C++ Does No One Any Favors, Those Reference Counts Aren't
     for(unsigned int j=1; j<=5; j++)                                                           //Going To Get Changed Or Reduced Nohow!  So There's No Need To
     {                                                                                          //Add Artificial AddRef() Or Release() Calls!
         s2=j;
         s3=s1+_T(',')+s2;
         strCoordinate=SysAllocString(s3.lpStr());
         pGrid->SetData(i,j,strCoordinate);
         SysFreeString(strCoordinate);
     }
}
pGrid->Refresh();
hButton=CreateWindowEx(0,_T("button"),_T("Retrieve Data"),WS_CHILD|WS_VISIBLE,150,240,100,30,Wea->hWnd,(HMENU)IDC_BUTTON1,Wea->hIns,0);
hButton=CreateWindowEx(0,_T("button"),_T("Release Grid"),WS_CHILD|WS_VISIBLE,350,240,100,30,Wea->hWnd,(HMENU)IDC_KILL_CTL1,Wea->hIns,0);

return 0;
}


void DestroyGrid(lpWndEventArgs Wea)                                                //In C Or C++ this is as simple as it gets.  Whatever the reference count was set to
{                                                                                   //in fnWndProc_OnCreate(), that is what it will be when this procedure executes.  There
IConnectionPointContainer* pConnectionPointContainer=NULL;                         //is no garbage collection or automatic reference counting going on here.  The only
IConnectionPoint* pConnectionPoint=NULL;                                           //way a reference count decremeents is when you call Release() and the only way it
DWORD dwCookie=NULL;                                                               //increments (other than through QueryInterface() calls) is when you explicitely call
IGrid* pGrid=NULL;                                                                 //AddRef().

pConnectionPoint=(IConnectionPoint*)GetWindowLong(Wea->hWnd,8);                    //Call Unadvise() On Sink And Release() IConnectionPoint*
dwCookie=(DWORD)GetWindowLong(Wea->hWnd,12);
if(pConnectionPoint)
{
    pConnectionPoint->Unadvise(dwCookie);
    pConnectionPoint->Release();
    SetWindowLong(Wea->hWnd,8,0);
}
pConnectionPointContainer=(IConnectionPointContainer*)GetWindowLong(Wea->hWnd,4);  //Release IConnectionPointContainer*
if(pConnectionPointContainer)
{
     pConnectionPointContainer->Release();
     SetWindowLong(Wea->hWnd,4,0);
}
pGrid=(IGrid*)GetWindowLong(Wea->hWnd,0);                                          //Release() IGrid*
if(pGrid)
{
    pGrid->Release();
    SetWindowLong(Wea->hWnd,0,0);
}
}


long fnWndProc_OnCommand(lpWndEventArgs Wea)
{
switch(LOWORD(Wea->wParam))
{
   case IDC_BUTTON1:
   {
        IGrid* pGrid=(IGrid*)GetWindowLong(Wea->hWnd,0);
        HRESULT hr=pGrid->FlushData();
        if(SUCCEEDED(hr))
        {
           BSTR strCell=SysAllocString(L"");
           hr=pGrid->GetData(3,2,&strCell);
           if(SUCCEEDED(hr))
           {
              MessageBox(Wea->hWnd,strCell,_T("Cell (3,2)"),MB_OK);
              SysFreeString(strCell);
           }
        }
        break;
   }
   case IDC_KILL_CTL1:
   {
        DestroyGrid(Wea);
        EnableWindow(GetDlgItem(Wea->hWnd,IDC_BUTTON1),FALSE);
        EnableWindow(GetDlgItem(Wea->hWnd,IDC_KILL_CTL1),FALSE);
       InvalidateRect(Wea->hWnd,NULL,TRUE);
        break;
   }
}

return 0;
}


long fnWndProc_OnDestroy(lpWndEventArgs Wea)
{
DestroyGrid(Wea);
CoFreeUnusedLibraries();
CoUninitialize();
PostQuitMessage(0);

return 0;
}


LRESULT CALLBACK fnWndProc(HWND hwnd, unsigned int msg, WPARAM wParam, LPARAM lParam)
{
WndEventArgs Wea;

for(unsigned int i=0; i<dim(EventHandler); i++)
{
     if(EventHandler[i].Code==msg)
     {
        Wea.hWnd=hwnd, Wea.lParam=lParam, Wea.wParam=wParam;
        return (*EventHandler[i].fnPtr)(&Wea);
     }
}

return (DefWindowProc(hwnd,msg,wParam,lParam));
}


int __stdcall WinMain(HINSTANCE hIns, HINSTANCE hPrevIns, LPSTR lpszArgument, int iShow)
{
TCHAR szClassName[]=_T("AxGridCtrl");
WNDCLASSEX wc;
MSG messages;
HWND hWnd;

wc.lpszClassName=szClassName;                         wc.lpfnWndProc=fnWndProc;
wc.cbSize=sizeof (WNDCLASSEX);                        wc.style=CS_DBLCLKS;
wc.hIcon=LoadIcon(NULL,IDI_APPLICATION);              wc.hInstance=hIns;
wc.hIconSm=LoadIcon(NULL, IDI_APPLICATION);           wc.hCursor=LoadCursor(NULL,IDC_ARROW);
wc.hbrBackground=(HBRUSH)COLOR_BTNSHADOW;             wc.cbWndExtra=16;
wc.lpszMenuName=NULL;                                 wc.cbClsExtra=0;
RegisterClassEx(&wc);
hWnd=CreateWindowEx(0,szClassName,szClassName,WS_OVERLAPPEDWINDOW,200,200,600,320,HWND_DESKTOP,0,hIns,0);
ShowWindow(hWnd,iShow);
while(GetMessage(&messages,NULL,0,0))
{
    TranslateMessage(&messages);
    DispatchMessage(&messages);
}

return messages.wParam;
}



/*
#define    UNICODE       //Main.cpp
#define    _UNICODE
#include   <windows.h>
#include   <tchar.h>
#include   <fcntl.h>
#include   <io.h>
#include   <stdio.h>
#include   <ocidl.h>
#include   <objbase.h>
#include   "WinTypes.h"
#include   "Strings.h"
#define    IDC_BUTTON1   2000                          //Control ID For Blue' Button
#define    IDC_KILL_CTL1 2005                          //Control ID For Kill COM Ctrl1
extern "C" const CLSID   CLSID_FHGrid                  ={0x20000000,0x0000,0x0000,{0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x70}};
extern "C" const IID     IID_IFHGrid                   ={0x20000000,0x0000,0x0000,{0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x71}};
extern "C" const IID     IID_IFHGrid_Events            ={0x20000000,0x0000,0x0000,{0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x72}};
extern "C" const IID     IID_IUnknown                  ={0x00000000,0x0000,0x0000,{0xC0,0x00,0x00,0x00,0x00,0x00,0x00,0x46}};
extern "C" const IID     IID_IConnectionPointContainer ={0xB196B284,0xBAB4,0x101A,{0xB6,0x9C,0x00,0xAA,0x00,0x34,0x1D,0x07}};


interface  IGrid : IUnknown
{
virtual   HRESULT __stdcall CreateGrid         (int, BSTR,int,int,int,int,int,int,int,BSTR,int,int         )=0;
virtual   HRESULT __stdcall SetRowCount        (int, int                                                   )=0;
virtual   HRESULT __stdcall SetData            (int, int, BSTR                                             )=0;
virtual   HRESULT __stdcall GetData            (int, int, BSTR*                                            )=0;
virtual   HRESULT __stdcall FlushData          (                                                           )=0;
virtual   HRESULT __stdcall Refresh            (                                                           )=0;
virtual   HRESULT __stdcall GetCtrlId          (int*                                                       )=0;
virtual   HRESULT __stdcall GethGrid           (int*                                                       )=0;
};


interface IGridEvents : IUnknown                //Out Going Interface From Grid
{
virtual HRESULT __stdcall Grid_OnKeyPress      (int KeyCode, int KeyData, int CellRow, int GridRow, int Col)=0;
virtual HRESULT __stdcall Grid_OnKeyDown       (int KeyCode, int KeyData, int CellRow, int GridRow, int Col)=0;
virtual HRESULT __stdcall Grid_OnLButtonDown   (int CellRow, int GridRow, int Col                          )=0;
virtual HRESULT __stdcall Grid_OnLButtonDblClk (int CellRow, int GridRow, int Col                          )=0;
virtual HRESULT __stdcall Grid_OnPaste         (int CellRow, int GridRow, int Col                          )=0;
virtual HRESULT __stdcall Grid_OnVButtonClick  (int iCellRow, int iGridRow                                 )=0;
};


class CSink : public IGridEvents                //CSink
{
public:
CSink();
~CSink();
HRESULT __stdcall QueryInterface               (REFIID iid, void** ppv                                     );
ULONG   __stdcall AddRef                       (                                                           );
ULONG   __stdcall Release                      (                                                           );
HRESULT __stdcall Grid_OnKeyPress              (int KeyCode, int KeyData, int CellRow, int GridRow, int Col);
HRESULT __stdcall Grid_OnKeyDown               (int KeyCode, int KeyData, int CellRow, int GridRow, int Col);
HRESULT __stdcall Grid_OnLButtonDown           (int CellRow, int GridRow, int Col                          );
HRESULT __stdcall Grid_OnLButtonDblClk         (int CellRow, int GridRow, int Col                          );
HRESULT __stdcall Grid_OnPaste                 (int CellRow, int GridRow, int Col                          );
HRESULT __stdcall Grid_OnVButtonClick          (int iCellRow, int iGridRow                                 );

private:
long m_cRef;
};


CSink::CSink() : m_cRef(0)
{
_tprintf(_T("  Entering CSink Constructor!\n"));
_tprintf(_T("    this = %u\n"),this);
_tprintf(_T("  Leaving CSink Constructor!\n\n"));
}


CSink::~CSink()
{
_tprintf(_T("      Entering CSink Destructor!\n"));
_tprintf(_T("        this = %u\n"),this);
_tprintf(_T("      Leaving CSink Destructor!\n"));
}


HRESULT CSink::QueryInterface(REFIID riid, void** ppv)
{
_tprintf(_T("    Entering CSink::QueryInterface() -- this = %u\n"),this);
if(riid == IID_IUnknown)
{
    *ppv = (IUnknown*)this;
}
else if(riid == IID_IFHGrid_Events)
{
    _tprintf(_T("      Client: CSink::QueryInterface() for IID_IFHGrid_Events  -- this = %u\n"), (IGridEvents*)this);
    *ppv = (IGridEvents*)this;
    _tprintf(_T("      *ppv = %u\n"), *ppv);
}
else
{
    *ppv = NULL;
    return E_NOINTERFACE;
}
AddRef();
_tprintf(_T("    Leaving CSink::QueryInterface(): this = %u\n"),this);

return S_OK;
}


ULONG CSink::AddRef()
{
return ++m_cRef;
}


ULONG CSink::Release()
{
_tprintf(_T("  Entering CSink::Release()\n"));
_tprintf(_T("    this = %u\n"),this);
if(--m_cRef != 0)
{
    _tprintf(_T("    m_cRef != 0 : m_cRef=%u\n"),m_cRef);
    return m_cRef;
}
else
{
    _tprintf(_T("    m_cRef == 0 And Will Now Delete CSink!\n"));
    delete this;
}
_tprintf(_T("  Leaving CSink::Release()\n"));

return 0;
}


HRESULT CSink::Grid_OnKeyPress(int KeyCode, int KeyData, int CellRow, int GridRow, int Col)
{
_tprintf(_T("\nEntering CSink::Grid_OnKeyPress()\n"));
_tprintf(_T("  CSink::Grid_OnKeyPress is %u\n"), KeyCode);
_tprintf(_T("Leaving CSink::Grid_OnKeyPress()\n"));

return S_OK;
}


HRESULT CSink::Grid_OnKeyDown(int KeyCode, int KeyData, int CellRow, int GridRow, int Col)
{
_tprintf(_T("\nEntering CSink::Grid_OnKeyDown()\n"));
_tprintf(_T("  CSink::Grid_OnKeyDown is %u\n"), KeyCode);
_tprintf(_T("Leaving CSink::Grid_OnKeyDown()\n"));

return S_OK;
}


HRESULT CSink::Grid_OnLButtonDown(int iCellRow, int iGridRow, int iCol)
{
_tprintf(_T("\nEntering CSink::Grid_OnLButtonDown()\n"));
_tprintf(_T("  CSink::Grid_OnLButtonDown: iRow = %u\tiCol = %u\n"),iCellRow,iCol);
_tprintf(_T("Leaving CSink::Grid_OnLButtonDown()\n"));

return S_OK;
}


HRESULT CSink::Grid_OnLButtonDblClk(int iCellRow, int iGridRow, int iCol  )
{
_tprintf(_T("\nEntering CSink::Grid_OnLButtonDblClk()\n"));
_tprintf(_T("  CSink::Grid_OnLButtonDblClk: iRow = %u\tiCol = %u\n"),iCellRow,iCol);
_tprintf(_T("Leaving CSink::Grid_OnLButtonDblClk()\n"));

return S_OK;
}


HRESULT CSink::Grid_OnPaste(int iCellRow, int iGridRow, int iCol  )
{
_tprintf(_T("\nEntering CSink::Grid_OnPaste()\n"));
_tprintf(_T("  CSink::Grid_OnPaste: iRow=%u\tiCol=%u\n"), iCellRow,iCol);
_tprintf(_T("Leaving CSink::Grid_OnPaste()\n"));

return S_OK;
}


HRESULT CSink::Grid_OnVButtonClick(int iCellRow, int iGridRow)
{
_tprintf(_T("\nEntering CSink::Grid_OnVButtonClick()\n"));
_tprintf(_T("  CSink::Grid_OnVButtonClick:  iCellRow=%u\tiGridRow=%u\n"),iCellRow,iGridRow);
_tprintf(_T("Leaving CSink::Grid_OnVButtonClick()\n"));

return S_OK;
}


long fnWndProc_OnCreate(lpWndEventArgs Wea)
{
IConnectionPointContainer* pConnectionPointContainer=NULL;   //Offset   What's Stored There
IConnectionPoint* pConnectionPoint=NULL;                     //=======================================
BSTR strSetup,strFontName,strCoordinate;                     //0  -  3  pGrid
DWORD dwCookie=NULL;                                         //4  -  7  pConnectionPointContainer
CSink* mySink=NULL;                                          //8  - 11  pConnectionPoint
IGrid* pGrid=NULL;                                           //12 - 15  dwCookie
String s1,s2,s3;
HWND hButton;
HRESULT hr;
int hCrt;
FILE* hf;

Wea->hIns=((LPCREATESTRUCT)Wea->lParam)->hInstance;
AllocConsole();
hCrt=_open_osfhandle((long)GetStdHandle(STD_OUTPUT_HANDLE),_O_TEXT);
hf = _fdopen( hCrt, "w" );
_iob[1]=*hf;
_tprintf(_T("Entering fnWndProc_OnCreate()\n"));
_tprintf(_T("  Wea->hWnd = %u\n"),Wea->hWnd);
hr=CoInitialize(NULL);
if(SUCCEEDED(hr))
{
    _tprintf(_T("  CoInitialize() Succeeded!\n"));
    hr=CoCreateInstance(CLSID_FHGrid,NULL,CLSCTX_INPROC_SERVER,IID_IFHGrid,(void**)&pGrid);
    if(SUCCEEDED(hr))
    {
       _tprintf(_T("\n  CoCreateInstance() Succeeded! -- pGrid = %u\n"),pGrid);
       SetWindowLong(Wea->hWnd,0,(long)pGrid);
       strFontName=SysAllocString(L"Times New Roman");
       strSetup=SysAllocString(L"120:Column 1:^,130:Column 2:^,140:Column 3:^,150:Column 4:^,160:Column 5:^");
       hr=pGrid->CreateGrid((int)Wea->hWnd,strSetup,10,10,570,218,12,5,28,strFontName,18,FW_DONTCARE);
       SysFreeString(strSetup);
       SysFreeString(strFontName);
       if(SUCCEEDED(hr))
       {
          _tprintf(_T("  pGrid->Create() Succeeded!\n"));
          hr=pGrid->QueryInterface(IID_IConnectionPointContainer,(void**)&pConnectionPointContainer);
          if(SUCCEEDED(hr))
          {
             _tprintf(_T("  \nGot pConnectionPointContainer = %u\n\n"),(unsigned int)pConnectionPointContainer);
             SetWindowLong(Wea->hWnd,4,(long)pConnectionPointContainer);
             hr = pConnectionPointContainer->FindConnectionPoint(IID_IFHGrid_Events, &pConnectionPoint);
             if(SUCCEEDED(hr))
             {
                _tprintf(_T("  Got pConnectionPoint = %u\n"),pConnectionPoint);
                SetWindowLong(Wea->hWnd,8,(long)pConnectionPoint);
                mySink = new CSink;
                _tprintf(_T("  mySink = %u\n\n"),mySink);
                hr=pConnectionPoint->Advise((IUnknown*)mySink, &dwCookie);
                if(SUCCEEDED(hr))
                {
                   _tprintf(_T("  pConnectionPoint->Advise() Succeeded!\n"));
                   SetWindowLong(Wea->hWnd,12,(long)dwCookie);
                   for(unsigned int i=1; i<=10; i++)
                  {
                       s1=i;
                       for(unsigned int j=1; j<=5; j++)
                       {
                           s2=j;
                           s3=s1+_T(',')+s2;
                           strCoordinate=SysAllocString(s3.lpStr());
                           _tprintf(_T("  "));
                           s3.Print(true);
                           pGrid->SetData(i,j,strCoordinate);
                           SysFreeString(strCoordinate);
                       }
                   }
                   _tprintf(_T("\n"));
                   pGrid->Refresh();
                }
                else
                   puts("  pConnectionPoint->Advise() Failed!");
             }
             else
                _tprintf(_T("  Failed To Get pConnectionPoint!\n"));
          }
          else
             _tprintf(_T("  Failed To Get IConnectionPointContainer*\n"));
          _tprintf(_T("\n"));
       }
       else
          _tprintf(_T("  pGrid->Create() Failed!\n"));
    }
    else
       _tprintf(_T("  CoCreateInstance() Failed!\n"));
}
else
    _tprintf(_T("  CoInitialize() Failed!\n"));
hButton=CreateWindowEx(0,_T("button"),_T("Retrieve Data"),WS_CHILD|WS_VISIBLE,150,240,100,30,Wea->hWnd,(HMENU)IDC_BUTTON1,Wea->hIns,0);
hButton=CreateWindowEx(0,_T("button"),_T("Release Grid"),WS_CHILD|WS_VISIBLE,350,240,100,30,Wea->hWnd,(HMENU)IDC_KILL_CTL1,Wea->hIns,0);
_tprintf(_T("Leaving fnWndProc_OnCreate()\n\n"));

return 0;
}


void DestroyGrid(lpWndEventArgs Wea)
{
IConnectionPointContainer* pConnectionPointContainer=NULL;
IConnectionPoint* pConnectionPoint=NULL;
DWORD dwCookie=NULL;
IGrid* pGrid=NULL;

_tprintf(_T("\n  Entering DestroyGrid()\n"));
pConnectionPoint=(IConnectionPoint*)GetWindowLong(Wea->hWnd,8);                     //Call Unadvise() On Sink And Release() IConnectionPoint*
dwCookie=(DWORD)GetWindowLong(Wea->hWnd,12);
if(pConnectionPoint)
{
    pConnectionPoint->Unadvise(dwCookie);
    pConnectionPoint->Release();
    SetWindowLong(Wea->hWnd,8,0);
}
else
    _tprintf(_T("    IConnectionPoint* Apparently Released!\n"));
pConnectionPointContainer=(IConnectionPointContainer*)GetWindowLong(Wea->hWnd,4);   //Release IConnectionPointContainer*
if(pConnectionPointContainer)
{
     pConnectionPointContainer->Release();
     SetWindowLong(Wea->hWnd,4,0);
}
else
    _tprintf(_T("    IConnectionPointContainer* Apparently Released!\n"));
pGrid=(IGrid*)GetWindowLong(Wea->hWnd,0);                                           //Release() IGrid*
if(pGrid)
{
    pGrid->Release();
    SetWindowLong(Wea->hWnd,0,0);
}
else
    _tprintf(_T("    IGrid* Apparently Released!\n"));
_tprintf(_T("  Leaving DestroyGrid()\n"));
}


long fnWndProc_OnCommand(lpWndEventArgs Wea)
{
_tprintf(_T("\nEntering fnWndProc_OnCommand()\n"));
switch(LOWORD(Wea->wParam))
{
   case IDC_BUTTON1:
   {
        IGrid* pGrid=(IGrid*)GetWindowLong(Wea->hWnd,0);
        HRESULT hr=pGrid->FlushData();
        if(SUCCEEDED(hr))
        {
           BSTR strCell=SysAllocString(L"");
           hr=pGrid->GetData(3,2,&strCell);
           if(SUCCEEDED(hr))
           {
              _tprintf(_T("  pGrid->GetData() Succeeded!\n"));
              _tprintf(_T("  strCell = %s\n"),strCell);
              SysFreeString(strCell);
           }
           else
              _tprintf(_T("  pGrid->GetData() Failed!\n"));
        }
        break;
   }
   case IDC_KILL_CTL1:
   {
        DestroyGrid(Wea);
        EnableWindow(GetDlgItem(Wea->hWnd,IDC_BUTTON1),FALSE);
        EnableWindow(GetDlgItem(Wea->hWnd,IDC_KILL_CTL1),FALSE);
       InvalidateRect(Wea->hWnd,NULL,TRUE);
        break;
   }
}
_tprintf(_T("Leaving fnWndProc_OnCommand()\n\n"));

return 0;
}


long fnWndProc_OnDestroy(lpWndEventArgs Wea)
{
_tprintf(_T("\nEntering fnWndProc_OnDestroy()\n"));
DestroyGrid(Wea);
CoFreeUnusedLibraries();
CoUninitialize();
_tprintf(_T("Leaving fnWndProc_OnDestroy()\n\n"));
MessageBox(Wea->hWnd,_T("Have Just Released Object!  You Can Copy The Output From The Console If You Want Though!"),_T("Will Close App!"),MB_OK);
PostQuitMessage(0);

return 0;
}


LRESULT CALLBACK fnWndProc(HWND hwnd, unsigned int msg, WPARAM wParam, LPARAM lParam)
{
WndEventArgs Wea;

for(unsigned int i=0; i<dim(EventHandler); i++)
{
     if(EventHandler[i].Code==msg)
     {
        Wea.hWnd=hwnd, Wea.lParam=lParam, Wea.wParam=wParam;
        return (*EventHandler[i].fnPtr)(&Wea);
     }
}

return (DefWindowProc(hwnd,msg,wParam,lParam));
}


int __stdcall WinMain(HINSTANCE hIns, HINSTANCE hPrevIns, LPSTR lpszArgument, int iShow)
{
TCHAR szClassName[]=_T("AxGridCtrl");
WNDCLASSEX wc;
MSG messages;
HWND hWnd;

wc.lpszClassName=szClassName;                         wc.lpfnWndProc=fnWndProc;
wc.cbSize=sizeof (WNDCLASSEX);                        wc.style=CS_DBLCLKS;
wc.hIcon=LoadIcon(NULL,IDI_APPLICATION);              wc.hInstance=hIns;
wc.hIconSm=LoadIcon(NULL, IDI_APPLICATION);           wc.hCursor=LoadCursor(NULL,IDC_ARROW);
wc.hbrBackground=(HBRUSH)COLOR_BTNSHADOW;             wc.cbWndExtra=16;
wc.lpszMenuName=NULL;                                 wc.cbClsExtra=0;
RegisterClassEx(&wc);
hWnd=CreateWindowEx(0,szClassName,szClassName,WS_OVERLAPPEDWINDOW,200,200,600,320,HWND_DESKTOP,0,hIns,0);
ShowWindow(hWnd,iShow);
while(GetMessage(&messages,NULL,0,0))
{
    TranslateMessage(&messages);
    DispatchMessage(&messages);
}

return messages.wParam;
}
*/


     There are actually two programs above – a non-debug version first and following that a debug version that creates a console in addition to the grid and outputs a lot of diagnostic information.  In C or C++ you can remark out whole sections of code with these symbols...

/*
commented out!!!
*/

     After the WinMain() of the first program above you'll see those symbols remarking out the 2nd whole program. 

     To run that program you'll need three additional files which I'll attach and they are Strings.h, Strings.cpp, and WinTypes.h.  I'll also post the code.  To insert those files into the project so you can run it, go up to your project explorer/manager and right click on the project name and choose the selection 'Add Files...'.  They should then show up in your project manager and you should be able to examine them.  Something else I always do is go into Build Options >>> Compiler Settings and check the 'Strip Symbols From Executable (minimizes size)' and 'Optimize For Small Code' options. The next thing you'll have to do to be able to compile this is add a few import libraries for the linker.  Go to the main menu and select...

Main Menu  >>  Project >>> Build Options...

     In the dialog that comes up choose the 'Linker Settings' tab.  Then click the 'Add' button under 'Link Libraries'.  Then you'll be presented with a dialog box where you'll have to navigate to wherever you installed Code::Blocks and under its installation directory you'll find paths such as this...

C:\Program Files\CodeBlocks\MinGW\Lib

     You'll have to go through this process twice so as to select...

Libole32.a
Liboleauto32.a

     When asked whether or not to keep these as a 'Relative Path' choose yes.  At that point you should be able to compile and run the code.  Before you do that though go to the View Main Menu and check the 'Logs' option so you'll see the compiler output window.  Then try to compile.  Here are the three files you'll need in addition to the code I just posted...

[Frederick J. Harris]

Code Select Expand


//WinTypes.h
#ifndef WINTYPES_H
#define WINTYPES_H
#define dim(x) (sizeof(x) / sizeof(x[0]))

typedef struct           WindowsEventArguments
{
HWND                    hWnd;
WPARAM                  wParam;
LPARAM                  lParam;
HINSTANCE               hIns;
}WndEventArgs,           *lpWndEventArgs;

long fnWndProc_OnCreate  (lpWndEventArgs Wea);
long fnWndProc_OnCommand (lpWndEventArgs Wea);
long fnWndProc_OnDestroy (lpWndEventArgs Wea);

struct EVENTHANDLER
{
unsigned int            Code;
long                    (*fnPtr)(lpWndEventArgs);
};

const EVENTHANDLER EventHandler[]=
{
{WM_CREATE,             fnWndProc_OnCreate},
{WM_COMMAND,            fnWndProc_OnCommand},
{WM_DESTROY,            fnWndProc_OnDestroy}
};
#endif


Code Select Expand


//Strings.h
#if !defined(STRINGS_H)
#define STRINGS_H
#define EXPANSION_FACTOR      2
#define MINIMUM_ALLOCATION   16

class String
{
public:
friend String operator+(TCHAR*, String&);
String();                                    //Uninitialized Constructor
String(const TCHAR);                         //Constructor Initializes With A TCHAR.
String(const TCHAR*);                        //Constructor Initializes String With TCHAR*
String(const String&);                       //Constructor Initializes String With Another String (Copy Constructor)
String(const int, bool);                     //Constructor Creates String With User Specified Capacity and optionally nulls out
String(const int, const TCHAR);              //Constructor initializes String with int # of TCHARs
String(int);                                 //Constructor initializes String with int converted to String
String(unsigned int);                        //Constructor initializes String with unsigned int converted to String
String(double);                              //Constructor initializes String with double converted to String
String& operator=(const TCHAR);              //Assign A TCHAR To A String
String& operator=(const TCHAR*);             //Assign A Null Terminated TCHARacter Array To A String
String& operator=(const String&);            //Assigns Another String To this One
String& operator=(int iNum);                 //Assigns an unsigned int to a String
String& operator=(unsigned int iNum);        //Assigns an unsigned int to a String
String& operator=(double dblNum);            //Assign a double to a String
String operator+(const TCHAR);               //For adding TCHAR to String
String operator+(const TCHAR*);              //Adds a TCHAR* to this
String operator+(String&);                   //Adds another String to this
String& operator+=(const TCHAR ch);          //Add TCHAR to this
String& operator+=(const String&);           //Adds a String to this and assigns it to left of equal sign
String& operator+=(const TCHAR*);            //Adds a TCHAR*to this and assigns it to left of equal sign
bool operator==(String&);                    //Compares Strings For Case Sensitive Equality
bool operator==(const TCHAR*);               //Compares String Against TCHAR* For Case Sensitive Equality
String& Make(const TCHAR ch, int iCount);    //Returns reference to this with iCount ch TCHARs in it
String Left(int);                            //Returns String of iNum Left Most TTCHARs of this
String Right(int);                           //Returns String of iNum Right Most TTCHARs of this
String Mid(int, int);                        //Returns String consisting of number of TTCHARs from some offset
String Replace(TCHAR*, TCHAR*);              //Returns String with 1st TCHAR* parameter replaced with 2nd TCHAR* parameter
String Remove(TCHAR*);                       //Returns A String With All The TCHARs In A TCHAR* Removed (Individual TCHAR removal)
String Remove(const TCHAR*, bool);           //Returns a String with 1st parameter removed.  2nd is bool for case sensitivity.
int InStr(const TCHAR*, bool);               //Returns one based offset of a particular TTCHAR pStr in a String
int InStr(const String&, bool);              //Returns one based offset of where a particular String is in another String
int ParseCount(const TCHAR);                 //Returns count of Strings delimited by a TTCHAR passed as a parameter
void Parse(String*, TCHAR);                  //Returns array of Strings in first parameter as delimited by 2nd TTCHAR delimiter
void SetTCHAR(int, TCHAR);                   //Sets TCHAR at zero based offset in this
void LTrim();                                //Returns String with leading spaces/tabs removed
void RTrim();                                //Returns String with spaces/tabs removed from end
void Trim();                                 //Returns String with both leading and trailing whitespace removed
int iVal();                                  //Returns integral value of String
int Len();                                   //Returns Length Of String Controlled By this
int Capacity();                              //Returns Maximum Permissable TCHARacter Count (One Less Than Allocation).
TCHAR* lpStr();                              //Returns TCHAR* To String
void Print(bool);                            //Outputs String To Console With Or Without CrLf.
~String();                                   //String Destructor

private:
TCHAR* lpBuffer;
int   iLen;
int   iCapacity;
};

String operator+(TCHAR* lhs, String& rhs);
#endif  //#if !defined(STRINGS_H)


Code Select Expand


//Strings.cpp
#define UNICODE
#define _UNICODE
#include  <stdlib.h>
#include  <cstdio>
#include  <tchar.h>
#include  <math.h>
#include  <string.h>
#include  "Strings.h"


String operator+(TCHAR* lhs, String& rhs)         //global function
{
String sr=lhs;
sr=sr+rhs;

return sr;
}


String::String()
{
lpBuffer=new TCHAR[MINIMUM_ALLOCATION];
lpBuffer[0]=_T('\0');
this->iCapacity=MINIMUM_ALLOCATION-1;
this->iLen=0;
}


String::String(const TCHAR ch)  //Constructor: Initializes with TCHAR
{
this->iLen=1;
int iNewSize=MINIMUM_ALLOCATION;
this->lpBuffer=new TCHAR[iNewSize];
this->iCapacity=iNewSize-1;
this->lpBuffer[0]=ch, this->lpBuffer[1]=_T('\0');
}


String::String(const TCHAR* pStr)  //Constructor: Initializes with TCHAR*
{
this->iLen=_tcslen(pStr);
int iNewSize=(this->iLen/16+1)*16;
this->lpBuffer=new TCHAR[iNewSize];
this->iCapacity=iNewSize-1;
_tcscpy(lpBuffer,pStr);
}


String::String(const String& s)  //Constructor Initializes With Another String, i.e., Copy Constructor
{
int iNewSize=(s.iLen/16+1)*16;
this->iLen=s.iLen;
this->lpBuffer=new TCHAR[iNewSize];
this->iCapacity=iNewSize-1;
_tcscpy(this->lpBuffer,s.lpBuffer);
}


String::String(const int iSize, bool blnFillNulls)  //Constructor Creates String With Custom Sized
{                                                   //Buffer (rounded up to paragraph boundary)
int iNewSize=(iSize/16+1)*16;
this->lpBuffer=new TCHAR[iNewSize];
this->iCapacity=iNewSize-1;
this->iLen=0;
this->lpBuffer[0]=_T('\0');
if(blnFillNulls)
{
    for(int i=0; i<this->iCapacity; i++)
        this->lpBuffer[i]=0;
}
}


String::String(int iCount, const TCHAR ch)
{
int iNewSize=(iCount/16+1)*16;
this->lpBuffer=new TCHAR[iNewSize];
this->iCapacity=iNewSize-1;
for(int i=0; i<iCount; i++)
     this->lpBuffer[i]=ch;
this->lpBuffer[iCount]=_T('\0');
this->iLen=iCount;
}


String::String(int iNum)
{
this->lpBuffer=new TCHAR[16];
this->iCapacity=15;
this->iLen=_stprintf(this->lpBuffer,_T("%d"),iNum);
}


String::String(unsigned int iNum)
{
this->lpBuffer=new TCHAR[16];
this->iCapacity=15;
this->iLen=_stprintf(this->lpBuffer,_T("%u"),iNum);
}


String::String(double dblNum)
{
this->lpBuffer=new TCHAR[32];
this->iCapacity=31;
this->iLen=_stprintf(this->lpBuffer,_T("%10.14f"),dblNum);
}


String& String::operator=(double dblNum)
{
if(this->iCapacity<32)
{
    delete [] this->lpBuffer;
    lpBuffer=new TCHAR[32];
    this->iCapacity=31;
}
this->iLen=_stprintf(this->lpBuffer,_T("%10.14f"),dblNum);

return *this;
}


void String::SetTCHAR(int iOffset, TCHAR ch)   //zero based!
{
if(iOffset<this->iCapacity)
{
    this->lpBuffer[iOffset]=ch;
    if(ch==_T('\0'))
    {
       if(iOffset<this->iLen || this->iLen==0)
          this->iLen=iOffset;
    }
}
}


String& String::operator=(const TCHAR ch)
{
this->lpBuffer[0]=ch, this->lpBuffer[1]=_T('\0');
this->iLen=1;
return *this;
}


String& String::operator=(const TCHAR* pStr)
{
int iNewLen=_tcslen(pStr);
if(iNewLen>this->iCapacity)
{
    delete [] this->lpBuffer;
    int iNewSize=(iNewLen*EXPANSION_FACTOR/16+1)*16;
    this->lpBuffer=new TCHAR[iNewSize];
    this->iCapacity=iNewSize-1;
}
_tcscpy(this->lpBuffer,pStr);
this->iLen=iNewLen;

return *this;
}


String& String::operator=(const String& strAnother)
{
if(this==&strAnother)
    return *this;
if(strAnother.iLen>this->iCapacity)
{
    delete [] this->lpBuffer;
    int iNewSize=(strAnother.iLen*EXPANSION_FACTOR/16+1)*16;
    this->lpBuffer=new TCHAR[iNewSize];
    this->iCapacity=iNewSize-1;
}
_tcscpy(this->lpBuffer,strAnother.lpBuffer);
this->iLen=strAnother.iLen;

return *this;
}


String& String::operator=(int iNum)
{
if(this->iCapacity>=15)
    this->iLen=_stprintf(this->lpBuffer,_T("%d"),iNum);
else
{
    delete [] this->lpBuffer;
    this->lpBuffer=new TCHAR[16];
    this->iCapacity=15;
    this->iLen=_stprintf(this->lpBuffer,_T("%d"),iNum);
}

return *this;
}


String& String::operator=(unsigned int iNum)
{
  if(this->iCapacity>=15)
    this->iLen=_stprintf(this->lpBuffer,_T("%d"),iNum);
else
{
    delete [] this->lpBuffer;
    this->lpBuffer=new TCHAR[16];
    this->iCapacity=15;
    this->iLen=_stprintf(this->lpBuffer,_T("%d"),iNum);
}

return *this;
}


String String::operator+(const TCHAR ch)
{
int iNewLen=this->iLen+1;

String s(iNewLen,false);
_tcscpy(s.lpBuffer,this->lpBuffer);
s.lpBuffer[iNewLen-1]=ch;
s.lpBuffer[iNewLen]=_T('\0');
s.iLen=iNewLen;

return s;
}


String String::operator+(const TCHAR* pStr)
{
int iNewLen=_tcslen(pStr)+this->iLen;
String s(iNewLen,false);
_tcscpy(s.lpBuffer,this->lpBuffer);
_tcscat(s.lpBuffer,pStr);
s.iLen=iNewLen;

return s;
}


String String::operator+(String& strRef)
{
int iNewLen=strRef.iLen+this->iLen;
String s(iNewLen,false);
_tcscpy(s.lpBuffer,this->lpBuffer);
_tcscat(s.lpBuffer,strRef.lpBuffer);
s.iLen=iNewLen;

return s;
}


String& String::operator+=(const TCHAR ch)
{
int iTot=this->iLen+1;
if(iTot>this->iCapacity)
{
    int iNewSize=(iTot*EXPANSION_FACTOR/16+1)*16;
    TCHAR* pNew=new TCHAR[iNewSize];
    _tcscpy(pNew,this->lpBuffer);
    delete [] this->lpBuffer;
    this->lpBuffer=pNew;
    this->lpBuffer[iTot-1]=ch;
    this->lpBuffer[iTot]=_T('\0');
    this->iCapacity=iNewSize-1;
    this->iLen=iTot;
}
else
{
    this->lpBuffer[iTot-1]=ch;
    this->lpBuffer[iTot]=_T('\0');
    this->iLen=iTot;
}
return *this;
}


String& String::operator+=(const TCHAR* pStr)
{
int iStrlen=_tcslen(pStr);
int iTot=iStrlen+this->iLen;
if(iTot>this->iCapacity)
{
    int iNewSize=(iTot*EXPANSION_FACTOR/16+1)*16;
    TCHAR* pNew=new TCHAR[iNewSize];
    _tcscpy(pNew,this->lpBuffer);
    delete [] this->lpBuffer;
    this->lpBuffer=pNew;
    _tcscat(pNew,pStr);
    this->iCapacity=iNewSize-1;
    this->iLen=iTot;
}
else
{
    _tcscat(this->lpBuffer,pStr);
    this->iLen=iTot;
}
return *this;
}


String& String::operator+=(const String& strRef)
{
int iTot=strRef.iLen+this->iLen;
if(iTot>this->iCapacity)
{
    int iNewSize=(iTot*EXPANSION_FACTOR/16+1)*16;
    TCHAR* pNew=new TCHAR[iNewSize];
    _tcscpy(pNew,this->lpBuffer);
    delete [] this->lpBuffer;
    this->lpBuffer=pNew;
    _tcscat(pNew,strRef.lpBuffer);
    this->iCapacity=iNewSize-1;
    this->iLen=iTot;
}
else
{
    _tcscat(this->lpBuffer,strRef.lpBuffer);
    this->iLen=iTot;
}
return *this;
}


bool String::operator==(String& strRef)
{
if(_tcscmp(this->lpStr(),strRef.lpStr())==0)
    return true;
else
    return false;
}


bool String::operator==(const TCHAR* pStr)
{
if(_tcscmp(this->lpStr(),pStr)==0)
    return true;
else
    return false;
}


String& String::Make(const TCHAR ch, int iCount)    //Creates (Makes) a String with iCount TCHARs
{
if(iCount>this->iCapacity)
{
    delete [] lpBuffer;
    int iNewSize=(iCount*EXPANSION_FACTOR/16+1)*16;
    this->lpBuffer=new TCHAR[iNewSize];
    this->iCapacity=iNewSize-1;
}
for(int i=0; i<iCount; i++)
     this->lpBuffer[i]=ch;
this->lpBuffer[iCount]=0;
this->iLen=iCount;
return *this;
}


String String::Left(int iNum)   //  strncpy = _tcsncpy
{
if(iNum<this->iLen)
{
    int iNewSize=(iNum*EXPANSION_FACTOR/16+1)*16;
    String sr(iNewSize,false);
    _tcsncpy(sr.lpBuffer,this->lpBuffer,iNum);
    sr.lpBuffer[iNum]=0;
    sr.iLen=iNum;
    return sr;
}
else
{
    String sr=*this;
    return sr;
}
}


String String::Right(int iNum)  //Returns Right$(strMain,iNum)
{
if(iNum<this->iLen)
{
    int iNewSize=(iNum*EXPANSION_FACTOR/16+1)*16;
    String sr(iNewSize,false);
    _tcsncpy(sr.lpBuffer,this->lpBuffer+this->iLen-iNum,iNum);
    sr.lpBuffer[iNum]=_T('\0');
    sr.iLen=iNum;
    return sr;
}
else
{
    String sr=*this;
    sr.iLen=this->iLen;
    return sr;
}
}


String String::Mid(int iStart, int iCount)
{
if(iStart<1)
{
    String sr;
    return sr;
}
if(iCount+iStart>this->iLen)
    iCount=this->iLen-iStart+1;
String sr(iCount,false);
_tcsncpy(sr.lpBuffer,this->lpBuffer+iStart-1,iCount);
sr.lpBuffer[iCount]=_T('\0');
sr.iLen=iCount;

return sr;
}


String String::Replace(TCHAR* pMatch, TCHAR* pNew)  //strncmp = _tcsncmp
{
int i,iLenMatch,iLenNew,iCountMatches,iExtra,iExtraLengthNeeded,iAllocation,iCtr;
iLenMatch=_tcslen(pMatch);
iCountMatches=0, iAllocation=0, iCtr=0;
iLenNew=_tcslen(pNew);
if(iLenNew==0)
{
    String sr=this->Remove(pMatch,true); //return
    return sr;
}
else
{
    iExtra=iLenNew-iLenMatch;
    for(i=0; i<this->iLen; i++)
    {
        if(_tcsncmp(lpBuffer+i,pMatch,iLenMatch)==0)
           iCountMatches++;  //Count how many match strings
    }
    iExtraLengthNeeded=iCountMatches*iExtra;
    iAllocation=this->iLen+iExtraLengthNeeded;
    String sr(iAllocation,false);
    for(i=0; i<this->iLen; i++)
    {
        if(_tcsncmp(this->lpBuffer+i,pMatch,iLenMatch)==0)
        {
           _tcscpy(sr.lpBuffer+iCtr,pNew);
           iCtr+=iLenNew;
           i+=iLenMatch-1;
        }
        else
        {
           sr.lpBuffer[iCtr]=this->lpBuffer[i];
           iCtr++;
        }
        sr.lpBuffer[iCtr]=_T('\0');
    }
    sr.iLen=iCtr;
    return sr;
}
}


String String::Remove(TCHAR* pStr)
{
unsigned int i,j,iStrLen,iParamLen;
TCHAR *pThis, *pThat, *p;
bool blnFoundBadTCHAR;

iStrLen=this->iLen;               //The length of this
String sr((int)iStrLen,false);    //Create new String big enough to contain original String (this)
iParamLen=_tcslen(pStr);          //Get length of parameter (pStr) which contains TCHARs to be removed
pThis=this->lpBuffer;
p=sr.lpStr();
for(i=0; i<iStrLen; i++)
{
     pThat=pStr;
     blnFoundBadTCHAR=false;
     for(j=0; j<iParamLen; j++)
     {
         if(*pThis==*pThat)
         {
            blnFoundBadTCHAR=true;
            break;
         }
         pThat++;
     }
     if(!blnFoundBadTCHAR)
     {
        *p=*pThis;
         p++;
        *p=_T('\0');
     }
     pThis++;
}
sr.iLen=_tcslen(sr.lpStr());

return sr;
}


String String::Remove(const TCHAR* pMatch, bool blnCaseSensitive)
{
int i,iCountMatches=0,iCtr=0;

int iLenMatch=_tcslen(pMatch);
for(i=0; i<this->iLen; i++)
{
     if(blnCaseSensitive)
     {
        if(_tcsncmp(lpBuffer+i,pMatch,iLenMatch)==0)  //_tcsncmp
           iCountMatches++;
     }
     else
     {
        if(_tcsnicmp(lpBuffer+i,pMatch,iLenMatch)==0) //__tcsnicmp
           iCountMatches++;
     }
}
int iAllocation=this->iLen-(iCountMatches*iLenMatch);
String sr(iAllocation,false);
for(i=0; i<this->iLen; i++)
{
     if(blnCaseSensitive)
     {
        if(_tcsncmp(this->lpBuffer+i,pMatch,iLenMatch)==0)
           i+=iLenMatch-1;
        else
        {
           sr.lpBuffer[iCtr]=this->lpBuffer[i];
           iCtr++;
        }
        sr.lpBuffer[iCtr]=_T('\0');
     }
     else
     {
        if(_tcsnicmp(this->lpBuffer+i,pMatch,iLenMatch)==0)
           i+=iLenMatch-1;
        else
        {
           sr.lpBuffer[iCtr]=this->lpBuffer[i];
           iCtr++;
        }
        sr.lpBuffer[iCtr]=_T('\0');
     }
}
sr.iLen=iCtr;
return sr;
}


int String::ParseCount(const TCHAR c)  //returns one more than # of
{                                      //delimiters so it accurately
int iCtr=0;                           //reflects # of strings delimited
TCHAR* p;                             //by delimiter.

p=this->lpBuffer;
while(*p)
{
  if(*p==c)
     iCtr++;
  p++;
}

return ++iCtr;
}


void String::Parse(String* pStr, TCHAR delimiter)
{
unsigned int i=0;
TCHAR* pBuffer=0;
TCHAR* c;
TCHAR* p;

pBuffer=new TCHAR[this->iLen+1];
if(pBuffer)
{
    pBuffer[0]=0, p=pBuffer;
    c=this->lpBuffer;
    while(*c)
    {
       if(*c==delimiter)
       {
          pStr[i]=pBuffer,  p=pBuffer;
          i++,              pBuffer[0]=0;
       }
       else
       {
          *p=*c,  p++;
          *p=0;
       }
       c++;
    }
    pStr[i]=pBuffer;
    delete [] pBuffer;
}
}


int String::InStr(const TCHAR* pStr, bool blnCaseSensitive)
{
int i,iParamLen,iRange;

if(*pStr==0)
    return 0;
iParamLen=_tcslen(pStr);
iRange=this->iLen-iParamLen;
if(iRange>=0)
{
    for(i=0;i<=iRange;i++)
    {
        if(blnCaseSensitive)
        {
           if(_tcsncmp(lpBuffer+i,pStr,iParamLen)==0)   //_tcsncmp
              return i+1;
        }
        else
        {
           if(_tcsnicmp(lpBuffer+i,pStr,iParamLen)==0)  //__tcsnicmp
              return i+1;
        }
    }
}

return 0;
}


int String::InStr(const String& s, bool blnCaseSensitive)
{
int i,iParamLen,iRange;

if(s.iLen==0)
    return 0;
iParamLen=s.iLen;
iRange=this->iLen-iParamLen;
if(iRange>=0)
{
    for(i=0; i<=iRange; i++)
    {
        if(blnCaseSensitive)
        {
           if(_tcsncmp(this->lpBuffer+i,s.lpBuffer,iParamLen)==0)  //_tcsncmp
              return i+1;
        }
        else
        {
           if(_tcsnicmp(this->lpBuffer+i,s.lpBuffer,iParamLen)==0) //__tcsnicmp
              return i+1;
        }
    }
}

return 0;
}


void String::LTrim()
{
int iCt=0;

for(int i=0; i<this->iLen; i++)
{
     if(this->lpBuffer[i]==32 || this->lpBuffer[i]==9)
        iCt++;
     else
        break;
}
if(iCt)
{
    for(int i=iCt; i<=this->iLen; i++)
        this->lpBuffer[i-iCt]=this->lpBuffer[i];
}
this->iLen=this->iLen-iCt;
}


void String::RTrim()
{
int iCt=0;

for(int i=this->iLen-1; i>0; i--)
{
     if(this->lpBuffer[i]==9||this->lpBuffer[i]==10||this->lpBuffer[i]==13||this->lpBuffer[i]==32)
        iCt++;
     else
        break;
}
this->lpBuffer[this->iLen-iCt]=0;
this->iLen=this->iLen-iCt;
}


void String::Trim()
{
this->LTrim();
this->RTrim();
}


int String::iVal()
{
return _ttoi(this->lpBuffer);  //_ttoi
}


int String::Len(void)
{
return this->iLen;
}


int String::Capacity(void)
{
return this->iCapacity;
}


TCHAR* String::lpStr()
{
return lpBuffer;
}


void String::Print(bool blnCrLf)
{
_tprintf(_T("%s"),lpBuffer);
if(blnCrLf)
    _tprintf(_T("\n"));
}


String::~String()   //String Destructor
{
delete [] lpBuffer;
lpBuffer=0;
}


     Pretty lot of code, isn't it?  Well, you can't really do much without a string class in C++, so I had to post all that.  Hopefully you've been able to run the program a few times to get a feel for it.  Anyway, getting back to our topic of eliminating global variables, look up in fnWndProc_OnCreate().  You'll see these two lines...

Code Select Expand


CoCreateInstance(CLSID_FHGrid,NULL,CLSCTX_INPROC_SERVER,IID_IFHGrid,(void**)&pGrid);
SetWindowLong(Wea->hWnd,0,(long)pGrid);


What CoCreateInstance() does is about like NewCom() in PowerBASIC – it creates an object from a Clsid.  If successful the call will return the grid interface pointer in pGrid.  Right after CoCreateInstance() is a call to SetWindowLong() which stores the pGrid pointer at offset zero in the instantiated window's structure.  To elaborate on this a bit, when my main window class was registered down in WinMain() I specified the class name for the program's main window as "AxGridTrial"...

Code Select Expand


TCHAR szClassName[]=_T("AxGridCtrl");     


Then I specified 16 extra .cbWndExtra bytes in the class structure that will apply to each instance of a window created...

Code Select Expand


wc.cbWndExtra=16;


This little blurb from fnWndProc_OnCreate() shows what my intentions were in terms of storing grid related data in the instance data...

Code Select Expand


//Offset   What's Stored There
//=======================================
//0  -  3  pGrid
//4  -  7  pConnectionPointContainer
//8  - 11  pConnectionPoint
//12 - 15  dwCookie


     So there you can see we stored our pGrid pointer at offset zero.  There were formerly four global pieces of data that we are now associating with the window, so all four of these variables are local to fnWndProc_OnCreate(), and these variables will go out of scope and be destroyed when this procedure terminates.  Its critical to realize though that although these variables have been destroyed, their former contents live on and are still valid in their storage in the .cbWndExtra bytes.  In terms of reference counting, QueryInterface calls were made on the COM object "FHGrid4.Grid" and we racked up a total tally of three AddRef()s within the grid dll.  Here is some output from a program run.  Note specifically that about three quarters of the way down, after fnWndProc_OnCreate() terminates, our reference count on pGrid is 3 – one AddRef() for pGrid, one AddRef() for pConnectionPointContainer, and one for pConnectionPoint...

Code Select Expand


@pGrid.m_cRef =  3  << After


continued....

[Frederick J. Harris]

....continued

Here's the program run...

Code Select Expand


Entering fnWndProc_OnCreate()
  Wea->hWnd = 1245844
  CoInitialize() Succeeded!

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

  Entering IClassFactory_CreateInstance()
    pGrid                      =  2455792
    Varptr(@pGrid.lpIGridVtbl) =  2455792
    Varptr(@pGrid.lpICPCVtbl)  =  2455796
    Varptr(@pGrid.lpICPVtbl)   =  2455800
    @pGrid.pISink              =  2455928
    @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 =  2455792
    Leaving IGrid_QueryInterface()
    @ppv                       =  2455792  << After QueryInterface() Call
    Entering Initialize() -- Initialize()
      GetModuleHandle()        =  10813440
    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 =  2455792
  Leaving IGrid_QueryInterface()

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

  CoCreateInstance() Succeeded! -- pGrid = 2455792

  Entering IGrid_CreateGrid()
    this           =  2455792
    hContainer     =  1245844
    strSetup       =  120:Column 1:^,130:Column 2:^,140:Column 3:^,150:Column 4:^,160:Column 5:^
    x              =  10
    y              =  10
    cx             =  570
    cy             =  218
    iRows          =  12
    iCols          =  5
    iRowHt         =  28
    strFontName    =  Times New Roman
    GetLastError() =  0
    hGrid          =  262782
    pGridData      =  2384784
  Leaving IGrid_CreateGrid()

  pGrid->Create() Succeeded!

  Entering IGrid_QueryInterface()
    Trying To Get IConnectionPointContainer
    this =  2455792
    Entering IConnectionPointContainer_AddRef()
      @pGrid.m_cRef =  1  << Before
      @pGrid.m_cRef =  2  << After
    Leaving IConnectionPointContainer_AddRef()
    this =  2455796
  Leaving IGrid_QueryInterface()

  Got pConnectionPointContainer = 2455796

  Entering IConnectionPointContainer_FindConnectionPoint()
    this  =  2455796
    @ppCP =  0
    Entering IConnectionPointContainer_QueryInterface()
      Looking For IID_IConnectionPoint
      Entering IConnectionPoint_AddRef()
        @pGrid.m_cRef =  2  << Before
        @pGrid.m_cRef =  3  << After
      Leaving IConnectionPoint_AddRef()
    Leaving IConnectionPointContainer_QueryInterface()
    @ppCP =  2455800
  Leaving IConnectionPointContainer_FindConnectionPoint()

  Got pConnectionPoint = 2455800
 
  Entering CSink Constructor!
    this = 9775240
  Leaving CSink Constructor!

  mySink = 9775240

  Entering IConnectionPoint_Advise()!  Grab Your Hardhat And Hang On Tight!
    this               =  2455800
    pGrid              =  2455792
    @pGrid.hControl    =  262782
    pUnkSink           =  9775240
    Vtbl               =  4233152
    @Vtbl[0]           =  4203056
    Entering CSink::QueryInterface() -- this = 9775240
      Client: CSink::QueryInterface() for IID_IFHGrid_Events  -- this = 9775240
      *ppv = 9775240
    Leaving CSink::QueryInterface(): this = 9775240
    dwPtr           =  9775240
    Call Dword Succeeded!
    0     2455928     0  Found Open Slot!
    Will Be Able To Store Connection Point!
  Leaving IConnectionPoint_Advise() And Still In One Piece!

  pConnectionPoint->Advise() Succeeded!

  1,1
  1,2
  1,3
  1,4
  1,5
  2,1
   ...
   ...
  9,4
  9,5
  10,1
  10,2
  10,3
  10,4
  10,5

Leaving fnWndProc_OnCreate()


Entering CSink::Grid_OnLButtonDown()
  CSink::Grid_OnLButtonDown: iRow = 2   iCol = 2
Leaving CSink::Grid_OnLButtonDown()

Entering CSink::Grid_OnKeyDown()
  CSink::Grid_OnKeyDown is 46
Leaving CSink::Grid_OnKeyDown()

Entering CSink::Grid_OnKeyDown()
  CSink::Grid_OnKeyDown is 46
Leaving CSink::Grid_OnKeyDown()

Entering CSink::Grid_OnKeyDown()
  CSink::Grid_OnKeyDown is 46
Leaving CSink::Grid_OnKeyDown()

Entering CSink::Grid_OnKeyDown()
  CSink::Grid_OnKeyDown is 46
Leaving CSink::Grid_OnKeyDown()

Entering CSink::Grid_OnKeyDown()
  CSink::Grid_OnKeyDown is 46
Leaving CSink::Grid_OnKeyDown()

Entering CSink::Grid_OnKeyDown()
  CSink::Grid_OnKeyDown is 70
Leaving CSink::Grid_OnKeyDown()

Entering CSink::Grid_OnKeyPress()
  CSink::Grid_OnKeyPress is 102
Leaving CSink::Grid_OnKeyPress()

Entering CSink::Grid_OnKeyDown()
  CSink::Grid_OnKeyDown is 82
Leaving CSink::Grid_OnKeyDown()

Entering CSink::Grid_OnKeyPress()
  CSink::Grid_OnKeyPress is 114
Leaving CSink::Grid_OnKeyPress()

Entering CSink::Grid_OnKeyDown()
  CSink::Grid_OnKeyDown is 69
Leaving CSink::Grid_OnKeyDown()

Entering CSink::Grid_OnKeyPress()
  CSink::Grid_OnKeyPress is 101
Leaving CSink::Grid_OnKeyPress()

Entering CSink::Grid_OnKeyDown()
  CSink::Grid_OnKeyDown is 68
Leaving CSink::Grid_OnKeyDown()

Entering CSink::Grid_OnKeyPress()
  CSink::Grid_OnKeyPress is 100
Leaving CSink::Grid_OnKeyPress()

Entering fnWndProc_OnCommand()
  pGrid->GetData() Succeeded!
  strCell = fred
Leaving fnWndProc_OnCommand()

Entering fnWndProc_OnCommand()
  Entering DestroyGrid()
    Entering IConnectionPoint_Unadvise()
      this            =  2455800
      dwCookie        =  0
      @pGrid.hWndCtrl =  262782
      dwPtr           =  9775240
      Entering CSink::Release()
        this = 9775240
        m_cRef == 0 And Will Now Delete CSink!
        Entering CSink Destructor!
          this = 9775240
        Leaving CSink Destructor!
      Leaving CSink::Release()
      IGrid_Events::Release() Succeeded!
      Release() Returned  0
    Leaving IConnectionPoint_Unadvise()

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

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

    Entering IGrid_Release()
      @pGrid.m_cRef =  1  << Before
      0     2455928     0
      1     2455932     0
      2     2455936     0
      3     2455940     0
      @pGrid.m_cRef = 0   << After
      Grid Was Deleted!
    Leaving IGrid_Release()
  Leaving DestroyGrid()
Leaving fnWndProc_OnCommand()


Entering fnWndProc_OnDestroy()
  Entering DestroyGrid()
    IConnectionPoint* Apparently Released!
    IConnectionPointContainer* Apparently Released!
    IGrid* Apparently Released!
  Leaving DestroyGrid()

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


     There is a 'RULE' you should be aware of.  Its a RULE whose basis is in object lifetime management, which is an important concept.  The RULE states that when an interface pointer is copied by a client, the client is responsible for calling AddRef() on it.  For example, CoCreateInstance, if successful, will hand out to you an interface pointer upon which QueryInterface() within the COM server called AddRef().  So at that point you have a reference count of 1.  If in your client code you have these variable declarations...

IUnknown* pUnk1;  //this is C code!
IUnknown* pUnk2;

...and your CoCreateInstance() call initialized pUnk1, then at the point you do this...

pUnk2 = pUnk1;

...then, by the rules of QueryInterface you need to call pUnk2->AddRef() right after the point of assignment or copy.  The reference count then becomes 2 on the object instance, and its methods can be called from either pointer.  Upon finishing with the pointers you then have two Release() calls to make.  Don't forger we're talking C or C++ here - not PowerBASIC.  We'll get to that in a bit.

     The reason for all this is to correctly manage object lifetime.  If you mess it up your app is pretty much shot.  You'll either have memory leaks, crashes, or both.  Crashes will come from the server prematurely unloading the dll while you are still holding on to interface pointers you think are still valid.  Memory leaks will come from the object failing to call clean up code and release itself because its still holding on to reference counts which you never released. 

     Having said all that, let me ask you a question.  Do you think my assignment of my pGrid interface pointer to offset zero within the .cbWndExtra bytes of the class instance structure constitutes an interface copy operation requiring an AddRef() call on it per the QueryInterface() rules I stipulated?  If you answered 'Yes' you are correct.  However, if you examine the code you see I didn't do it.  Also, if an AddRef() should have been called on pGrid then logic dictates it should also apply to pConnectionPointContainer and pConnectionPoint too!

     My excuse for not doing it is another interesting COM concept known as (you guessed it, there's a name for it!) 'Reference Counting Optimization'.  The idea is as follows.  If the logic of an application is so simple that there is no danger of a reference counting foul up, then just ignore calling AddRef() followed by immediate Release() calls in the name of simplicity and perhaps sanity.  For example, in our relatively simple client we are just storing three interface pointers in a WM_CREATE handler and releasing those same three in a WM_DESTROY handler.  There isn't any conditional branch logic anywhere where interface pointers are being passed as parameters to other functions, and those functions passing them to still other functions, which depending on conditions at the time, may or may not do various things with them affecting object lifetimes.  So its a matter of making a judgment in the app you are developing whether or not you can safely get away with it without wrecking havoc upon yourself.  In the code I posted I got away with it just fine.  When you get to PowerBASIC though, you are likely going to have to at least understand this.

     Lets now turn to a PowerBASIC example of the same thing.  But lets look first at some problems we are going to run into right away in attempting to do what I did in the C++ program above.  Remember, we started with these two lines...

Code Select Expand


CoCreateInstance(CLSID_FHGrid,NULL,CLSCTX_INPROC_SERVER,IID_IFHGrid,(void**)&pGrid);
SetWindowLong(Wea->hWnd,0,(long)pGrid);


In PowerBASIC, we would like to code it this way...

Code Select Expand


Let pGrid = NewCom "FHGrid4.Grid"
Call SetWindowLong(Wea.hWnd, 0, pGrid)


     Let me gently break the first piece of bad news.  That won't compile.  PowerBASIC won't allow you to put an interface pointer in the 3rd parameter of a SetWindowLong() Api function call which function call requires a Long instead.  This can actually be solved fairly easily; PowewBASIC has the Objptr() function to retrieve an address out of an interface pointer, so you can try this instead...

Code Select Expand


Let pGrid = NewCom "FHGrid4.Grid"
Call SetWindowLong(Wea.hWnd, 0, Objptr(pGrid))


     That will work as far as that goes, but it doesn't end your problems by any means.  Getting it in is only half the battle.  You also have to be able to get it out where you need it and be able to use it there.  The getting it out part isn't too bad but the making use of it part is a real killer.  Recall in our C++ app above part of the user interface involved a button that when clicked would retrieve the contents out of the grid in Row 3, Column 2?  Here is the pertinent code for that...
   

Code Select Expand


IGrid* pGrid=(IGrid*)GetWindowLong(Wea->hWnd,0);       //Retrieve interface pointer from instance memory
pGrid->FlushData();                                    //If data is in edit control, flush it back to grid memory                         
BSTR strCell=SysAllocString(L"");                      //Do a C++ thing to allocate a BSTR
pGrid->GetData(3,2,&strCell);                          //Do interface member call to retrieve Cell (3,2)
MessageBox(Wea->hWnd,strCell,_T("Cell (3,2)"),MB_OK);  //Show it in a message box
SysFreeString(strCell);                                //Release the BSTR memory


To implement that in PowerBASIC, which has such nice String functions, we would like to do something like this...

Code Select Expand


Local pGrid As IGrid
Local strData As WString

pGrid=GetWindowLong(Wea.hWnd,0)
pGrid.FlushData()
strData=pGrid.GetData(3,2)
MsgBox("Cell 3,2 Contains " & strData)


     Boy, how I hate to break the bad news!  As logical as that all looks, it won't even close to work!  PowerBASIC will absolutely and unconditionally refuse to allow you to initialize the pGrid object variable that way.  It provides the NewCom(), AnyCom(), and GetCom() functions for that, and GetWindowLong() isn't in that list.  You can holler and scream all you like.  If it makes you feel better you can even output the address held in the interface pointer up in WM_CREATE before you stored it using SetWindowLong(), and you can check it out against what is coming out of GetWindowLong() in the WM_COMMAND button click handler to be sure they are the same, and they will be.  But you won't be able to assign it back into another local IGrid object variable using the equal sign.  And don't even think about using GetCom, because that won't work with in process servers.

     If you are thinking this is bad - you are right.  However, if you are suspecting there might still be a way to do it, you are right again (or I wouldn't be writing this, would I?). 

     I'm sure at some point in the past you've used the PowerBASIC VariantVt function.  If you check out the PowerBASIC Help file on VariantVt it lists all the types of variables which can be held in a Variant, and several of them are objects of one form or another.  In particular though, it can hold a generic interface pointer in the form of IUnknown.  One should hopefully be able to assume then that if PowerBASIC allows one to store an interface pointer in a variant, it will allow one to reassign it to an object variable when one takes it out.  Indeed, this is the case.  So, before I present a full working program showing this, let me describe how it works.

     First, one must allocate a local variant into which the interface pointer is going to be stored.  However, a simple local variant won't work, because we are now going to have to store the address of the variant in the window's .cbWndExtra bytes instance data, and a locally allocated variable will also go out of scope too after our WM_CREATE handler exits.  So what we are going to have to do is allocate a variant dynamically, or on the heap or free store, using a memory allocation function, and we are going to have to store the interface pointer in that using pointer notation, i.e.,

Code Select Expand


Local pVnt As Variant Ptr                     'Allocate a local Variant Pointer
Local pGrid As IGrid                          'Allocate a local interface pointer

pVnt=GlobalAlloc(%GPTR,16)                    'The size of a Variant is 16 bytes - allocate a pointer to a 16 byte chunk
If pVnt Then                                  '
   Let pGrid = NewCom "FHGrid4.Grid"          'Create the COM Object, and get your 1st pointer to it.
   @pVnt=pGrid                                'Use pointer notation to assign it to your Variant memory block
   Call SetWindowLong(Wea.hWnd,0,pVnt)        'Store the Variant ptr in .cbWndExtra bytes.  The memory block the pointer is pointing
Else                                          'to contains the pGrid interface pointer
   MsgBox("Memory Allocation Failure!!!")
   Function=-1 : Exit Function
End If


    There's more!  Recall above I discussed the issue with reference counting vis a vis copying interface pointers?  Well, PowerBASIC will recognize the assignment above as an interface pointer assignment, and will do an AddRef() on pGrid when it is assigned to the Variant memory block.  This AddRef() will increment the reference count on pGrid to 2, so that when the local pGrid goes out of scope at the termination of the WM_CREATE handler, the reference count will fall only to 1 - not zero, and the object stored in the .cbWndExtra bytes will stay alive - for further use elsewhere, which is the point of all this.

     Of course, the above code (or its equivalent) will be in our WM_CREATE handler.  In every procedure where we need to retrieve the pGrid interface pointer we are going to have to use GetWindowLong() to retrieve first the Variant Ptr, then retrieve the interface pointer out of the variant memory block.  PowerBASIC will recognize all this copying and retrieval of interface pointers for what it is, and automatically handle all reference counting.  Here then is PBClient4_v4.bas which demonstrates this functionality.  Right afterwards I'll provide the console output from the running of this program with debug output statements included.  The source code has a duplicated version remarked out underneath it which has the debug output statements included, so you can run it and produce your own output if you want to demonstrate to yourself that its working as I state)...

continued....

[Frederick J. Harris]

Code Select Expand


'PBClient4_v4.bas        'Uses Jose's Declares         'This program takes a crack at eliminating global object variables
#Compile                 Exe  "PBClient4_v4.exe"       'like we've been using up to this point in all these programs.
#Dim                     All  'Uses PBWin 10.02        'This is one area that is actually easier to do in C or C++ than in
%UNICODE                 = 1                           'PowerBASIC.  The source of the difficulty in PowerBASIC is its
#If %Def(%UNICODE)                                     'automatic reference counting.  For example, so far we've had a
    Macro ZStr           = WStringz                    'globally allocated IGrid interface pointer.  If we allocate it
    Macro BStr           = WString                     'locally, it will go out of scope and be released by PowerBASIC
    %SIZEOF_CHAR         = 2                           'after our WM_CREATE message handler exits.  Typically, to make a
#Else                                                  'variable persist across invocations of functions, one stores the
    Macro ZStr           = Asciiz                      'variable's value in Windows memory allocated through .cbWndExtra
    Macro BStr           = String                      'bytes, or Windows Properties, i.e., Get/SetProp().  We can do this
    %SIZEOF_CHAR         = 1                           'here, but we need to first call pGrid.AddRef() on the interface...
#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                        '...pointer so that the object itself doesn't get destroyed if the
#Include                 "Windows.inc"                 'pGrid.Release() call PowerBASIC makes at the exit of the WM_CREATE
#Include                 "ObjBase.inc"                 'handler causes its reference count to fall to zero.  Sad to say,
                                                       'that isn't the only problem; there's another one that's even worse.
Type WndEventArgs                                      'To begin with, even if you use Objptr() to assign the address of
  wParam                 As Long                       'the object variable within storage in the .cbWndExtra bytes, you
  lParam                 As Long                       'won't be able to easily retrieve that value and assign it back into
  hWnd                   As Dword                      'another locally allocated object variable.  PowerBASIC simply
  hInst                  As Dword                      'won't allow it.  You'll get a compile error.  One way around this
End Type                                               'is to store the object variable, i.e., interface pointer, in a
                                                       'variant.  There are two object types in the variant union; IDispatch
Declare Function FnPtr(wea As WndEventArgs) As Long    'and IUnknown.  Of course, to do this it won't do any good to
                                                       'create a local variant, because it would go out of scope too.  So
Type MessageHandler                                    'you need to do a memory allocation for 16 bytes, which is the size
  wMessage               As Long                       'of a variant, and use pointer notation to store the interface
  dwFnPtr                As Dword                      'pointer in the variant.  Then you store the memory allocation in
End Type                                               'the Window Class Instance or Window Properties.  The added benifit
Global MsgHdlr()         As MessageHandler             'of this is that the PowerBASIC Compiler recognizes this operation
                                                       'as an interface copy, and by the RULES of COM and QueryInterface()
                                                       'it automatically does an AddRef() on the interface pointer so that
Interface IGrid $IID_IFHGrid : Inherit IAutomation     'when the locally defined one goes out of scope, the object won't
  Method CreateGrid _                                  'be destroyed/released as it would if its reference count fell to
  ( _                                                  'zero.  But alas, you still have to deal with the hassle of allo-
    Byval hParent     As Long, _                       'cating the memory for the Variant, and releasing it when done. All
    Byval strSetup    As WString, _                    'in all, it isn't pretty.
    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 pVnt As Variant Ptr                                                       '8  - 11     IConnectionPointContainer Ptr - pConnectionPointContainer
  Local EventGuid As Guid                                                         '12 - 15     Connection Cookie             - dwCookie
  Local dwCookie As Dword
  Local pGrid As IGrid                                                            'According to the 'Rules' of QueryInterface(), the copying of an interface pointer
  Local hCtl As Dword                                                             'requires that an AddRef() call be done on it.  Consider that when QueryInterface()
  Register i As Long                                                              'is called successfully and returns an interface pointer to the caller, an AddRef()
  Register j As Long                                                              'has already been done on it, and its the caller's responsibility to Release() it.
                                                                                  'In using C or C++ this must be done manually, but PowerBASIC handles these details
  pCreateStruct=wea.lParam                                                        'itself.  One of several possible ways to store an interface pointer returned by
  Wea.hInst=@pCreateStruct.hInstance                                              'PowerBASIC in a Window's internal storage, i.e., in .cbWndExtra bytes, or in Window
  Let pGrid = NewCom "FHGrid4.Grid"                                               'Properties, is to allocate memory for a Variant, and store the interface pointer in
  pVnt=GlobalAlloc(%GPTR, 16)                                                     'the Variant.  To see this being done, look exactly left << from here in the source
  @pVnt=pGrid                                                                     'code.  Variants can store IDispatch and generic object pointers as IUnknown.
  Call SetWindowLong(Wea.hWnd,0,pVnt)                                             'However, the PowerBASIC compiler will recognize an expression such as @pVnt=pGrid
  strSetup= _                                                                     'as an interface pointer copy operation, and will do an AddRef() on it just as the
  "120:Column 1:^,130:Column 2:^,140:Column 3:^,150:Column 4:^,160:Column 5:^"    'RULES for QueryInterface dictate. Think about it for a moment.  If all of the
  pGrid.CreateGrid(Wea.hWnd,strSetup,10,10,570,222,25,5,20,"",18,%FW_DONTCARE)    'interface pointers are locally allocated such as in this program, PowerBASIC -
  pConnectionPointContainer = pGrid                                               'whose goal is to relieve the coder of the tedium of reference counting, is going
  pVnt=GlobalAlloc(%GPTR, 16)                                                     'to have to automatically call a Release() on any local interface variables when
  @pVnt=pConnectionPointContainer                                                 'they go out of scope.  So if one's goal is to preserve the life of an interface
  Call SetWindowLong(Wea.hWnd,8,pVnt)                                             'variable by obtaining it and storing it in Window Properties or .cbWndExtra bytes,
  EventGuid=$IID_IGridEvents                                                      'then an AddRef() is going to have to be done on it when it is stored in the
  Call pConnectionPointContainer.FindConnectionPoint _                            'variant pointer that is actually going to be stored.  At that point the reference
  ( _                                                                             'count on the object will be 2, and when the local object goes out of scope and a
    Byval Varptr(EventGuid), _                                                    'Release() is called on it, it will decrease to 1, i.e., the one being stored.
    Byval Varptr(pConnectionPoint) _                                              'That may be all that is necessary to keep the object alive, and the COM Dll in
  )                                                                               'memory.  So as you can see (or will soon see), the elimination of global variables
  pVnt=GlobalAlloc(%GPTR, 16)                                                     'if they be object variables (interface pointers) tends to get a bit tricky in
  @pVnt=pConnectionPoint : Call SetWindowLong(Wea.hWnd,4,pVnt)                    'PowerBASIC.  Likely one of the few things that's easier to do in C or C++.  The
  Let pSink = Class  "CGridEvents"                                                'basic procedure is going to require you to dimension a local Variant Ptr, allocate
  Call pConnectionPoint.Advise(Byval Objptr(pSink), dwCookie)                     '16 bytes to point the pointer at, then assign the interface pointer to the Variant
  Call SetWindowLong(Wea.hWnd,12,dwCookie)                                        'memory.  At that point you'll then be able to store the Variant Pointer wherever
  For i=1 To 25                                                                   'and however you want, and the AddRef() PowerBASIC does on the interface copy will
    For j=1 To 5                                                                  'keep the object alive when PowerBASIC calls Release() on the locally dimensioned
      strCoordinate="(" & Trim$(Str$(i)) & "," & Trim$(Str$(j)) & ")"             'interface pointer. Also, only through the use of this technique will it be possible
      pGrid.SetData(i, j, strCoordinate)                                          'to re-assign the interface pointer held in the variant back into another object
    Next j                                                                        'variable in another procedure.  If you are laboring under the assumption that you
  Next i                                                                          'can bypass all this hassle and just store an interface pointer in .cbWndExtra bytes
  pGrid.Refresh()                                                                 'and in some other procedure copy it back into another object variable - well, I
  hCtl=CreateWindow _                                                             'recommend you just try it once and see how far you get!  Actually, there is a way
  ( _                                                                             'to do it, but its tricky!
    "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)                             'If you've decided to use the Variant approach to eliminating
  Local pConnectionPointContainer As IConnectionPointContainer   'globally allocated object variables from your PowerBASIC COM
  Local pConnectionPoint As IConnectionPoint                     'programs, then in any procedure where you wish to retrieve an
  Local pVnt As Variant Ptr                                      'object variable you'll do as just left where you see the
  Local dwCookie As Dword                                        'Variant Ptr being retrieved in this case from .cbWndExtra bytes
  Local pGrid As IGrid                                           'and used in a normal fashion.  Be aware though that PowerBASIC
 
  dwCookie=GetWindowLong(Wea.hWnd,12)                            'is doing an AddRef() on your object variable when it assigns
  pVnt=GetWindowLong(Wea.hWnd,4)                                 'it back into a locally allocated object.  The logic is somewhat
  If pVnt Then                                                   'tricky in this case just left because its the job of DestroyGrid()
     pConnectionPoint=@pVnt                                      'to destroy the grid, and it looks like the three .Release() calls
     Call pConnectionPoint.Unadvise(dwCookie)                    'are doing just that.  But what is actually happening is that the
     Call pConnectionPoint.Release()                             'reference count on FHGrid4.Grid will be 3 coming into this
     Call SetWindowLong(Wea.hWnd,4,0)                            'procedure from the allocation and storage of an IGrid Ptr, an
     Call GlobalFree(pVnt)                                       'IConnectionPointContainer Ptr and a IConnectionPoint Ptr in
  End If                                                         'fnWndProc_OnCreate().  But when this procedure runs the reference
  pVnt=GetWindowLong(Wea.hWnd,8)                                 'count will increment from 3 to 4 three times as PowerBASIC does
  If pVnt Then                                                   'its 'hidden' AddRef() when each pointer is retrieved from the
     pConnectionPointContainer=@pVnt                             '.cbWndExtra bytes of the Window Class Instance.  So when this
     Call pConnectionPointContainer.Release()                    'procedure finally exits, the reference count will still be 3 in
     Call SetWindowLong(Wea.hWnd,8,0)                            'spite of the 3 .Release() calls (they were counterbalanced by the
     Call GlobalFree(pVnt)                                       '3 hidden AddRefs).  However, when the procedure exits PowerBASIC
  End If                                                         'will clean up the stack and call three more Releases on the 3
  pVnt=GetWindowLong(Wea.hWnd,0)                                 'local interface pointers.  That is what will drive the reference
  If pVnt Then                                                   'count on the object down to zero and force its destruction in
     pGrid=@pVnt                                                 'memory.  So yes, it does what it looks like, but be aware of the
     Call pGrid.Release()                                        'circuitous route it follows to do so.  Also note that the three
     Call SetWindowLong(Wea.hWnd,0,0)                            'variant pointer memory allocations need to be cleaned up so as
     Call GlobalFree(pVnt)                                       'to prevent a memory leak.
  End If
End Sub


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

  Select Case As Long Lowrd(Wea.wParam)
    Case %IDC_RETRIEVE
      pVnt=GetWindowLong(Wea.hWnd,0)
      pGrid=@pVnt
      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 Of Above
''PBClient4_v4.bas
'#Compile                 Exe  "PBClient4_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
'
'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
'
'
'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 pVnt As Variant Ptr                                      '8  - 11     IConnectionPointContainer Ptr - pConnectionPointContainer
'  Local EventGuid As Guid                                        '12 - 15     Connection Cookie             - dwCookie
'  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"
'  pVnt=GlobalAlloc(%GPTR, 16)
'  Prnt "  pVnt = " & Str$(pVnt)
'  @pVnt=pGrid : Call SetWindowLong(Wea.hWnd,0,pVnt)
'  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
'  pVnt=GlobalAlloc(%GPTR, 16)
'  Prnt "  pVnt = " & Str$(pVnt)
'  @pVnt=pConnectionPointContainer : Call SetWindowLong(Wea.hWnd,8,pVnt)
'  EventGuid=$IID_IGridEvents
'  Call pConnectionPointContainer.FindConnectionPoint(Byval Varptr(EventGuid), Byval Varptr(pConnectionPoint))
'  pVnt=GlobalAlloc(%GPTR, 16)
'  Prnt "  pVnt = " & Str$(pVnt)
'  @pVnt=pConnectionPoint : Call SetWindowLong(Wea.hWnd,4,pVnt)
'  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 pVnt As Variant Ptr
'  Local dwCookie As Dword
'  Local hr,iCnt As Long
'  Local pGrid As IGrid
'
'  Prnt "  Entering DestroyGrid()"
'  dwCookie=GetWindowLong(Wea.hWnd,12)
'  pVnt=GetWindowLong(Wea.hWnd,4)
'  Prnt "    pVnt = " & Str$(pVnt)
'  If pVnt Then
'     pConnectionPoint=@pVnt
'     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)
'     Call GlobalFree(pVnt)
'  Else
'     Prnt "    pConnectionPoint Was Already Released!"
'  End If
'  pVnt=GetWindowLong(Wea.hWnd,8)
'  Prnt "    pVnt = " & Str$(pVnt)
'  If pVnt Then
'     pConnectionPointContainer=@pVnt
'     Call pConnectionPointContainer.Release() To iCnt
'     Prnt "    iCnt = " & Str$(hr)
'     Call SetWindowLong(Wea.hWnd,8,0)
'     Call GlobalFree(pVnt)
'  Else
'     Prnt "    pConnectionPointContainer Was Already Released!"
'  End If
'  pVnt=GetWindowLong(Wea.hWnd,0)
'  Prnt "    pVnt = " & Str$(pVnt)
'  If pVnt Then
'     pGrid=@pVnt
'     Call pGrid.Release() To iCnt
'     Prnt "  iCnt = " & Str$(iCnt)
'     Call SetWindowLong(Wea.hWnd,0,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
'
'  Prnt "Entering fnWndProc_OnCommand()"
'  Select Case As Long Lowrd(Wea.wParam)
'    Case %IDC_RETRIEVE
'      Prnt "  Case %IDC_RETRIEVE"
'      pVnt=GetWindowLong(Wea.hWnd,0) : pGrid=@pVnt
'      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

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


     Here then is the console output from the above program.  What might be instructive for you to examine closely are the three AddRef() /Release() calls on the three local interface pointers that occur when an assignment is made to the Variant Ptr memory, and in terms of the Release() calls, when a procedure exits and PowerBASIC calls Release() on the local object pointers.  I'll try to mark it out for you in the below output........