Theo's Forum

IT-Consultant: Frederick J. Harris => Fred's COM (Component Object Model) Tutorials => Topic started by: Frederick J. Harris on July 26, 2011, 05:56:21 PM

Title: Grid Custom Control Project - Converting It To COM
Post by: Frederick J. Harris on July 26, 2011, 05:56:21 PM
Lately I’ve been building custom grid controls and trying to convert them to usable COM based controls which can be loaded and used through PowerBASIC’s or C++’s COM facilities and COM Apis.  Below is the starter code for the grid in custom control form.  It compiles to dllGrid.dll.  I used PowerBASIC 10.02.  I’ve included the release binary in the attached zip.  Also provided is a test host – dllHost1.bas.  I didn’t bother including the binary for that; it’s easy enough to create (not that the dll is any harder).  I used the PowerBASIC includes for this but there are comments in the code for using Jose’s includes.  Very little needs to be changed; one line of code and a couple different includes.

I really didn’t want to furnish code that I thought might seriously interfere with folks marketing grid controls, so the functionality of this code is nowhere as complete as with those controls presently for sale.  For me to use it in my work apps I’ll need to expand its functionality to include coloring of cells, deletions, and use of combo boxes in cells.  However, as it now stands you can create as many grid controls and rows and columns as you like, adjust the column widths at run time, put data into it or get it out easily, specify fonts and row heights, scroll about horizontally and vertically, and last but not least, data won’t get ‘stuck’ in the edit control used for editing cells (an aggravating problem with the SIGrid Control, at least for me).

Within  several days I should be able to post my largely successful attempts at converting this over to a COM based control.  I did not succeed in creating a full Ocx ActiveX based control in the full sense of those terms, i.e., requiring an ActiveX Control Container, IDispatch based, and providing drag and drop through OLE functionality in Visual Basic like visual designers.   My control won’t work in Visual Basic 6.  

Whatever merit it has lies I believe in its ability to be used through language agnostic COM services rather than in dll custom control form.  This ability solves the somewhat thorny problem of the need for PowerBASIC created dlls to be accessed through explicit linking and function pointers in other languages such as C or C++.  This latter requirement in my opinion significantly reduces the desirability of PowerBASIC components from the standpoint of  other language users.  COM solves this problem nicely.   Here is the code for dllGrid.dll.  There are a good many comments in the code, plus un-commenting the %DEBUG symbol will generate loads of diagnostic info in an output file.  You can also generate ansi or unicode builds by just commenting or commenting out the %UNICODE symbol right below the %DEBUG symbol…
Title: Re: Grid Custom Control Project - Converting It To COM
Post by: Frederick J. Harris on July 26, 2011, 05:58:46 PM
First Half...

Code: [Select]
#Compile                 Dll  "dllGrid.dll"  'This grid custom control compiles to about 27 K with the
#Dim                     All                 'PowerBASIC includes and 31 K with Jose's includes (release
'%DEBUG                  = 1                 'version).  To do a debug run just uncomment the %DEBUG equate
%UNICODE                 = 1                 'at left.  The grid allows you to set the desired number of
#Include                 "Win32Api.inc"      'rows at design time in the CreateWindowEx() call that creates
%IDC_BASE                = 1499              'the grid, or later at run time through a SetRowCount()
%SIZEOF_PTR              = 4                 'exported function.  The grid has horizontal and verticle
%SIZEOF_HANDLE           = 4                 'scroll bars and resizable columns.  It makes use of the
%ID_PANE                 = 1500              'header ( WC_HEADER ) common control to do this.  Also, the
%ID_HEADER               = 1505              'verticle buttons along the left side of the grid send a
%ID_CELL                 = 1600              'message back to the parent as to which row in the grid and
%IDC_EDIT                = 1605              'its position (row) in the buffer that was clicked.  It also
%GRID_CELL_CHAR          = 40000             'sends keypress, keydown, lbuttondown, paste and cell
%GRID_CELL_KEYDOWN       = 40001             'double click notifications back to its host in the WM_NOTIFY
%GRID_CELL_LBUTTONDOWN   = 40002             'message.
%GRID_CELL_LBUTTONDBLCLK = 40003
%GRID_CELL_PASTE         = 40004             'My intentions in creating this control were three-fold.  First,
%GRID_VBUTTON_CLICK      = 40005             'I wanted to replace the SIGrid control which I'm presently
                                             'using in several mission critical apps at work.  Secondly,
#If %Def(%DEBUG)                             'I wanted to explore the details of converting the standard
Global fp                As Long             'Windows dll based custom control over to a COM based ActiveX
#EndIf                                       'type control. Thirdly, I wanted to make the code public so 
                                             'others might benifit from my explorations of this topic, and
#If %Def(%UNICODE)                           'that I might get valuable feedback on my coding and designs.
    Macro ZStr           = WStringz
    Macro BStr           = WString           'This app makes use of BStrs and ZStrs instead of the Power-
    %SIZEOF_CHAR         = 2                 'BASIC actual variable types.  This is exactly how the UNICODE
#Else
    Macro ZStr           = Asciiz            'issue is handled in C/C++, and I think its an acceptable and
    Macro BStr           = String            'perhaps even elegant solution to the miseries of the times we
    %SIZEOF_CHAR         = 1                 'are now lining through related to strings.
#EndIf
Macro dwIdx(r,c)         = (r-1)*iRange + (c-1)  ' << for obtaining zero based linear offset from one based
Global fnEditWndProc     As Dword                'row / col grid data.

Type WndEventArgs                            'By the way, the headers for using Jose's includes would be
  wParam                 As Long             'Windows.inc, Commctrl.inc, and HeaderCtrl.inc.
  lParam                 As Long
  hWnd                   As Dword
  hInst                  As Dword
End Type

Declare Function FnPtr(wea As WndEventArgs) As Long

Type MessageHandler                          'Used to support my function pointer message cracking scheme. 
  wMessage               As Long             
  dwFnPtr                As Dword
End Type
Global MsgHdlr()         As MessageHandler

Type GridData
  iCtrlID                As Long       'Control ID of Grid
  hParent                As Dword      'Handle To Grid's Parent, i.e., the object whose CreateWindow() Call Created The Grid.
  hGrid                  As Dword      'Handle To Grid
  hBase                  As Dword      'Parent of Pane.  Needed to solve intractable Z Order problem with Verticle Buttons
  hPane                  As Dword      'The Pane Is A Child Of The Grid.  It Is What The Cells Are Painted On.  hPane Is The Handle
  hEdit                  As Dword      'Handle of edit control.  May be NULL if not existing.  Its what you type into.
  cx                     As Dword      'This Would Be The Width Of The Grid From The CreateWindow() Call That Created It.
  cy                     As Dword      'This Would Be The Height Of The Grid From The CreateWindow() Call That Created It.
  hHeader                As Dword      'Handle Of Header Common Control That Allows For Resizable Columns.
  iCols                  As Dword      'Number Of Colums In Grid.  This Is Determined From A ParseCount Of strSetup.
  iRows                  As Dword      'This Is The Number Of Rows Of Data The Grid Will Hold, Which Can Be Many More Than the Visible Rows.
  iVisibleRows           As Dword      'This Is How Many Rows Are Visible, Given How Large The Grid Is Top To Bottom from cx and cy
  iRowHeight             As Dword      'How Many Pixels High Each Row Is.  This affects how many rows are visible.
  iPaneHeight            As Dword      'A bit complicated.  Will explain in WM_CREATE handler.
  iEditedCellRow         As Long       'This number will be between 1 and iVisibleRows.
  iEditedRow             As Long       'This will be the row number in the underlying data buffer
  iEditedCol             As Long       'Column where editing is taking place
  pColWidths             As Dword Ptr  'Allocated in WM_CREATE.  Contains the present column widths. Zero based, i.e., col 1 in zero, etc.
  pCellHandles           As Dword Ptr  'Allocated in WM_CREATE for grid.  Stores Cell handles.
  pGridMemory            As Dword Ptr  'Allocated when # of rows are known, i.e., in WM_CREATE.  Holds pointers to ZStrs.
  pVButtons              As Dword Ptr  'Same as above.  Holds handles of verticle buttons along left edge of grid
  blnAddNew              As Long       'Not used at this time.  Will be used if new rows can be added.
  iFontSize              As Long       'Self explanatory
  iFontWeight            As Long       'For CreateFont() call
  hFont                  As Dword      'Handle to Font.
  szFontName             As ZStr * 28  'Self explanatory
End Type

Type dllGridMessage                    'Used for shipping data back to client through WM_NOTIFY message
  lpnmh                  As NMHDR
  ptCell                 As Points
  iCol                   As Long
  iRow                   As Long
  wParam                 As Long
  lParam                 As Long
End Type


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          'This function and fnCellProc() are very important procedures in this grid control.
  Local strData As BStr            'When a WM_LBUTTONDOWN message is received in fnCellProc(), which is the registered
  Local iLen As Long               'Window Procedure for the "Cell" Window Class, an "edit" control is created and its
                                   'subclass proc - fnEditSubClass is setup.  At that point GridData::hEdit is filled
  #If %Def(%DEBUG)                 'out with the handle of the edit control.  This variable in the UDT/struct also serves
  Print #fp,                                      'dual service as a boolean/flag that the grid presently has an active
  Print #fp, "  Entering blnFlushEditControl()"   'edit control in it.  When focus leaves the cell the edit control is
  #EndIf                                          'destroyed, the subclass removed and GridData::hEdit set back to zero.
  pGridData=GetWindowLong(hGrid,0)                'Naturally, the contents of the edit control must be salvaged and
  If @pGridData.hEdit Then                        'written to the underlying data buffer if its different from what is
     iLen=GetWindowTextLength(@pGridData.hEdit)   'already there.  You can see several lines below where the grid's
     pZStr=GlobalAlloc(%GPTR,(iLen+1)*%SIZEOF_CHAR)                             'SetGrid() exported function is called
     If pZStr Then                                                              'with the row = @pGridData.iEditedRow
        Call GetWindowText(@pGridData.hEdit,Byval pZStr,iLen+1)                 'and the  col = @pGridData.iEditedCol,
        strData=@pZStr                                                          'which UDT/struct members would have
        Call SetGrid(hGrid,@pGridData.iEditedRow,@pGridData.iEditedCol,strData) 'been set down in fnCellProc() when a
        Call SetWindowLong(@pGridData.hEdit,%GWL_WNDPROC,fnEditWndProc)         'WM_LBUTTONDOWN was received there, and
        Call DestroyWindow(@pGridData.hEdit)                                    'the underlying data buffer location
        @pGridData.hEdit=0        'determined through various logic there involving loops and SCROLLINFO data.  So its
        Call Refresh(hGrid)       'like I first said here, this and fnCellProc() are rather important procs.  Actually,
        Call GlobalFree(pZStr)    'this procedure and fnCellProc() were my answer to years and years of frustration with
     Else                         'the SIGrid control in terms of flawlessly getting the contents of its edit control
        #If %Def(%DEBUG)          'out and getting it persisted to the underlying grid data buffer.  Note that after this
        Print #fp, "    Function=%FALSE"               'procedure exits the edit control is destroyed, the sub class
        Print #fp, "  Leaving blnFlushEditControl()"   'removed, and GridData.hEdit set to zero.
        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


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,hHost As Dword
  Local pGridData As GridData Ptr
  Local dgm As dllGridMessage
  Local iReturn As Long

  #If %Def(%DEBUG)
  Print #fp, "  Entering fnEditSubClass"
  #EndIf
  hCell=GetParent(hEdit) : hPane=GetParent(hCell)            'I don't think I need to explain this stuff.  Just your basic
  hBase=GetParent(hPane) : hGrid=GetParent(hBase)            'WM_NOTIFY notification stuff SendMessage'd back to the host.
  hHost=GetParent(hGrid) : pGridData=GetWindowLong(hPane,0)
  dgm.lpnmh.hwndFrom=hGrid
  dgm.lpnmh.idFrom=@pGridData.iCtrlID
  dgm.wParam=wParam
  dgm.lParam=lParam
  dgm.ptCell.x=@pGridData.iEditedCol
  dgm.ptCell.y=@pGridData.iEditedCellRow
  dgm.iCol=@pGridData.iEditedCol
  dgm.iRow=@pGridData.iEditedRow
  Select Case As Long wMsg
    Case %WM_CHAR
      #If %Def(%DEBUG)
      Print #fp, "    Got WM_CHAR Message In fnEditSubClass!"
      #EndIf
      dgm.lpnmh.code=%GRID_CELL_CHAR
      iReturn=SendMessage(hHost,%WM_NOTIFY,GetDlgCtrlID(hGrid),Varptr(dgm))
      #If %Def(%DEBUG)
      Print #fp, "    iReturn = " iReturn
      #EndIf
      If iReturn=-1 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
      dgm.lpnmh.code=%GRID_CELL_KEYDOWN
      iReturn=SendMessage(hHost,%WM_NOTIFY,GetDlgCtrlID(hGrid),Varptr(dgm))
      #If %Def(%DEBUG)
      Print #fp, "    iReturn = " iReturn
      #EndIf
    Case %WM_PASTE
      #If %Def(%DEBUG)
      Print #fp, "    Got WM_PASTE Message In fnEditSubClass!"
      #EndIf
      dgm.lpnmh.code=%GRID_CELL_PASTE
      iReturn=SendMessage(hHost,%WM_NOTIFY,GetDlgCtrlID(hGrid),Varptr(dgm))
      #If %Def(%DEBUG)
      Print #fp, "    iReturn = " iReturn
      #EndIf
    Case %WM_LBUTTONDBLCLK
      #If %Def(%DEBUG)
      Print #fp, "    Got %WM_LBUTTONDBLCLK Message In fnEditSubClass!"
      #EndIf
      dgm.lpnmh.code=%GRID_CELL_LBUTTONDBLCLK
      iReturn=SendMessage(hHost,%WM_NOTIFY,GetDlgCtrlID(hGrid),Varptr(dgm))
      #If %Def(%DEBUG)
      Print #fp, "    iReturn = " iReturn
      #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                       'The cells are actually windows whose parent is the pane, and,
      Call SetWindowLong(hCell,0,%NULL)   'of course, the pane's parent is the base, and the base's parent
      Function=0 : Exit Function          'is the grid itself.  And of course, the grid's parent is the
    Case %WM_LBUTTONDOWN                  'host app.  So there's quite a lineage involved.
      Local iRange,iCellBufferPos,iGridMemOffset,iRow,iCol As Long
      Local hPane,hBase,hGrid As Dword
      Local pGridData As GridData Ptr     'As mentioned in my discussion in blnFlushEditControl(), this proc and the latter mentioned
      Local si As SCROLLINFO              'are rather important.  Note that blnFlushEditControl() is called here about eight lines below
      Local pZStr As ZStr Ptr             'where I'm typing right now.  So when a WM_LBUTTONDOWN is received in one of the cells, whatever
      Register i As Long                  'was in any edit control within the cell is written to the underlying data buffer, and the edit
      Register j As Long                  'control is destroyed.  Just left and below GetScrollInfo() is called to get the .nPos value
      hPane=GetParent(hCell)              'because that value will be needed to determine which row in the data buffer is being accessed.
      hBase=GetParent(hPane)              'Then the code goes into a double For loop to test the handle of the cell - hCell, against all
      hGrid=GetParent(hBase)              'the cell handles stored in the GridData::pCellHandles[] buffer set up in WM_CREATE.  Once this
      pGridData=GetWindowLong(hPane,0)    'loop logic finds the i, j cell location where the WM_LBUTTONDOWN occurred, it can also determine
      Call blnFlushEditControl(hGrid)     'with the .nPos SCROLLINFO data where in the data buffer we are fooling around.  It then assigns
      si.cbSize = sizeof(SCROLLINFO)      'the data in the buffer to pZStr (a null terminated string buffer pointer), so that data can be
      si.fMask=%SIF_POS                   'put in the edit control which will soon be created.
      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)     '<<< macro for converting one based row / col coordinates to linear zero based buffer position.
          If @pGridData.@pCellHandles[iCellBufferPos]=hCell Then
             iGridMemOffset=iRange*(si.nPos-1)+iCellBufferPos
             pZStr=@pGridData.@pGridMemory[iGridMemOffset]
             iRow=i : iCol=j
             Exit, Exit                   'Here you can see an edit control is being created and its parent is being set to the hCell coming
          End If                          'into this Window Procedure, that is, the cell that received a WM_LBUTTONDOWN.  When the grid was
        Next j                            'created a buffer was set up to store the column widths, i.e., GridData::pColWidths[].  When the
      Next i                              'user uses the header control at top of the grid to resize columns, this data is received in
      @pGridData.hEdit=CreateWindow _     'fnPaneProc(), and the pColWith[] buffer updated.  So it always has the most recent col width info.
      ( _                                 
        "edit", _
        "", _
        %WS_CHILD Or %WS_VISIBLE Or %ES_AUTOHSCROLL, _
        1, _
        0, _
        @pGridData.@pColWidths[iCol-1]-2, _
        @pGridData.iRowHeight, _
        hCell, _                          'Note below where the i, j coordinates obtained in the loop above are being persisted to @pGridData
        %IDC_EDIT, _                      'in the iEditedCellRow, iEditedRow, and iEditedCol members.  The .iEditedCellRow will between 1 and
        GetModuleHandle(Byval 0), _       'the number of grid rows visible.  The .iEditedRow value will relate to the row in the grid's data
        ByVal 0 _                         'buffer.  For example, if the user clicks in the fifth row of the grid, that fifth row might be record
      )                                   'five hundred in the buffer if the user had scrolled down to there.
      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
      @pGridData.iEditedRow=iRow+si.nPos-1
      @pGridData.iEditedCol=iCol
      Call SetFocus(@pGridData.hEdit)
      Function=0 : Exit Function
    Case %WM_PAINT
      Local hDC,hFont,hTmp As Dword       'As you can see, I'm writing a pointer to whatever should be visible in a cell at offset
      Local pBuffer As ZStr Ptr           'zero in the cell's .cbWndExtra bytes, and the font its supposed to be displayed at offset
      Local ps As PAINTSTRUCT             'four.  That way, when a WM_PAINT comes through to a cell, it just needs to query its
      hDC=BeginPaint(hCell,ps)            'internal structure for what and how its to be displayed.  Afterall, I'm a believer in
      pBuffer=GetWindowLong(hCell,0)      'OOP, right?
      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    'Lot of complicated header control stuff made even worse
      Local pNotify As HD_NOTIFY Ptr     'with pointers the misery of which was compounded to the
      Local iPos(),iWidth() As Long      'n'th degree with SetWindowPos() miseries.  I hate
      Local index,iHt,iRange As Long     'SetWindowPos().  Its my least favorite Api fn.  I mean,
      Local iCols As Dword               'what's the bottom, what's the top, and what's in the
      pNotify=lParam                     'middle?
      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)  'You know, I might have been able to get by with a label control here!
End Function
Title: Re: Grid Custom Control Project - Converting It To COM
Post by: Frederick J. Harris on July 26, 2011, 06:04:27 PM
2nd Half...

Code: [Select]
Function fnGridProc_OnCreate(Wea As WndEventArgs) As Long              'This is where the grid is put together.  Data will be fed
  Local iFlds,iHdlCount,iCols,iCtr,iSize As Long                       'into this function directly from the CreateWindowEx() call
  Local strParseData(),strFieldData() As BStr                          'that creates the grid.  The 3rd parameter of the call will
  Local pGridData1,pGridData2 As GridData Ptr                          'be a BStr containing the column information such as # of
  Local dwStyle,hButton,hCell,hDC As Dword                             'pixels in width, the caption of the column, and whether its
  Local pCreateStruct As CREATESTRUCT Ptr                              'to be left justified, center, or right justified.  The
  Local uCC As INIT_COMMON_CONTROLSEX                                  'column justification hasn't been implemented yet.  I'll
  Local szText As ZStr*64                                              'leave that as 'extra credit' work for you!  Also, the last
  Local hdrItem As HDITEM                                              'parameter of the CreateWindowEx() call, i.e., lpCreateParams,
  Local strSetup As BStr                                               'will contain a pointer to a GridData UDT passed in from the
  Local iPos() As Long                                                 'client.  With this info the grid can be built.  It more or
  Register i As Long                                                   'less 'pulls itself up by its bootstraps'.
  Register j As Long
  Local rc As RECT

  #If %Def(%DEBUG)
  Print #fp, "  Entering %WM_CREATE Case"
  #EndIf
  pCreateStruct=Wea.lParam                                             'Get strSetup from host from caption of CreateWindow() call.
  Wea.hInst=@pCreateStruct.hInstance                                   'A GridData type var will also be passed in through .lpCreateParams
  pGridData1=@pCreateStruct.lpCreateParams
  If @pGridData1.iRows=0 Or @pGridData1.iCols=0 Or @pGridData1.iRowHeight=0 Then
     fnGridProc_OnCreate=-1 : Exit Function
  End If
  strSetup=@pCreateStruct.@lpszName
  Call GetClientRect(Wea.hWnd,rc)                                      'Get client rect size which will be basis for GridData::iVisibleRows
  #If %Def(%DEBUG)
  Print #fp, "    %WM_USER                 = " %WM_USER                'and GridData::iPaneHeight
  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.blnFontBold  = " @pGridData1.blnFontBold
  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,",")           'columns are seperated by commas in 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                  'A question arose in my mind whether I wanted to have the client
     Function=-1 : Exit Function                    'both allocate and free memory for a GridData Type to be passed
  End If                                            'through the CreateWindow() call.  I decided the client could
  pGridData2=GlobalAlloc(%GPTR,sizeof(GridData))    'locally allocate a GridData, and in here in the WM_CREATE handler
  If pGridData2=0 Then                              'I'd allocate memory for it, copy what data was in it to here, and
     Function=-1 : Exit Function                    'fill out the remaining fields.  Then I'd store a pointer to in in
  End If                                            'the Grid's WndClassEx::cbWndExtraBytes.  Then in a WM_CLOSE or
  Call SetWindowLong(Wea.hWnd,0,pGridData2)         'WM_DESTROY deallocate it.  That would be easiest for clients.  Let
  @pGridData2.iCtrlID=@pCreateStruct.hMenu          'the grid do all the dirty work.  So what you see at left are the
  @pGridData2.cx=@pCreateStruct.cx                  'fields of the Grid's GridData type being copied from the one passed
  @pGridData2.cy=@pCreateStruct.cy                  'in through the CreateWindow() call to the one allocated here.  Also
  @pGridData2.iCols=iCols                           'such critical details are being taken care of such as calculating
  @pGridData2.iRows=@pGridData1.iRows               'the number of rows that will be visible given the iRowHeight the
  @pGridData2.iRowHeight=@pGridData1.iRowHeight     'client wants and the size of the grid from the CreateWindow() cx, cy
  @pGridData2.iVisibleRows=Fix((rc.Bottom-@pGridData1.iRowHeight)/@pGridData1.iRowHeight)    'parameters.  You know, I
  @pGridData2.iPaneHeight=(@pGridData2.iVisibleRows+1)*@pGridData1.iRowHeight                'go on and on, but if you
  @pGridData2.hGrid=Wea.hWnd                                                                 'want to know how this thing
  @pGridData2.hParent=GetParent(Wea.hWnd)           'works you ought to run it in DEBUG mode (uncomment %DEBUG at top)
  @pGridData1.iVisibleRows=@pGridData2.iVisibleRows 'and then check out the Output.txt file.  Everything you ever wanted
  #If %Def(%DEBUG)
  Print #fp, "    pGridData2               = " pGridData2                  'to know and more is in there!!!!!  I'll tell
  Print #fp, "    @pGridData2.iCtrlID      = " @pGridData2.iCtrlID         'what though - this business below with the
  Print #fp, "    @pGridData2.iPaneHeight  = " @pGridData2.iPaneHeight     'pane and the base is a bit tricky.  The base
  Print #fp, "    @pCreateStruct.cy        = " @pCreateStruct.cy           'is a child of the grid and is the lowest thing
  Print #fp, "    @pGridData1.iRowHeight   = " @pGridData1.iRowHeight      'in the Z Order, i.e., its on the bottom behind
  Print #fp, "    @pGridData2.iVisibleRows = " @pGridData2.iVisibleRows    'everything.  You'll also find a MoveWindow() call
  Print #fp, "    @pGridData2.iRows        = " @pGridData2.iRows           'on it situating it at x=12.  The Pane is a child
  #EndIf
  Redim strParseData(iCols) As BStr                                        'of the base.  The reason for the existance of the
  Parse strSetup,strParseData(),","                                        'base at 12 pixels from the left edge of the grid
  @pGridData2.pColWidths=GlobalAlloc(%GPTR,(iCols+1)*%SIZEOF_PTR)          'is so that the verticle buttons could sit atop the
  If @pGridData2.pColWidths=0 Then                                         'grid and not the pane.  The pane moves - the grid
     Call GlobalFree(pGridData2)                                           'and the base don't.  The pane moves to cause the
     Function=-1 : Exit Function                                           'appearance of horizontal scrolling.  Also, I had
  End If                                                                   'excrutiating difficulties getting command clicks
  #If %Def(%DEBUG)
  Print #fp, "    @pGridData2.pColWidths   = " @pGridData2.pColWidths      'on the verticle buttons to come through the grid's
  Print #fp,                                                               'Window Procedure, if the buttons weren't situated
  Print #fp, "    i         strParseData(i) "                              'directly on the grid's surface.
  Print #fp, "    ============================="
  For i=0 To iCols-1                                                       'So, in terms of components, we have a 'grid' class
    Print #fp, "    " i, strParseData(i)   'which is the grid itself.  The 'base' is at the bottom 12 pixels to the right of the
  Next i                                   'left edge.  This gives room for the verticle buttons to sit on the grid itself.  On
  Print #fp,                               'top of the base is the pane, and this 'scrolls' through MoveWindow() calls.  Finally,
  #EndIf
                                           'on top of the pane are the grid cells, a pointer to which is stored in .cbWndExtra bytes.
  @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                                    'All this chunk of code has to do with
    iFlds=ParseCount(strParseData(i),":")               'parsing the strSetup comma delimited
    Redim strFieldData(iFlds-1)                         'fields so as to get the caption and
    Parse strParseData(i), strFieldData(), ":"          'pixel width info out so Header control
    @pGridData2.@pColWidths[i]=Val(strFieldData(0))     'can be setup correctly.
    @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,hdrItem)        'For Jose's Includes
    Call Header_InsertItem(@pGridData2.hHeader,i,Varptr(hdrItem)) 'For the PowerBASIC includes
    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
         Print #fp,
     #EndIf
     @pGridData2.pGridMemory=GlobalAlloc(%GPTR,iSize*%SIZEOF_PTR)
  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  'Your basic tricky scrollbar code!
  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
  Local pGridData As GridData Ptr
  Local dgm As dllGridMessage
  Local si As SCROLLINFO
  Local iReturn As Long

  #If %Def(%DEBUG)
  Print #fp,
  Print #fp, "  Entering fnGridProc_OnCommand()"
  Print #fp, "    Lowrd(Wea.wParam) = " Lowrd(Wea.wParam)
  #EndIf
  If Lowrd(Wea.wParam)>20000 Then
     pGridData=GetWindowLong(Wea.hWnd,0)
     Call blnFlushEditControl(@pGridData.hGrid)
     si.cbSize = sizeof(SCROLLINFO)
     si.fMask=%SIF_POS
     Call GetScrollInfo(@pGridData.hGrid,%SB_VERT,si)
     dgm.lpnmh.hwndFrom=@pGridData.hGrid
     dgm.lpnmh.idFrom=@pGridData.iCtrlID
     dgm.wParam=Wea.wParam
     dgm.lParam=Wea.lParam
     dgm.iRow=si.nPos+Lowrd(Wea.wParam)-20001
     dgm.lpnmh.code=%GRID_VBUTTON_CLICK
     iReturn=SendMessage(@pGridData.hParent,%WM_NOTIFY,@pGridData.iCtrlID,Varptr(dgm))
  End If
  #If %Def(%DEBUG)
  Print #fp, "  iReturn             = " iReturn
  Print #fp, "  Leaving fnGridProc_OnCommand()"
  Print #fp,
  #EndIf

  Function=0
End Function


Function fnGridProc_OnClose(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_OnClose()"
  #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
     Call DestroyWindow(Wea.hWnd)
  End If
  #If %Def(%DEBUG)
  Print #fp, "  Leaving fnGridProc_OnClose()"
  #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_CLOSE    :   MsgHdlr(4).dwFnPtr=CodePtr(fnGridProc_OnClose)
End Sub


Function Initialize() Export As Long
  Local szClassName As ZStr*16
  Local wc As WNDCLASSEX

  #If %Def(%DEBUG)
      Print #fp,
      Print #fp, "  Entering 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=GetModuleHandle(ByVal %NULL)        : wc.hIcon=LoadIcon(%NULL, ByVal %IDI_APPLICATION)
  wc.hCursor=LoadCursor(%NULL, ByVal %IDC_ARROW)   : wc.hbrBackground=GetStockObject(%WHITE_BRUSH)
  wc.lpszMenuName=%NULL
  If RegisterClassEx(wc)=%FALSE Then
     Function=%False
     Exit Function
  End If

  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=GetModuleHandle(ByVal %NULL)        : wc.hIcon=LoadIcon(%NULL, ByVal %IDI_APPLICATION)
  wc.hCursor=LoadCursor(%NULL, ByVal %IDC_ARROW)   : wc.hbrBackground=GetStockObject(%WHITE_BRUSH)
  wc.lpszMenuName=%NULL
  If RegisterClassEx(wc)=%FALSE Then
     Function=%False
     Exit Function
  End If

  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=GetModuleHandle(ByVal %NULL)        : wc.hIcon=LoadIcon(%NULL, ByVal %IDI_APPLICATION)
  wc.hCursor=LoadCursor(%NULL, ByVal %IDC_ARROW)   : wc.hbrBackground=GetStockObject(%GRAY_BRUSH)
  wc.lpszMenuName=%NULL
  If RegisterClassEx(wc)=%FALSE Then
     Function=%False
     Exit Function
  End If

  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=GetModuleHandle(ByVal %NULL)        : 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)
  Print #fp, "    GetModuleHandle() = " wc.hInstance
  #EndIf
  If RegisterClassEx(wc)=%FALSE Then
     Function=%False
     Exit Function
  End If

  Call AttachMessageHandlers()
  #If %Def(%DEBUG)
      Print #fp, "  Leaving Initialize()"
      Print #fp,
  #EndIf

  Function=%True
End Function


#If %def(%DEBUG)
Function DllMain(ByVal hInstance As Long, ByVal fwdReason As Long, ByVal lpvReserved As Long) As Long
  Select Case As Long fwdReason
    Case %DLL_PROCESS_ATTACH
      #If %Def(%DEBUG)
      fp=Freefile : Open "Output1.txt" For Output As #fp
      Print #fp, "In DllMain() Processing %DLL_PROCESS_ATTACH"
      #EndIf
    Case %DLL_PROCESS_DETACH
      #If %Def(%DEBUG)
      Print #fp, "In DllMain() Processing %DLL_PROCESS_DETACH"
      Close #fp
      #EndIf
  End Select

  DllMain=1
End Function
#EndIf
Title: Re: Grid Custom Control Project - Converting It To COM
Post by: Frederick J. Harris on July 26, 2011, 06:07:29 PM
Here is a zip containing the dll custom control, a host to take a look at it, and the source for the control...
Title: Re: Grid Custom Control Project - Converting It To COM
Post by: James C. Fuller on July 26, 2011, 06:13:33 PM
Fred,
  I've used an old version of the Farpoint grid control for ages for a couple of reasons.
It has multi-line headers and a min/max setting for each cell.
Another very nice feature is saving/loading just the formatting of all cells with a single call.
The file is huge but compacts down to minimal size.

James
 
Title: Re: Grid Custom Control Project - Converting It To COM
Post by: Frederick J. Harris on July 26, 2011, 06:44:39 PM
I'll have to check it out James. 

Working on a grid control and converting it to a COM based thing is something I wanted to get at for a long time, but am just now getting to it.
Title: Re: Grid Custom Control Project - Converting It To COM
Post by: James C. Fuller on July 26, 2011, 08:37:23 PM
Here is an example of multi line headers. It also shows how I use the Min/Max setting of the cell and display it in the status bar.

James
Title: Re: Grid Custom Control Project - Converting It To COM
Post by: Frederick J. Harris on July 26, 2011, 08:51:07 PM
Is that a dll based custom control James or an ActiveX control?  I just went to their website and it looks like its .NET now for Windows Forms.
Title: Re: Grid Custom Control Project - Converting It To COM
Post by: James C. Fuller on July 26, 2011, 09:45:59 PM
Fred,
  It's a dll, version 3.0; no longer available and probably not supported any more.

James
Title: Re: Grid Custom Control Project - Converting It To COM
Post by: Frederick J. Harris on August 09, 2011, 08:39:12 PM
                                                                                            Converting Custom Controls To ActiveX Controls : Initial Thoughts And Issues

     There appear to me at this time to be two paths that could be followed in converting a typical Windows custom control which provides some sort of visual appearance to a COM based ActiveX control, and early on in such an endeavor it’ll be necessary to decide which of these paths one wishes to take.  Also, I’ll only be discussing these issues with reference to PowerBASIC, and writing PowerBASIC low level code.  I don’t believe its possible to use PowerBASIC’s high level capabilities to accomplish any of this.

     The first path is to develop a ‘full’ ActiveX control which is also referred to as an OCX and these controls usually have that file name extension.  These controls act as OLE servers and support all the linking and embedding interfaces necessary to provide design time drag and drop capabilities in Visual Basic like design environments.  These types of controls are actually in one of their ‘running’ states or ‘modes’ as they present a visual appearance in the toolbox of Visual Basic, or in design mode on a form, for example.  In other words, they are acting in somewhat like the classic case of embedding an Excel spreadsheet within a Word document (which is where COM started, actually).  They also make heavy demands on any host or containing application that wishes to utilize them, as witnessed by Jose’s Ole Container component (OleCon.inc) capable of negotiating the complex interplay of interface calls between the many interfaces in the Ole Control and the host app.  Jose’s above mentioned Ole Container custom control involves approximately 4000 lines of code.  One alternative to that is the use of Atl71.dll.  That component adds an 87 K file dependency to whatever you develop.  This is not the road I followed, for I personally don’t use visual designers anymore. 

     The second path one may follow is to simply add the COM ‘glue’ to an already existing custom control so that it can be loaded by a host app through COM Services and interact with the client/host through a sink interface rather than WM_NOTIFY messaging as is typical with custom controls.  This is the path I followed.  The techniques I’ll shortly show seem to create controls that work perfectly in PowerBASIC, C/C++, or .NET.

     The fact that these techniques allow easy use of PowerBASIC created controls in other languages such as those mentioned has merit I think.  A PowerBASIC created custom control in Dll form could certainly be loaded and used in C or C++, but I do believe it would require rather special handling that many C or C++ developers might not wish to subject themselves to.  C and C++ coders prefer to have a *.lib file to link against so as to have the same facilities as is provided by PowerBASIC’s Declare statement.  With imported functions listed in PowerBASIC declares where the name and path to the dll is provided, a PowerBASIC developer can use the imported functions just the same as built in functions or ones written directly in the consuming app.  C or C++ coders accomplish this same ease of use by being provided with a *.lib file which allows the linker at compile time to resolve external calls into the dll and create an executable.  Neither PowerBASIC coders nor C and C++ coders enjoy using LoadLibrary() to load a dll, and GetProcAddress() and function pointers to call Dll functions.  Sure it can be done, but who wants to if it can be avoided?

     Another issue relating directly to the above is that I’m not even sure all C++ developers – especially the newer ones, are even all that conversant in the use of function pointers in calling functions in loaded Dlls.  Function pointers have always been an important topic in C, but much less so in C++ with its oftentimes higher level object oriented syntax.  Given the prevalence of high level class libraries in today’s C++ application development, its simply not necessary to use function pointers to get things done and I don’t think many use them, except likely some of the more advanced developers, and those with strong leanings or backgrounds in C.  While I have no idea how widespread the use of PowerBASIC created custom controls are in other languages, given the above situation, I would tend to think it would be minimal.

     Modifying an already existing PowerBASIC custom control Dll to make it usable through COM is very doable and nicely solves these problems I just mentioned above.  In terms of speed the control will be just as fast as the custom control Dll and in terms of size I believe we’re looking at somewhere around a 15 K size hit due to the necessity of defining and implementing a number of interfaces which wouldn’t be in a custom control, and of course there is the required registry code to make the control self-registering.  Where I’m pulling these numbers from is my custom control grid code I just posted above in this thread which compiles to 27 K as a custom control and 42 K with the necessary COM infrastructure.  I expect this 15 K or so would remain relatively constant for larger more complex controls, or only increase slightly.

     I’ll now discuss the control itself and converting the custom control code over to a COM based control.  So far I’m on the third iteration of the control.  I wasn’t sure if I should discuss or present my first and second iterations (my first try in less pompous terminology) of the control.  Since a second and third had to be developed which are apparently better, why not just provide that one to you all?  The reason I’m making it harder on myself and providing a first,  second, and third iteration of the control as well as having to explain these all is that I’m quite certain the first version of the control will be much easier for you, my readers, to understand.  The way I constructed the first version of the control was to literally copy the entirety of the custom control ‘as is’ to a new file containing fairly boiler plate COM infra-structure code, wire it together here and there with a lick and a promise, put on a crash helmet, brace myself, click the compile button, , and hope for the best!  That’s probably making it sound too simple, but isn’t too far from the truth.  In my first version, you’ll be able to easily see the exact same procedures as in dllGrid.bas – my custom control posted previously in this thread.  And of course the relationship and separateness of this typical message handling Win Api code to what is specifically COM related should help you see what is going on.  What would be most difficult for you, I believe, would be an admixture of COM and custom control code where it would be difficult to tell which is what.  That really isn’t the case in any version, but the separateness is more complete in my first version.  And of course I’ll discuss the issues I had with the first iteration that caused me to create a second and third, and I think there are some illuminating conceptual issues that were brought forth through this. 

     The first thing that must be done to convert a custom control into a usable COM Control / ActiveX Control, is decide what the external interfaces to the control will look like.  In other words, what were the exported functions in the custom control, and what messages did it send back to host apps – likely through the WM_NOTIFY messaging apparatus? 

     In terms of the exported functions from the custom control, you can check out your declares you use in the *.inc file associated with the custom control.  These will become part of what might be termed the 'inbound' interface to the ActiveX Control, i.e., the typical case of function/method calls made into the COM object which causes it to do something or other.

     In terms of messages sent from the control to the client/host app through WM_NOTIFY messaging, its a bit more involved.  First realize that all messaging in Windows involves a function pointer arrangement; think of the WNDCLASSEX::lpfnWndProc member of your Window Classes.  In the case of typical Win32 coding in PowerBASIC or C/C++ the mechanics of how this is setup and made to work through the Window Procedure is somewhat hidden within the proprietary API.  With COM its a good bit more transparent in that every detail of it is visible in the ActiveX and client code - at least when coding it low level in PowerBASIC or C/C++.  To make a long story short (at least at this point of just wanting to present the FHGrid1.idl file), the client has to create a legitimate COM Class containing what is termed a 'sink' interface, which is an interface that will be called by the COM object when something happens within it, such as the user clicking within a grid cell.  Using this specific case as an example, what would happen there is that a WM_LBUTTONDOWN would be picked up within the Window Procedure of the grid; the grid would have access to a VTable/Interface pointer sent in from the client, and it would use this pointer to 'callback' into the client sink object.  The direction of movement here is not your typical one of the client calling into the COM object, but rather the reverse as the COM object calls 'out' into the client.  Therefore, these types of interfaces are termed 'outgoing' or 'source' interfaces.

     Much of the complexity then of creating visual COM based controls is setting up this two way data transfer mechanism.  The interfaces involved are IConnectionPointContainer, IConnectionPoint, IEnumConnectionPoints, and IEnumConnections.  These later two can be practically done without in controls such as I'm building here.  But in any case, here is the FHGrid1.idl file that must be run through the midl compiler to create an embeddable typelib for the grid ActiveX control...   

Code: [Select]
// fhGrid1.idl
import "unknwn.idl";

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

[object, uuid(20000000-0000-0000-0000-000000000062), oleautomation] interface IGridEvents : IUnknown
{
 HRESULT Grid_OnKeyPress([in] int KeyCode);
 HRESULT Grid_OnKeyDown([in] int KeyCode);
 HRESULT Grid_OnLButtonDown([in] int iRow, [in] int iCol);
 HRESULT Grid_OnLButtonDblClk([in] int iRow, [in] int iCol);
 HRESULT Grid_OnPaste([in] int iRow, [in] int iCol);
 HRESULT Grid_OnVButtonClick([in] int iCellRow, [in] int iGridRow);
};

[uuid(20000000-0000-0000-0000-000000000063), helpstring("FHGrid1 TypeLib"), version(1.0)] library FHGrid1Library
{
 importlib("stdole32.tlb");
 interface IGrid;
 interface IGridEvents;
 [uuid(20000000-0000-0000-0000-000000000060)]
 coclass FHGrid1
 {
           interface IGrid;
  [source] interface IGridEvents;
 }
};

     Note in the above idl code there are two interfaces defined.  First you have the IGrid interface, and the members of this relate almost exactly to the exported functions of the grid custom control previously posted.  This interface will of course be implemented within the COM dll, and the client will only need to have its definition within itself to call 'into' it in the typical manner once it has an interface pointer to it's implementation within the dll.  The second interface defined above is the IGridEvents interface, and the tables are reversed on this one, so to speak.  The ActiveX control in the dll will have a definition of this interface within itself, but the interface will be implemented within a class in the client or host app, and the COM control will call 'out' to this interface, i.e., its an outgoing or source of events interface. 

     Finally, there is a library statement in the idl code for the 'FHGrid1Library'.  Within this library declaration are statements of the existence of an inbound interface IGrid, and an outbound or source interface IGridEvents.  With this information hosting languages such as high level PowerBASIC or Visual Basic can at runtime synthesize workable sink objects to 'absorb' the events fired by visual COM based controls. 

     I'll attach the generated FHGrid1.tlb file for those who do not have a C/C++ environment with midl to create it for themselves.  With that tlb file you should be able to create the COM Control for yourself if you have preferably PowerBASIC 10.02.  There is a resource statement at the top of FHGrid1.bas like so...

Code: [Select]
#Resource                             Typelib, 1, "FHGrid1.tlb"

That's basically what you need the above file for.  If you have Visual Studio you can invoke the Microsoft Interface Definition Language (midl.exe ) compiler from the command line to create the type lib.  Here is what it looks like for me on the command line using Visual Studio 6 where my development path for version 1 of the control is…

C:\Code\PwrBasic\PBWin10\COM\Grids\v1

Code: [Select]
C:\Code\PwrBasic\PBWin10\COM\Grids\v1>Midl FHGrid1.idl
Microsoft (R) MIDL Compiler Version 5.01.0164
Copyright (c) Microsoft Corp 1991-1997. All rights reserved.
Processing .\FHGrid1.idl
FHGrid1.idl
Processing C:\Program Files (x86)\Microsoft Visual Studio\VC98\include\unknwn.idl
unknwn.idl
Processing C:\Program Files (x86)\Microsoft Visual Studio\VC98\include\wtypes.idl
wtypes.idl
Processing C:\Program Files (x86)\Microsoft Visual Studio\VC98\include\oaidl.idl
oaidl.idl
Processing C:\Program Files (x86)\Microsoft Visual Studio\VC98\include\objidl.idl
objidl.idl

C:\Code\PwrBasic\PBWin10\COM\Grids\v1>

After getting the above output from midl I can then do a dir to see what files are in my v1 directory, which reveals this…

Code: [Select]
C:\Code\PwrBasic\PBWin10\COM\Grids\v1>dir
 Volume in drive C is OSDisk
 Volume Serial Number is 3E79-B713

 Directory of C:\Code\PwrBasic\PBWin10\COM\Grids\v1

08/05/2011  03:02 PM    <DIR>          .
08/05/2011  03:02 PM    <DIR>          ..
08/05/2011  03:02 PM               809 dlldata.c
07/29/2011  03:09 PM            82,771 FHGrid1.bas
08/05/2011  02:49 PM                74 FHGrid1.bat
08/05/2011  03:02 PM            17,839 FHGrid1.h
08/05/2011  03:01 PM             1,570 FHGrid1.idl
08/05/2011  02:58 PM             4,225 FHGrid1.LNX
08/05/2011  03:01 PM                39 FHGrid1.rc
08/05/2011  03:02 PM             3,444 FHGrid1.tlb
08/05/2011  03:02 PM             1,215 FHGrid1_i.c
08/05/2011  03:02 PM            63,089 FHGrid1_p.c
              10 File(s)        175,075 bytes
               2 Dir(s)  158,641,577,984 bytes free

C:\Code\PwrBasic\PBWin10\COM\Grids\v1>

Note that FHGrid1.tlb is there, and that is what I needed.  Having that, I can compile the code for the COM Control.  Without further ado – iteration #1….

continued.....

Title: Re: Grid Custom Control Project - Converting It To COM
Post by: Frederick J. Harris on August 09, 2011, 08:42:45 PM
Here is FHGrid1.bas…

Code: [Select]
#Compile                              Dll  "FHGrid1.dll" 'Use Jose’s Includes!  Compiled With PowerBASIC 10.02
#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                              "HeaderCtrl.inc"
#Resource                             Typelib, 1, "FHGrid1.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.

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) As Long
Declare Function ptrKeyDown           (Byval this As Dword Ptr, Byval iKeyCode As Long) As Long
Declare Function ptrLButtonDown       (Byval this As Dword Ptr, Byval iRow As Long, Byval iCol As Long) As Long
Declare Function ptrLButtonDblClk     (Byval this As Dword Ptr, Byval iRow As Long, Byval iCol As Long) As Long
Declare Function ptrPaste             (Byval this As Dword Ptr, Byval iRow 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-000000000060}")
$IID_IFHGrid                          = Guid$("{20000000-0000-0000-0000-000000000061}")
$IID_IFHGrid_Events                   = Guid$("{20000000-0000-0000-0000-000000000062}")
$IID_LIBID_FHGrid                     = Guid$("{20000000-0000-0000-0000-000000000063}")

Type IGridVtbl
  QueryInterface                      As Dword Ptr
  AddRef                              As Dword Ptr
  Release                             As Dword Ptr
  Initialize                          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
  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 * 28
End Type

Type Grid
  lpIGridVtbl                         As IGridVtbl Ptr
  lpICPCVtbl                          As IConnectionPointContainerVtbl Ptr
  lpICPVtbl                           As IConnectionPointVtbl Ptr
  hContainer                          As Dword
  hControl                            As Dword
  m_cRef                              As Long
End Type


Type IEnumConnectionPointsVtbl
  QueryInterface                      As Dword Ptr
  AddRef                              As Dword Ptr
  Release                             As Dword Ptr
  Next                                As Dword Ptr
  Skip                                As Dword Ptr
  Reset                               As Dword Ptr
  Clone                               As Dword Ptr
End Type

Type IEnumConnectionPoints1
  lpVtbl                              As IEnumConnectionPointsVtbl Ptr
End Type


Type IEnumConnectionsVtbl
  QueryInterface                      As Dword Ptr
  AddRef                              As Dword Ptr
  Release                             As Dword Ptr
  Next                                As Dword Ptr
  Skip                                As Dword Ptr
  Reset                               As Dword Ptr
  Clone                               As Dword Ptr
End Type

Type IEnumConnections1
  lpVtbl                              As IEnumConnectionsVtbl Ptr
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 g_ptrOutGoing                  As Dword Ptr                      'This is an ultimate simplification of the IConnectionPoint interface where only one sink is possible.
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
  Prnt "    Entering IGrid_QueryInterface()"
  @ppv=%NULL
  Select Case iid
    Case $IID_IUnknown
      Prnt "        Trying To Get IUnknown"
      Call IGrid_AddRef(this)
      @ppv=this
      Prnt "        this = " & Str$(this)
      Prnt "      Leaving IGrid_QueryInterface()"
      Function=%S_OK
      Exit Function
    Case $IID_IFHGrid
      Prnt "      Trying To Get IFHGrid"
      Call IGrid_AddRef(this)
      @ppv=this
      Prnt "      this = " & Str$(this)
      Prnt "    Leaving IGrid_QueryInterface()"
      Function=%S_OK
      Exit Function
    Case $IID_IConnectionPointContainer
      Prnt "        Trying To Get IConnectionPointContainer"
      Prnt "        this = " & Str$(this)
      Incr this
      @ppv=this
      Call IConnectionPointContainer_AddRef(this)
      Prnt "        this = " & Str$(this)
      Prnt "      Leaving IGrid_QueryInterface()"
      Function=%S_OK
      Exit Function
    Case $IID_IConnectionPoint
      Prnt "        Trying To Get IConnectionPoint"
      Prnt "        this = " & Str$(this)
      Incr this : Incr this
      @ppv=this
      Call IConnectionPoint_AddRef(this)
      Prnt "        this = " & Str$(this)
      Prnt "      Leaving IComCtrl_QueryInterface()"
      Function=%S_OK
      Exit Function
    Case Else
      Prnt "        Looking For Something I Ain't Got!"
      Prnt "      Leaving IGrid_QueryInterface()"
  End Select

  Function=%E_NoInterface
End Function


Function IGrid_AddRef(ByVal this As IGrid Ptr) As Long
  Local pGrid As Grid 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 Grid Ptr

  #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
     Call DestroyWindow(@pGrid.hControl)
     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_SetRowCount(Byval this As IGrid Ptr, Byval iRowCount As Long, Byval blnForce As Long) As Long
  Local pGrid As Grid Ptr

  pGrid=this
  If SetRowCount(@pGrid.hControl, 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 Grid Ptr

  pGrid=this
  If SetGrid(@pGrid.hControl,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 Grid Ptr

  pGrid=this
  strData=GetGrid(@pGrid.hControl,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 Grid Ptr

  pGrid=this
  If blnFlushEditControl(@pGrid.hControl) 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 Grid Ptr
  pGrid=this
  Call Refresh(@pGrid.hControl)
  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 Grid Ptr

  pGrid=this
  pGridData=GetWindowLong(@pGrid.hControl,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 Grid Ptr

  pGrid=this
  hGrid=@pGrid.hControl
  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


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,hHost As Dword
  Local pGridData As GridData Ptr
  Local iReturn,hr As Long
  Local Vtbl As Dword Ptr

  #If %Def(%DEBUG)
  Print #fp, "  Entering fnEditSubClass"
  #EndIf
  hCell=GetParent(hEdit) : hPane=GetParent(hCell)
  hBase=GetParent(hPane) : hGrid=GetParent(hBase)
  hHost=GetParent(hGrid) : pGridData=GetWindowLong(hPane,0)
  Select Case As Long wMsg
    Case %WM_CHAR
      #If %Def(%DEBUG)
      Print #fp, "    Got WM_CHAR Message In fnEditSubClass!"
      #EndIf
      Vtbl=@g_ptrOutGoing
      Call Dword @Vtbl[3] Using ptrKeyPress(g_ptrOutGoing, wParam) To hr
      #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
      Vtbl=@g_ptrOutGoing
      Call Dword @Vtbl[4] Using ptrKeyDown(g_ptrOutGoing, wParam) To hr
      #If %Def(%DEBUG)
      If SUCCEEDED(hr) Then
         Print #fp, "    Call Dword @Vtbl[4] Using ptrKeyPress() 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
      Vtbl=@g_ptrOutGoing
      Call Dword @Vtbl[7] Using ptrPaste(g_ptrOutGoing, @pGridData.iEditedRow, @pGridData.iEditedCol) To hr
      #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
      Vtbl=@g_ptrOutGoing
      Call Dword @Vtbl[6] Using ptrLButtonDblClk(g_ptrOutGoing, @pGridData.iEditedRow, @pGridData.iEditedCol) To hr
      #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  '%WM_LBUTTONDBLCLK
      Local iRange,iCellBufferPos,iGridMemOffset,iRow,iCol,hr As Long
      Local hPane,hBase,hGrid As Dword
      Local pGridData As GridData Ptr
      Local si As SCROLLINFO
      Local pZStr As ZStr Ptr
      Local Vtbl As Dword Ptr
      Register i As Long
      Register j As Long
      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                 'get rank of cell memory in
             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
      @pGridData.iEditedRow=iRow+si.nPos-1
      @pGridData.iEditedCol=iCol
      Call SetFocus(@pGridData.hEdit)
      Vtbl=@g_ptrOutGoing
      Call Dword @Vtbl[5] Using ptrLButtonDown(g_ptrOutGoing, @pGridData.iEditedRow, @pGridData.iEditedCol) To hr
      #If %Def(%DEBUG)
      If SUCCEEDED(hr) Then
         Print #fp, "    Call Dword @Vtbl[5] Using ptrLButtonDown() Succeeded!"
      End If
      #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

Code Too Long...Continued Next Post.....
Title: Re: Grid Custom Control Project - Converting It To COM
Post by: Frederick J. Harris on August 09, 2011, 08:49:10 PM
continued...

Code: [Select]
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
  Local iCellRow,iGridRow,hr As Long
  Local pGridData As GridData Ptr
  Local Vtbl As Dword Ptr
  Local si As SCROLLINFO

  #If %Def(%DEBUG)
  Print #fp,
  Print #fp, "  Entering fnGridProc_OnCommand()"
  Print #fp, "    Lowrd(Wea.wParam) = " Lowrd(Wea.wParam)
  #EndIf
  If Lowrd(Wea.wParam)>20000 Then
     pGridData=GetWindowLong(Wea.hWnd,0)
     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
     Vtbl=@g_ptrOutGoing
     Call Dword @Vtbl[8] Using ptrVButtonClick(g_ptrOutGoing, 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()"
  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


Function IGrid_Initialize(Byval this As IGrid Ptr) As Long
  Local szClassName As ZStr*16
  Local wc As WNDCLASSEX

  #If %Def(%DEBUG)
      Prnt ""
      Prnt "  Entering Initialize() -- IGrid_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
  If RegisterClassEx(wc)=%FALSE Then
     Function=%E_FAIL
     Exit Function
  End If

  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
  If RegisterClassEx(wc)=%FALSE Then
     Function=%E_FAIL
     Exit Function
  End If

  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
  If RegisterClassEx(wc)=%FALSE Then
     Function=%E_FAIL
     Exit Function
  End If

  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
  If RegisterClassEx(wc)=%FALSE Then
     Function=%E_FAIL
     Exit Function
  End If

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

  Function=%True
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 hGrid,dwStyle As Dword
  Local pGrid As Grid Ptr
  Local gd As GridData

  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

  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,10,10,570,218,Wea.hWnd,%IDC_GRID1,Wea.hInst,ByVal Varptr(grdData))
  hGrid=CreateWindowEx _
  ( _
    %WS_EX_OVERLAPPEDWINDOW, _
    "Grid", _
    Byval Strptr(strSetup), _
    dwStyle, _
    x, _
    y, _
    cx, _
    cy, _
    hContainer, _
    g_CtrlId, _
    g_hModule, _
    ByVal Varptr(gd) _
  )
  Prnt "    GetLastError() = " & Str$(GetLastError())
  Prnt "    hGrid          = " & Str$(hGrid)
  Incr g_CtrlId
  pGrid=this
  @pGrid.hContainer=hContainer
  @pGrid.hControl=hGrid
  Call SetFocus(hGrid)
  Prnt "  Leaving IGrid_CreateGrid()" : Prnt ""

  Function=%S_OK
End Function


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 Grid 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 Grid Ptr

  #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
     Call DestroyWindow(@pGrid.hControl)
     #If %Def(%DEBUG)
     Prnt "    @pGrid.m_cRef = 0 And Will Now Delete pGrid!"
     #EndIf
     Call CoTaskMemFree(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 IConnectionPointContainer1 Ptr, Byval ppEnum As IEnumConnectionPoints1 Ptr) 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


Function IConnectionPoint_AddRef(ByVal this As IConnectionPoint1 Ptr) As Long
  Local pGrid As Grid 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 Grid Ptr

  #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
     Call DestroyWindow(@pGrid.hControl)
     #If %Def(%DEBUG)
     Prnt "    @pGrid.m_cRef = 0 And Will Now Delete pGrid!"
     #EndIf
     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 IConnectionPoint1 Ptr, Byref iid As Guid) As Long
  Function=%E_NOTIMPL
End Function


Function IConnectionPoint_GetConnectionPointContainer(Byval this As IConnectionPoint1 Ptr, Byval ppCPC As IConnectionPointContainer1 Ptr) 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 Vtbl As Dword Ptr
  Local hr As Long

  #If %Def(%DEBUG)
  Prnt "  Entering IConnectionPoint_Advise()!  Grab Your Hardhat And Hang On Tight!"
  Prnt "    pUnkSink      = " & Str$(pUnkSink)
  Prnt "    @pUnkSink     = " & Str$(@pUnkSink)
  #EndIf
  Vtbl=@pUnkSink
  #If %Def(%DEBUG)
  Prnt "    Vtbl          = " & Str$(Vtbl)
  Prnt "    @Vtbl[0]      = " & Str$(@Vtbl[0])
  Prnt "    g_ptrOutGoing = " & Str$(g_ptrOutGoing) & "  << Before Call Of QueryInterface() On Sink"
  #EndIf
  Call Dword @Vtbl[0] Using ptrQueryInterface(pUnkSink,$IID_IFHGrid_Events,Varptr(g_ptrOutGoing)) To hr
  #If %Def(%DEBUG)
  Prnt "    g_ptrOutGoing = " & Str$(g_ptrOutGoing) & "  << After Call Of QueryInterface() On Sink"
  #EndIf
  If SUCCEEDED(hr) Then
     #If %Def(%DEBUG)
     Prnt "    Call Dword Succeeded!"
     #EndIf
     @pdwCookie=1
  Else
     @pdwCookie=0
  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 As Dword Ptr
  Local iReturn As Long

  #If %Def(%DEBUG)
  Prnt "  Entering IConnectionPoint_Unadvise()"
  #EndIf
  VTbl=@g_ptrOutGoing
  Call Dword @Vtbl[2] Using ptrRelease(g_ptrOutGoing) To iReturn
  #If %Def(%DEBUG)
  Prnt "    dwCookie = " & Str$(dwCookie)
  #EndIf
  If SUCCEEDED(iReturn) Then
     #If %Def(%DEBUG)
     Prnt "    IGrid_Events::Release() Succeeded!"
     #EndIf
  End If
  #If %Def(%DEBUG)
  Prnt "    Release() Returned " & Str$(iReturn)
  Prnt "  Leaving IConnectionPoint_Unadvise()"
  #EndIf

  Function=%NOERROR
End Function


Function IConnectionPoint_EnumConnections(Byval this As IConnectionPoint1 Ptr, Byval ppEnum As IEnumConnections1 Ptr) 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 Grid 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(Grid))
     #If %Def(%DEBUG)
     Prnt "    pGrid                      = " & Str$(pGrid)
     #EndIf
     If pGrid Then
        @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))
        #EndIf
        @pGrid.m_cRef=0
        @pGrid.hContainer=0 : @pGrid.hControl=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
     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

continued...
Title: Re: Grid Custom Control Project - Converting It To COM
Post by: Frederick J. Harris on August 09, 2011, 08:54:56 PM
continued...

Code: [Select]
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
     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.Initialize                           = CodePtr(IGrid_Initialize)
     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)

     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 v1"
        szVerIndProgID  =  "FHGrid1.Grid"
        szProgID        =  "FHGrid1.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  =  "FHGrid1.Grid"
     szProgID        =  "FHGrid1.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\v1\Output.txt" For Output As #fp
      Print #fp, "Entering DllMain() -- %DLL_PROCESS_ATTACH"
      #EndIf
      Call DisableThreadLibraryCalls(hInstance)
      g_hModule         =  hInstance
      g_CtrlId          =  1500
    Case %DLL_PROCESS_DETACH
      #If %Def(%DEBUG)
      Print #fp, "Leaving DllMain() -- %DLL_PROCESS_DETACH"
      Close #fp
      #EndIf
  End Select

  DllMain=%TRUE
End Function

End Code!
Title: Re: Grid Custom Control Project - Converting It To COM
Post by: Frederick J. Harris on August 09, 2011, 08:57:57 PM
     In all the code I’m presenting here and am going to discuss, there are two different debug outputs.  First, my clients which connect with the COM control allocate a console, and output various diagnostic/debug statemnts to it.  Second, on every run where the COM dll is accessed, there is a debug output file opened and there is a hard coded path to it as seen below.  Look up in DllMain() just a few lines up and you’ll see this reproduced again…



Code: [Select]
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\v1\Output.txt" For Output As #fp   ‘’’’’’!!!!  <<< Change This !!!!!!!!!
      Print #fp, "Entering DllMain() -- %DLL_PROCESS_ATTACH"
      #EndIf
      Call DisableThreadLibraryCalls(hInstance)
      g_hModule         =  hInstance
      g_CtrlId          =  1500
    Case %DLL_PROCESS_DETACH
      #If %Def(%DEBUG)
      Print #fp, "Leaving DllMain() -- %DLL_PROCESS_DETACH"
      Close #fp
      #EndIf
  End Select

  DllMain=%TRUE
End Function

     It is critically important that you change the above path where you run this code to reflect a path and location where you want to work with this code yourself on your computer.  Otherwise, my guess is the control will neither register correctly nor run.  Some debug output statements go to the console and others go to the output file.  Most of the COM related calls print to the console, and most of the grid construction/destruction code that is basically Win32 Api code common with the grid custom control goes to the output file.  You really need to take care of this step in fixing the Output.txt file path before you register the control; otherwise it likely won't register.

     I’ll just jump into the details of explaining it at this point.  Perhaps it would be good to have the code open to both dllGrid.bas, i.e., the custom control, and FHGrid1.bas, the COM version.  Comparing the initial screen of both programs you’ll note this near the top of  FHGrid1.bas….

Code: [Select]
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) As Long
Declare Function ptrKeyDown           (Byval this As Dword Ptr, Byval iKeyCode As Long) As Long
Declare Function ptrLButtonDown       (Byval this As Dword Ptr, Byval iRow As Long, Byval iCol As Long) As Long
Declare Function ptrLButtonDblClk     (Byval this As Dword Ptr, Byval iRow As Long, Byval iCol As Long) As Long
Declare Function ptrPaste             (Byval this As Dword Ptr, Byval iRow 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

…and this is in dllGrid.bas but also not in FHGrid1.bas

Code: [Select]
Type dllGridMessage      'Used for shipping data back to client through WM_NOTIFY message
  lpnmh                  As NMHDR
  ptCell                 As Points
  iCol                   As Long
  iRow                   As Long
  wParam                 As Long
  lParam                 As Long
End Type         

     The reason for this change is that those declares are going to be used as model declarations for Call Dword function pointer calls at the client’s Sink object, which is the object notified when events occur in the control.  The Type dllGridMessage was removed from the COM control because the WM_NOTIFY message is not used to notify the client of events.  In COM, Sink objects are used.  So there you have a fairly significant difference right up front.  I’ll have more to say about this. 

The next thing you’ll notice in the COM code are GUIDs….

Code: [Select]
$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-000000000060}")
$IID_IFHGrid                          = Guid$("{20000000-0000-0000-0000-000000000061}")
$IID_IFHGrid_Events                   = Guid$("{20000000-0000-0000-0000-000000000062}")
$IID_LIBID_FHGrid                     = Guid$("{20000000-0000-0000-0000-000000000063}")

     This is just part of doing business in COM.  You’ll always have these.  Note one needs class ids and guids for all the interfaces, both incoming and outgoing.  An incoming interface is the standard kind.  Its implemented in the server and provides services to the client.  An outgoing interface is implemented rather in the client and the server calls ‘out’ into it.  While its not implemented in the server we’re discussing now, we need a guid (actually an iid) for it, and also interface definitions for it.  So you can see all these guids above, but you won’t find them in the custom control code.

     The next thing you’ll see in the COM control are lots of things like this….

Code: [Select]
Type IGridVtbl
  QueryInterface                      As Dword Ptr
  AddRef                              As Dword Ptr
  Release                             As Dword Ptr
  Initialize                          As Dword Ptr
  SetRowCount                         As Dword Ptr
  SetData                             As Dword Ptr
  GetData                             As Dword Ptr
  FlushData                           As Dword Ptr
  Refresh                             As Dword Ptr
  GethGrid                            As Dword Ptr
  GetCtrlId                           As Dword Ptr
  CreateGrid                          As Dword Ptr
End Type

Type IGrid
  lpVtbl                              As IGridVtbl Ptr
End Type

     Lots and lots of them.  These are the low level definitions of the Vtable or interface structures that are needed to set up what the memory footprint must look like to qualify as a COM object.  You’ll find sets of these things in twos for each of the interfaces implemented by the COM grid control.  Specifically, you’ll have one set for the custom interface, i.e., one set for IGrid, and one each for IConnectionPointContainer and IConnectionPoint.

This…

Code: [Select]
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
  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 * 28
End Type


…has nothing to do with COM and you’ll find it in both the custom control and COM version.  Obviously, it’s a structure that maintains ‘state’ for the grid control, and functions exactly the same way in both versions.  A pointer to it is stored at offset zero of the .cbWndExtra bytes for both versions.

Now this…

Code: [Select]
Type Grid
  lpIGridVtbl                         As IGridVtbl Ptr
  lpICPCVtbl                          As IConnectionPointContainerVtbl Ptr
  lpICPVtbl                           As IConnectionPointVtbl Ptr
  hContainer                          As Dword
  hControl                            As Dword
  m_cRef                              As Long
End Type

…you won’t find in the custom control code.  It’s a COM class, and that’s pretty important stuff.  Clients never know anything of it – its structure is only defined within the deep recesses of the COM server.  The client never gets a pointer to one; the best the client can ever do is get a pointer to an interface defined and maintained within the class.  All the member variables of this entity are hidden from the client.  All this is part of the design of COM to keep implementation details about the object away from clients.  These ‘class objects’ are instantiated within the server and the best the client can do is get an interface pointer out of it if the client can pass a correct IID into a QueryInterface() call.  This particular class, i.e., ‘Grid’, is able to pass out interface pointers to the IGrid interface, the IConnectionPointContainer Interface, and the IConnectionPoint interface.  However, to get an IConnectionPoint Interface one must first call an IConnectionPointContainer member to get it.

     A memory allocation for the ‘Grid’ class can be found down in IClassFactory_CreateInstance().  This function is never called directly by the client however.  It is actually a function ‘plugged into’ IClassFactory::CreateInstance through the mysterious alchemy of Codeptr() down in DllGetClassObjectImpl(), which function executes when COM services do a LoadLibrary() on FHGrid1.dll and call DllGetClassObjexct().

Moving down a little in FHGrid.bas you'll find this...

Code: [Select]
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

     An implementation of that entity isn't to be found in the custom control code.  The reason for its lack there is it concerns the method of communication between the grid in the COM server and the client.  As mentioned previously, custom controls routinely use Windows messaging apparatus involving the WM_NOTIFY message to transfer information back to a client.  COM uses an event sink, which is a somewhat different affair.  What happens is that a client can learn about a Server's 'source' or outgoing interface from a type library.  The client of the COM object can then implement that interface within some class within itself, and pass a pointer to the class implementing the sink back to the COM server. Later I'll present various client programs showing all kinds of variations on this theme so that it is comprehensible to you.

     An important distinction to keep in mind though is that the above two types are present in this server code only to allow it to make Call Dword function pointer calls on the client's sink object, once the client has passed a pointer to it into this server code. These two types are not instantiated here.  The situation with Call Dword is something like deer hunting here in Pennsylvania; its a good idea to have the deer fairly in your sights and to know what your target looks like before pulling the trigger; the above type descriptions tell this code what the target looks like so that there is a good chance of hitting it.

     Moving on down in FHGrid1.bas you’ll see a bunch of functions which occur exactly as in dllGrid.bas – the custom control.  These are the exported functions from the custom control, although here I removed the Export keyword, because they aren’t being called from the client, but rather from within the COM control itself.  These procedures are…


Code: [Select]
Function SetRowCount(Byval hGrid As Long, Byval iRowCount As Long, Byval blnForce As Long) As Long
Sub Refresh(Byval hGrid As Dword)
Function SetGrid(Byval hGrid As Long, Byval iRow As Long, Byval iCol As Long, Byval strData As BStr) As Long
Function GetGrid(Byval hGrid As Long, Byval iRow As Long, Byval iCol As Long) As BStr
Function blnFlushEditControl(Byval hGrid As Dword) As Long

After that are the actual IGrid interface functions whose addresses are set into the Vtable of the grid COM control, ActiveX control, whatever you want to call it, down in DllGetClassObjectImpl()…..

Code: [Select]
Function IGrid_QueryInterface(….) As Long
Function IGrid_AddRef        (….) As Long
Function IGrid_Release       (….) As Long
Function IGrid_Initialize    (….) As Long
Function IGrid_CreateGrid    (….) As Long
Function IGrid_SetRowCount   (….) As Long
Function IGrid_SetData       (….) As Long
Function IGrid_GetData       (….) As Long
Function IGrid_FlushData     (….) As Long
Function IGrid_Refresh       (….) As Long
Function IGrid_GetCtrlId     (….) As Long
Function IGrid_GethGrid      (….) As Long

Please take a brief look at all these functions.  It goes without saying they are rather important.  I’ll try to explain how they fit into the big picture. 

First, a client app never calls any of these functions directly.  In my demo program is a variable declaration like so…

Code: [Select]
Global pGrid As IGrid 

…and a member call on IGrid::CreateGrid like so… 

Code: [Select]
pGrid.CreateGrid(Wea.hWnd,strSetup,10,10,570,218,12,5,28,strFontName,32,%FW_DONTCARE)

Here is what an IGridVtbl and an IGrid look like…
   
Code: [Select]
Type IGridVtbl
  QueryInterface                      As Dword Ptr
  AddRef                              As Dword Ptr
  Release                             As Dword Ptr
  Initialize                          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
  GethGrid                            As Dword Ptr
  GetCtrlId                           As Dword Ptr
End Type

Type IGrid
  lpVtbl                              As IGridVtbl Ptr
End Type

     The way IGrid_CreateGrid() gets called by the client is that in DllGetClassObjectImple() a globally defined variable named IGrid_Vtbl of type IGridVtbl gets initialized in terms of its CreateGrid member by a CodePtr() call on IGrid_CreateGrid().  The client, upon successfully creating an object of "FHGrid.Grid" class, will have a pointer to its Vtable in pGrid.  At the end of that pointer is the IGridVtbl.  Up in the fifth one based slot (fourth zero based slot) in that Vtable sits a pointer to IGrid_CreateGrid.  So the client is two levels of indirection removed from the actual function.  This creates a tremendous level of insulation between code in the server and code in the client app.  Its what COM is all about.  Since the client never compiles or links against anything in the server, it doesn’t matter what changes are made to it, as long as the interface remains unchanged everything should work.  I’d recommend you examine closely all the details I just described in the server code if you want to have a fighting chance of understanding this.  Below is the actual code to IGrid_CreateGrid()…




Code: [Select]
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 hGrid,dwStyle As Dword
  Local pGrid As Grid Ptr
  Local gd As GridData

  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
  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))
  Prnt "    hGrid          = " & Str$(hGrid)
  Incr g_CtrlId
  pGrid=this
  @pGrid.hContainer=hContainer
  @pGrid.hControl=hGrid
  Call SetFocus(hGrid)
  Prnt "  Leaving IGrid_CreateGrid()" : Prnt ""

  Function=%S_OK
End Function

     You should easily see in this finally how the custom control code integrates into the COM control code because in this function is the CreateWindowEx() call that is the necessary prelude to the creation of the grid and the use of all the grid related functions spoken of briefly by me and which make up the preponderance of the code in dllGrid.bas – the grid custom control. Now lets show some client code that uses the grid.  We’ll do something as simple as possible like my clients for the custom control code.  Here is the inc file for the client…

Title: Re: Grid Custom Control Project - Converting It To COM
Post by: Frederick J. Harris on August 09, 2011, 09:00:21 PM
Code: [Select]
'PBClient1_v1.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

Interface IGrid $IID_IFHGrid : Inherit IAutomation
  Method Initialize()
  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 GridEvents As Event
  Interface IGrid_Events $IID_IGridEvents :  Inherit IAutomation
    Method Grid_OnKeyPress(Byval KeyCode As Long)
      Prnt "Got KeyPress From Grid!" & Str$(KeyCode) & "=" & Chr$(KeyCode)
    End Method

    Method Grid_OnKeyDown(Byval KeyCode As Long)
      ' Insert your code here
    End Method

    Method Grid_OnLButtonDown(Byval iRow As Long, Byval iCol As Long)
      ' Insert your code here
    End Method

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

    Method Grid_OnPaste(Byval iRow 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))
    End Method
  End Interface
End Class

     This code could have been produced by a COM Browser. Here is the  main source…

Code: [Select]
#Compile              Exe          'Used PBWin 10.02; Jose’s Incs             
#Dim                  All
$CLSID_FHGrid         = GUID$("{20000000-0000-0000-0000-000000000060}")
$IID_IFHGrid          = GUID$("{20000000-0000-0000-0000-000000000061}")
$IID_IGridEvents      = GUID$("{20000000-0000-0000-0000-000000000062}")
%IDC_RETRIEVE         = 1500
%IDC_UNLOAD_GRID      = 1505
%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
#Include              "Windows.inc"
#Include              "ObjBase.inc"
#Include              "PBClient1_v1.inc"


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 fnWndProc_OnCreate(Wea As WndEventArgs) As Long
  Local strSetup,strFontName,strCoordinate As BStr
  Local pCreateStruct As CREATESTRUCT Ptr
  Global pSink As IGrid_Events
  Global pGrid As IGrid
  Local hCtl As Dword
  Register i As Long
  Register j As Long

  Call AllocConsole()
  Prnt "Entering fnWndProc_OnCreate() In Host"
  pCreateStruct=wea.lParam
  wea.hInst=@pCreateStruct.hInstance
  Let pGrid = NewCom "FHGrid1.Grid"
  Call pGrid.Initialize()
  strFontName="Times New Roman"
  strSetup="120:Column 1:^,130:Column 2:^,140:Column 3:^,150:Column 4:^,160:Column 5:^"
  pGrid.CreateGrid(Wea.hWnd,strSetup,10,10,570,218,12,5,28,strFontName,18,%FW_DONTCARE)
  Let pSink = Class  "GridEvents"
  Events From pGrid Call pSink
  For i=1 To 10
    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() In Host"

  fnWndProc_OnCreate=0
End Function


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
      pGrid.FlushData()
      strData=pGrid.GetData(3,2)
      Prnt "Cell 3,2 Contains " & strData
    Case %IDC_UNLOAD_GRID
      Events End pSink
      Set pGrid=Nothing : Set pSink=Nothing
      Call EnableWindow(GetDlgItem(Wea.hWnd,%IDC_RETRIEVE),%False)
      Call EnableWindow(GetDlgItem(Wea.hWnd,%IDC_UNLOAD_GRID),%False)
      Call InvalidateRect(Wea.hWnd, Byval 0, %True)
  End Select
  Prnt "Leaving fnWndProc_OnCommand()"

  fnWndProc_OnCommand=0
End Function


Function fnWndProc_OnClose(Wea As WndEventArgs) As Long
  Prnt "Entering fnWndProc_OnClose() In Host"
  If IsObject(pGrid) Then
     Set pGrid=Nothing
  End If
  If IsObject(pSink) Then
     Events End pSink
     Set pSink=Nothing
  End If
  Call CoFreeUnusedLibraries()
  Call DestroyWindow(Wea.hWnd)
  Call PostQuitMessage(0)
  Prnt "Leaving fnWndProc_OnClose() In Host"

  fnWndProc_OnClose=0
End Function


Function fnWndProc(ByVal hWnd As Long,ByVal wMsg As Long,ByVal wParam As Long,ByVal lParam As Long) As Long
  Static 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_CLOSE    :   MsgHdlr(2).dwFnPtr=CodePtr(fnWndProc_OnClose)
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

Note I hid two globals…


Code: [Select]
Global pSink As IGrid_Events
Global pGrid As IGrid

…among the locals in fnWndProc_OnCreate().  Thought I’d be above board and warn you about that.  In my opinion hiding globals among locals is slightly underhanded, but I did it here nonetheless.  There are ways of getting rid of globals in all this, but I felt it would detract from what I’m trying to explain (hiding them in Set/GetWindowLong() or Set/GetProp() calls, and there are other issues unique to COM involved in this that I’d like to put off until later).  The calls pertinent to creating an instance of the grid – from fnWndProc_OnCreate(), are as follows….

Code: [Select]
Let pGrid = NewCom "FHGrid1.Grid"
Call pGrid.Initialize()
StrSetup = "120:Column 1:^,130:Column 2:^,140:Column 3:^,150:Column 4:^,160:Column 5:^"
pGrid.CreateGrid(Wea.hWnd, strSetup, 10, 10, 570, 218, 12, 5, 28, ””, 32, %FW_DONTCARE)
Let pSink = Class  "GridEvents"
Events From pGrid Call pSink
 

     In my opinion, that isn't that much code.  First, the class which implements the IGrid interface is instantiated from COM Services through PowerBASIC’s NewCom keyword.  The phrase “FHGrid1.Grid” is passed to this function as this phrase is the Program ID.  Ordinarily you would want to do error checking such as IsTrue(IsObject)) on every call, but here I omitted it for the sake of brevity.  After this call successfully completes pGrid will be a pointer to the IGrid interface.  The next call…

PGrid.Initialize()

…registers the Window Classes for all the sub-components of the grid such as the cells, the pane, etc.  After that you see a string initialized with the column setup information for the grid.  Then you have the CreateGrid call on IGrid which creates the grid.  It should be very easy for you to see how this translates into the CreateWindowEx() call in IGrid_CreateGrid() within the dll.  The final two calls relate to connecting the client’s sink up with the COM control.  This is an area that always left me a bit wondering and confused, as quite a lot goes on ‘behind the scenes’ so to speak, and I feel I can do a good job of explaining it, but I’d prefer putting that off just a bit.  In my third iteration of the COM control I’ll present every possible variation on the connection point code imaginable as well as a lot of discussion.  For now, lets just look at the console output from running PBClient_v1.exe.

     First, of course, I ought to mention that “FHGrid1.Grid” ought to be registered with COM through putting it in the Windows Registry.  For Vista/Win7 users you need to be careful to ‘Run As Administrator’.  What works for me is to create a batch file in my working directory (like where I ran midl from) that invokes cmd.exe and I right click on that to ‘Run As Administrator’, and then invoke RegSvr32.exe to register the control…

Code: [Select]
C:\Code\PwrBasic\PBWin10\COM\Grids\v1>RegSvr32 FHGrid1.dll

     After doing that you’ll hopefully get a message box telling you the dll registration was successful. I might point out that in x64 Windows the CLSID key won’t list the GUID for the Control Class.  Due to registry redirection its located under...

Code: [Select]
HKEY_CLASSES_ROOT\Wow6432Node\Clsid\{0x20000000,0x0000,0x0000,{0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x60}}

     Assuming you've created the COM dll, successfully registered it, and compiled the client PBClient_v1.bas, here is the output you would expect to see in the console window (in addition to the grid) after executing the client.  I've made considerable notes to the right explaining what is happening, and its significance...


Code: [Select]
Entering fnWndProc_OnCreate() In Host        ‘In WM_CREATE handler in Client
  Entering DllGetClassObjectImpl()           ‘This is COM Services ‘SCM’ loading the dll from PB NewCom statement
    Entering IClassFactory_QueryInterface()  ‘Getting IID_IUnknown or IID_IClassFactory
      Entering IClassFactory_AddRef()        ‘One Class Factory Created and Referenced
        g_lObjs =  1
      Leaving IClassFactory_AddRef()
      this =  9964228
    Leaving IClassFactory_QueryInterface()
    IClassFactory_QueryInterface() For iid Succeeded!
  Leaving DllGetClassObjectImpl()

  Entering IClassFactory_CreateInstance()    ‘Now use FHGrid’s IClassFactory::CreateInstance to create COM memory layout
    pGrid                      =  1359424    ‘to support FHGrid.  This involves a memory allocation for the class Grid,
    Varptr(@pGrid.lpIGridVtbl) =  1359424    ‘which memory allocation involves 24 bytes; 12 bytes for three interface
    Varptr(@pGrid.lpICPCVtbl)  =  1359428    ‘pointers and 12 bytes for three class member variables.  The three interface
    Varptr(@pGrid.lpICPVtbl)   =  1359432    ‘pointers are for the IGrid, IconnectionPointContainer, and IConnectionPoint
    @ppv                       =  0  << Before QueryInterface() Call
    Entering IGrid_QueryInterface()          ‘pointers.  The three member variables are for the reference counter, the
      Trying To Get IFHGrid                  ‘hContainer, and the hControl (instance of grid) when its created.
      Entering IGrid_AddRef()
        @pGrid.m_cRef =  1
      Leaving IGrid_AddRef()
      this =  1359424
    Leaving IGrid_QueryInterface()
    @ppv                       =  1359424  << After QueryInterface() Call
  Leaving IClassFactory_CreateInstance()

  Entering IGrid_AddRef()
    @pGrid.m_cRef =  2
  Leaving IGrid_AddRef()

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

  Entering IClassFactory_Release()           ‘At this point PowerBASIC released the Class Factory, seeing that no more
    g_lObjs =  1                             ‘grids were to be created.  Bear in mind though that the grid hasn’t been
  Leaving IClassFactory_Release()            ‘actually created yet.  What has been created so far is just COM infrastructure
                                             ‘code to support the grid control.
  Entering IGrid_QueryInterface()
    Trying To Get IFHGrid
    Entering IGrid_AddRef()
      @pGrid.m_cRef =  2
    Leaving IGrid_AddRef()
    this =  1359424
  Leaving IGrid_QueryInterface()

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

  Entering Initialize() -- IGrid_Initialize()   ‘Here is where pGrid.Initialize() was called in the client.  At this point 
    GetModuleHandle() =  9895936                ‘all the Window Classes used by the grid are registered (RegisterClassEx().
  Leaving Initialize()


  Entering IGrid_CreateGrid()                   ‘Here is the important call to pGrid.CreateGrid(…)  !!!!! IMPORTANT!!!!!! 
    this           =  1359424
    hContainer     =  1180416
    strSetup       =  120:Column 1:^,130:Column 2:^,140:Column 3:^,150:Column 4:^,160:Column 5:^
    x              =  10
    y              =  10                        ‘The big CreateWindowEx() call that instantiates a “Grid” Window Class is
    cx             =  570                       ‘in this procedure.  Of course, if you know your Windows Api programming
    cy             =  218                       ‘you’ll know that the CreateWindowEx() call on the “Grid” Window Class will
    iRows          =  12                        ‘cause fnGridProc_OnCreate() to execute, as well as all the WM_CREATE
    iCols          =  5                         ‘handlers for the “Pane”, the “Cell”s, so on and so forth, and momentarily
    iRowHt         =  28                        ‘you’ll have a grid on your client’s window.
    strFontName    = Times New Roman
    hGrid          =  3932902
  Leaving IGrid_CreateGrid()

  Entering IGrid_QueryInterface()                             ‘The next step after creating the windowing machinery for the
    Trying To Get IconnectionPointContainer                   ‘grid is to set up the outgoing interface and the event
    this =  1359424                                           ‘handling machinery involving the client’s sink object.  This
    Entering IConnectionPointContainer_AddRef()               ‘output at left would have been caused by the two lines in
      @pGrid.m_cRef =  1  << Before                           ‘client right after the CreateGrid() call.  PowerBASIC would
      @pGrid.m_cRef =  2  << After                            ‘have done a QueryInterface() for IconnectionPointContainer,
    Leaving IConnectionPointContainer_AddRef()                ‘which is in the 1st zero based slot in the class “Grid”.  The
    this =  1359428                                           ‘IGrid Vtable pointer is at offset zero at 1359424 and the
  Leaving IGrid_QueryInterface()                              ‘IConnectionPointContainer slot is at 1359428 which is the…
                   
  Entering IConnectionPointContainer_FindConnectionPoint()    ‘number returned to the client from the QueryInterface() call.
    this  =  1359428                                          ‘The next thing PowerBASIC did was use the pointer just
    @ppCP =  0                                                ‘returned to it to see if it can get an IConnectionPoint
    Entering IConnectionPointContainer_QueryInterface()       ‘pointer based on the presence of $IID_IgridEvents.  This it
      Looking For IID_IConnectionPoint interface pointer.     ‘managed to do and the IconnectionPoint pointer is in zero
      Entering IConnectionPoint_AddRef()                      ‘based slot two of the “Grid” class at 1359432.  One of the
        @pGrid.m_cRef =  2  << Before                         ‘member functions of IconnectionPoint is the Advise() method
        @pGrid.m_cRef =  3  << After                          ‘and that gets called next.  The purpose and workings of
      Leaving IConnectionPoint_AddRef()                       ‘Advise() are to pass to the COM control the address of an
      Leaving IConnectionPointContainer_QueryInterface()      ‘instantiated class in the client which implements the sink
    @ppCP =  1359432                                          ‘interface of which the Server/Com Control has the
  Leaving IConnectionPointContainer_FindConnectionPoint()     ‘definitions only, i.e. the IGridEventsVtbl Type previously

  Entering IConnectionPoint_Advise()!  Grab Your Hardhat And Hang On Tight!
    pUnkSink      =  1371108 ‘…discussed.  What might be confusing here is that it all looks somewhat un-necessary for the
    @pUnkSink     =  2109324 ‘server to do a QueryInterface() call back into the client from within Advise() to get the same
    Vtbl          =  2109324 ‘number that was originally passed to it from the client, i.e., 1371044, but it might not
    @Vtbl[0]      =  2115400 ‘always be like this if the class passed to the server has more than the $IID_IGridEvents
    g_ptrOutGoing =  0       ‘interface implemented within it.  In this unique and simple case where the GridEvents class
    g_ptrOutGoing =  1371108 ‘only has the IGrid_Events interface implemented within it, the ptr to the event sink interface
    Call Dword Succeeded!    ‘will be the same number as the address of the clients sink class.  I hope I made and explained
  Leaving IConnectionPoint_Advise() And Still In One Piece!                          ‘this clear, although I fear I haven’t!

  Entering IGrid_AddRef()
    @pGrid.m_cRef =  4
  Leaving IGrid_AddRef()

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

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


Got KeyPress From Grid! 102=f        ‘The output you are seeing here is from me clicking in cell ( 3, 2 ) and deleting the
Got KeyPress From Grid! 114=r        ‘contents of the cell, then typing in my first name of fred.  Then, while leaving the
Got KeyPress From Grid! 101=e        ‘cursor blinking in cell ( 3, 2 ), I clicked the ‘Retrieve (3,2)” button in the client. 
Got KeyPress From Grid! 100=d        ‘As I may have mentioned, leaving the cursor in a cell after an edit causes major
Cell 3,2 Contains fred               ‘problems with the grid control I’m now using.  One can not retrieve the data from the
                                     ‘cell under those conditions, and that is one of the reasons I decided to write my own
                                     ‘grid control.

Entering IGrid_QueryInterface()
  Trying To Get IconnectionPointContainer                      ‘All this code here involves PowerBASIC releasing
  this =  1359424                                              ‘all the interface pointers its presently holding
  Entering IConnectionPointContainer_AddRef()                  ‘so as to release the grid and dll and close down.
    @pGrid.m_cRef =  2  << Before                              ‘Apparently PowerBASIC released its
    @pGrid.m_cRef =  3  << After                               ‘IconnectionPointContainer and IConnectionPoint
  Leaving IConnectionPointContainer_AddRef()                   ‘interface pointers after setting up the connection
  this =  1359428                                              ‘point to the sink in the client, for here it is
Leaving IGrid_QueryInterface()                                 ‘re-acquiring them so as to release the Server’s…
             
Entering IConnectionPointContainer_FindConnectionPoint()       ‘hold on its sink.  The IconnectionPoint::Unadvise()
  this  =  1359428                                             ‘method does that.
  @ppCP =  0
  Entering IConnectionPointContainer_QueryInterface()
    Looking For IID_IConnectionPoint
    Entering IConnectionPoint_AddRef()
      @pGrid.m_cRef =  3  << Before
      @pGrid.m_cRef =  4  << After
    Leaving IConnectionPoint_AddRef()
  Leaving IConnectionPointContainer_QueryInterface()
  @ppCP =  1359432
Leaving IConnectionPointContainer_FindConnectionPoint()

Entering IConnectionPoint_Unadvise()
  this            =  1359432
  @pGrid.hControl =  3932902
  dwPtr           =  1371044
  IGrid_Events::Release() Succeeded!
  Release() Returned  1
Leaving IConnectionPoint_Unadvise()

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

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

Entering IConnectionPointContainer_Release()          ‘Here all the pointers have been released and there is a call
  @pGrid.m_cRef =  2  << Before                       ‘of CoFreeUnusedLibraries() in the client which causes Windows
  @pGrid.m_cRef =  1  << After                        ‘to call DllCanUnloadNow() in the server.  The server will
Leaving IConnectionPointContainer_Release()           ‘indicate back to windows that it can be unloaded if there
                                                      ‘are no server locks on the server, and no outstanding objects
Entering IGrid_Release()                              ‘left.  In this case there aren’t, so the server is unloaded
  @pGrid.m_cRef =  1  << Before                       ‘and the client closes.
  @pGrid.m_cRef = 0   << After
  Grid Was Deleted!
Leaving IGrid_Release()

Entering fnWndProc_OnClose() In Host
  Entering DllCanUnloadNow()
    I'm Outta Here!
  Leaving DllCanUnloadNow()
Leaving fnWndProc_OnClose() In Host
Title: Re: Grid Custom Control Project - Converting It To COM
Post by: Frederick J. Harris on August 09, 2011, 09:03:23 PM
    Obviously, I've been working with this code for some time, and my usual testing sequence is to start the client, and when the grid becomes visible, I'll scroll it vertically one line so that cell ( 3, 2 ) is on the second line - not the third.  Then I'll WM_LBUTTONDOWN and click in cell ( 3, 2 ) to get the cursor blinking there (that creates an edit control there), and I'll delete the contents of that cell.  Then I type my name "Fred" into it, being careful to leave the edit control cursor blinking in cell 3, 2.  After that I click the button "Retrieve Cell (3,2)" beneath the grid on the client.  If the GUI isn't overtop of the console you should be getting various outputs within the console screen on these various interactions with the grid.  These are created by various Call Dword statements on the client's sink.  Finally, I'll click either the "Unload Grid" button, or the x button to end the app.  You'll then receive a blocking message box to tell you that you can copy the output from the console window if you like.  You need to use the console system menu to do that (right click in title bar).  As an aside, the whole reason I go through this little routine I described above is that for years and years I suffered through the SIGrid control's inability to successfully retrieve cell contents under that usage scenario, and its essentially why I wrote my own grid.

     Hopefully you've managed to get all this working.  If you are having problems contact me in Jose's Forum or the PowerBASIC Forum or at fharris@evenlink.com.

     Having presented all that, I think its time for me to state a problem with this first iteration of the grid COM control.  The issue concerns connection points.  In fact, I think its time I delve pretty deeply into connection points, because they are difficult, to say the least.  Some readers may recall quite some time ago I presented a simple version of a visual COM based control here at Jose’s Forum. Here is the link….

http://www.jose.it-berater.org/smfforum/index.php?topic=3872.0

     Actually, I started this grid COM control with that code as a basis because I found out it successfully worked perfectly as far as I could tell with every client language I’m capable of programming with which includes C, C++, PowerBASIC, Visual Basic 6, and Visual Basic .NET. 

     That code was really an extreme over-simplification of the full ‘by the books’ connection point COM specification.  Fact is, it didn’t really pass muster as being ‘on spec’ because, among other things, it didn’t implement all the enumerators as required by the COM specification.  If you look at that code or the code for this grid you’ll see many of the IConnectionPointContainer and IConnectionPoint members returning E_NOTIMPL.  This is specifically disallowed by the COM Specification (for connection points).  Having said that I’d like to point out a few facts.  All the books one might acquire on COM or Atl take this route of introducing the Connection Point topic by presenting first this stripped down and simplified version similar to what I presented.  The various authors state up front that while it may not exactly match the COM Specification, it might nonetheless be adequate in many or most instances.  Then, some authors will present a fully implemented connection point example, and others will state its simply to complicated to get into without framework support by tools from Microsoft such as ATL or MFC that auto-generate wizard produced code for the coder.  My personal belief is that this somewhat simplified connection point code is adequate in the case of ActiveX controls or COM controls as I am presenting them here.  They represent a special case situation.  Allow me to elaborate.

     In a full implementation of the connection point technology, an object might support multiple connection points, and each connection point might support multiple connections. Just what does that mean?   

     Lets take an example.  I’m just making this up, so please bear with me.  Say you have a Wall Street type firm that has many stock traders and the firm has some piece of software on a server perhaps that continually monitors incoming feeds of DOW stocks, NASDAQ stock companies, and perhaps companies trading in other exchanges, for example, foreign or S & P 500 stocks.  Lets say this piece of software is not a dll but an exe server.  The Connection Point technology works with both in process and out of process servers – both local and remote.  OK, lets further assume that the server maintains a connection point for each of these categories of stocks, i.e., one connection point for DOW stocks, another for NASDAQ, still another for S & P 500 stocks, etc.  Now, this trading house is full of traders and all kinds of financial wheeling and dealing folks, and each has a desk with one or more desktops or laptops on it.  These computers all run client software programs which connect with the services provided by this COM object which is monitoring the incoming feed on stock prices.  Some of the traders are only interested in DOW stocks, others only NASDAQ stocks, some both, etc.  In any case the main server which is monitoring the incoming financial feed for ALL stocks is keeping track of each client computer implementing an outgoing interface connected to it, and its connection points are actually wrapping an array of sink objects on these various computers.  For example, at one particular moment it might have five clients wanting to be notified through its DOW connection point of a change to a DOW stock’s value.  Maybe it has 10 computers connected to its NASDAQ connection point wanting to be notified of a change to a NASDAQ stock price.  When it determines through its external feed that some stock changed in value it has to fire out event notifications to all the various computers wanting to be notified of an event for that specific connection point.  Its holding pointers to all these computers in an array, so it does this by looping through the array calling each external sink currently active. Of course, it has to also implement logic to disconnect a sink when a client closes a connection down.

     To give you just an idea of how a connection point might be set up to handle multiple connections (I didn't implement it here), a class might be created like so...

Code: [Select]
%MAX_CONNECTIONS                               = 16

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 CConnectionPointImpl
  lpICPVtbl                                       As IConnectionPointVtbl Ptr
  m_ref                                           As Dword
  m_cookie                                        As Dword
  m_position                                      As Long
  m_unkArray(%MAX_CONNECTIONS-1)                  As Dword Ptr                            <<<<Note Array Declaration!!!
  m_pConnectionPointContainer                     As IConnectionPointContainer1 Ptr
End Type

...
...

Type Grid
  lpIGridVtbl                                     As IGridVtbl Ptr
  lpICPCVtbl                                      As IConnectionPointContainerVtbl Ptr
  lpCPImpl                                        As CConnectionPointImpl Ptr
  hContainer                                      As Dword
  hControl                                        As Dword
  m_cRef                                          As Long
End Type

     In the above code snippet note I have a UDT named CConnectionPointImpl, and that class has a member m_unkArray(), which is an array the class maintains to hold all the addresses of the sink objects sent into it through the IConnectionPoint::Advise() method.  A pointer to this class is a member of the Grid class (see Grid::lpCPImpl above).   

     OK, I think I’ve made the point of showing some ways in which this connection point technology can become complicated because of its flexibility.  All kinds of topologies are supported by it.  You can have scenarios where you have one server firing event notifications to multiple clients, or you can have a situation where one client sink is being fired upon by multiple servers.  Or, you can also have a simple topology where there is only one server and one sink to be notified by it.  Unless I am mistaken in my reasoning, this later simplified case is the likely scenario or topology of an in process connectable COM object that is in fact some type of visual control or component such as a grid.  How could it really be otherwise?  Think for a moment of the typical messaging that goes on in the Window Procedure of an application involving the WM_COMMAND message and buttons.  Lets assume you have two buttons on a Form with separate procedures to carry out whatever processing needs to be done for each respective button click.  If the user clicks button #1, is it really useful that button #2 be informed of it in a separate message?  Well, in some cases maybe, but in those cases doesn’t it make more sense for that logic to be in the client app rather than the server?  Doesn’t it make more sense for Windows to send one WM_COMMAND message and as part of that message include the identifier of the button that was clicked, rather than sending a separate message to both buttons that button #1 was clicked?  This is essentially what is made possible by a full implementation of the connection point architecture.  In the case of our grid control, lets assume we have a client with four instantiations of the grid control on a form, i.e., some form has four grids on it, each with different data in it.  You then set focus on one of these grids and edit some data in a cell.  This activity would of course generate WM_KEYPRESS Windows messages.  Lets say this activity occurred in grid #1.  The full implementation of the connection point architecture would allow us to store for each grid pointers to the sinks of all the other grids, so that, when a keypress occurred in grid #1, the sinks for grid #’s 2, 3, and 4 would also be called.  In my mind, this is of dubious value.  If you actually would wish for something like this, I think it makes more sense to code it in the client rather than making it a feature of the grid.  Therefore, I’ve already decided that for any controls I make (definitely including this one here), I’m going to hold fast to a prescribed one to one relationship between the server, i.e., the control, and the sink to which it calls.

     Lets take a bit of a close look at what is happening with our connection point in our grid.  Up near the top of the source code for FHGrid1.bas is this global variable declaration...

Code: [Select]
Global g_ptrOutGoing  As Dword Ptr

What this variable is supposed to hold for the grid is the pointer to the client's sink which is to be notified.  The following two lines in the client PBClient1_v1.bas...

Code: [Select]
Let pSink = Class  "GridEvents"
Events From pGrid Call pSink     

...will cause the grid's IConnectionPoint_Advise() function to be called.  This function was 'plugged into' the IConnectionPoint VTable by CodePtr() down in DllGetClassObjectImpl().  Here is what our console output showed for this Advise() method when our client executed (reproduced from above)...

Code: [Select]
Entering IConnectionPoint_Advise()!  Grab Your Hardhat And Hang On Tight!
  pUnkSink      =  1371108
  @pUnkSink     =  2109324
  Vtbl          =  2109324 
  @Vtbl[0]      =  2115400 
  g_ptrOutGoing =  0       
  g_ptrOutGoing =  1371108
  Call Dword Succeeded!   
Leaving IConnectionPoint_Advise() And Still In One Piece!

And here is the function itself without the debug statements...

Code: [Select]
Function IConnectionPoint_Advise(Byval this As IConnectionPoint1 Ptr, Byval pUnkSink As Dword Ptr, Byval pdwCookie As Dword Ptr) As Long
  Local Vtbl As Dword Ptr
  Local hr As Long
 
  Vtbl=@pUnkSink
  Call Dword @Vtbl[0] Using ptrQueryInterface(pUnkSink,$IID_IFHGrid_Events,Varptr(g_ptrOutGoing)) To hr
  If SUCCEEDED(hr) Then
     @pdwCookie=1
  Else
     @pdwCookie=0
  End If
 
  Function=hr
End Function

     Let me discuss this code because its important.  The number 1371108 represents both the address of the instantiation of the client's "GridEvents" Class, and in this particular case, the address of where a pointer to the IGridEvents VTable is located.  This duality exists because the "GridEvents" Class only implements one interface, and a pointer to that interface will be at the base allocation of the class.  As you can see, this number came into the Advise() method through the pUnkSink parameter.  As you can also see, its the number that finally got stored in g_ptrOutGoing through some rather confusing and nasty logic.  At 1371108 is a pointer to the IGridEvents VTable, which starts at 2109324.  The first 'slot' in that VTable holds the number 2115400, and that is the address of where QueryInterface() is located for the "GridEvents" Class.  How do I know that, you ask?  I know it because it is the way it has to be for a COM class.  There is a standard in place.  A call Dword is then done to execute the Event Class's QueryInterface(), and the Guid of IID_IFHGridEvents is passed in.  Also passed in is the address (Varptr) of g_ptrOutGoing, so that a pointer to the sink interface can be returned in it if QueryInterface() can successfully satisfy the request for $IID_IFHGridEvents.  If you've read this paragraph about 10 times, studied the code, and are presently experiencing decent mental clarity, it might occur to you that it would have been a lot easier to just assign pUnkSink directly to g_ptrOutGoing, rather than following the above torturous path.  In this case it would have worked because the Class "EventClass" only implements one interface, and that interface pointer is located at the base allocation for the class.  But what if the client's sink interface was only one of four or five other interfaces implemented by a class, and it wasn't the first?  In that case it wouldn't have worked.  The QueryInterface would have been required to get the correct interface pointer out of the class.

     Unless you are a good bit smarter than I you might be having trouble with all this.  It is pretty 'deep'.  It occurred to me it might be clearer if I presented a low level client written in PowerBASIC without the 'WithEvents' stuff.  Then you would see the one to one relationship in procedure calls between what is going on in the client code and what is happening in the console output from the 'deep innards' of the COM Class.  Here then is PBClient2_v1, and note especially the fnWndProc_OnCreate() code where the grid is instantiated and IConnectionPointContainer and IConnectionPoint interface pointers are retrieved and used directly without the WithEvents stuff.  These interfaces are actually build into the compiler, and when using the PowerBASIC IDE, if you set the cursor in front of either IConnectionPointContainer or IConnectionPoint and hit the 'Help' icon, or press the F1 key, you'll be taken to a page with all kinds of good info on the usage of these interfaces (not).  On my setup they highlight in pretty blue too.

Title: Re: Grid Custom Control Project - Converting It To COM
Post by: Frederick J. Harris on August 09, 2011, 09:07:12 PM
Code: [Select]
'PBClient2_v1.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

Interface IGrid $IID_IFHGrid : Inherit IAutomation
  Method Initialize()
  Method Create _
  ( _
    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 KeyCode As Long)
      Prnt "Got KeyPress From Grid!" & Str$(KeyCode) & "=" & Chr$(KeyCode)
    End Method

    Method Grid_OnKeyDown(Byval KeyCode As Long)
      ' Insert your code here
    End Method

    Method Grid_OnLButtonDown(Byval iRow As Long, Byval iCol As Long)
      ' Insert your code here
    End Method

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

    Method Grid_OnPaste(Byval iRow 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))
    End Method
  End Interface
End Class

And the main source code file....

Code: [Select]
'PBClien2_v1.bas
#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-000000000060}")
$IID_IFHGrid                     = GUID$("{20000000-0000-0000-0000-000000000061}")
$IID_IGridEvents                 = GUID$("{20000000-0000-0000-0000-000000000062}")
%IDC_RETRIEVE                    = 1500
%IDC_UNLOAD_GRID                 = 1505
#Include                         "Windows.inc"
#Include                         "ObjBase.inc"
#Include                         "PBClient2_v1.inc"
Global pSink                     As IGridEvents
Global pGrid                     As IGrid
Global pConPtCon                 As IConnectionPointContainer
Global pConPt                    As IConnectionPoint
Global dwCookie                  As Dword

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 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()                                                                     'Allocate A Console For Debug Output
  pCreateStruct=wea.lParam : wea.hInst=@pCreateStruct.hInstance                           'Get hInstance From CREATESTRUCT Ptr
  Let pGrid = NewCom "FHGrid1.Grid"                                                       'Instantiate COM Grid Class
  strSetup="120:Column 1:^,130:Column 2:^,140:Column 3:^,150:Column 4:^,160:Column 5:^"   'Setup String For Grid
  pGrid.Initialize()                                                                      'Initialize Window Classes In Grid
  pGrid.Create(Wea.hWnd, strSetup, 10, 10, 570, 222, 25, 5, 20, "", 18, %FW_DONTCARE)     'IGrid Interface Method Call To Create Grid
  pConPtCon = pGrid                                                                       'QueryInterface() For IConnectionPointContainer
  EventGuid=$IID_IGridEvents                                                              'Convert Guid In Text Form To Raw Guid
  Call pConPtCon.FindConnectionPoint(Byval Varptr(EventGuid), Byval Varptr(pConPt))       'Find Connection Point
  Let pSink = Class  "CGridEvents"                                                        'Instantiate Event Sink Class
  Call pConPt.Advise(Byval Objptr(pSink), dwCookie)                                       'Notify Grid Component of Sink Address
  For i=1 To 25                                                                           'Load Grid With Sample Strings
    For j=1 To 5                                                                          'Refresh() Method Needs To Be
      strCoordinate="(" & Trim$(Str$(i)) & "," & Trim$(Str$(j)) & ")"                     'Called Afterwards To Make Them Visible
      pGrid.SetData(i, j, strCoordinate)                                                  'The Button Lower Left Retrieves The
    Next j                                                                                'Text From Row 3, Col 2.  The Button
  Next i                                                                                  'Lower Right Unloads The Grid.
  pGrid.Refresh()
  hCtl=CreateWindow("button","Retrieve Cell (3,2)",%WS_CHILD Or %WS_VISIBLE,75,245,200,30,Wea.hWnd,%IDC_RETRIEVE,Wea.hInst,ByVal 0)
  hCtl=CreateWindow("button","Unload Grid",%WS_CHILD Or %WS_VISIBLE,325,245,200,30,Wea.hWnd,%IDC_UNLOAD_GRID,Wea.hInst,ByVal 0)

  fnWndProc_OnCreate=0
End Function


Sub DestroyGrid()
  If IsTrue(IsObject(pConPt)) Then
     Call pConPt.Unadvise(dwCookie)
  End If
  If IsTrue(IsObject(pSink)) Then
     Set pSink     = 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
End Sub


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

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

  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


And here then would be the output from running this program with FHGrid1.dll....


Code: [Select]
Entering DllGetClassObjectImpl()
  Entering IClassFactory_QueryInterface()
    Entering IClassFactory_AddRef()
      g_lObjs =  1
    Leaving IClassFactory_AddRef()
    this =  2689732
  Leaving IClassFactory_QueryInterface()
  IClassFactory_QueryInterface() For iid Succeeded!
Leaving DllGetClassObjectImpl()

Entering IClassFactory_CreateInstance()
  pGrid                      =  4456360
  Varptr(@pGrid.lpIGridVtbl) =  4456360
  Varptr(@pGrid.lpICPCVtbl)  =  4456364
  Varptr(@pGrid.lpICPVtbl)   =  4456368
  @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 =  4456360
  Leaving IGrid_QueryInterface()
  @ppv                       =  4456360  << After QueryInterface() Call
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 =  4456360
Leaving IGrid_QueryInterface()

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

Entering Initialize() -- IGrid_Initialize()
  GetModuleHandle() =  2621440
Leaving Initialize()

Entering IGrid_CreateGrid()
  this           =  4456360
  hContainer     =  459332
  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          =  393808
Leaving IGrid_CreateGrid()

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

Entering IConnectionPointContainer_FindConnectionPoint()
  this  =  4456364
  @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 =  4456368
Leaving IConnectionPointContainer_FindConnectionPoint()

Entering IConnectionPoint_Advise()!  Grab Your Hardhat And Hang On Tight!
  pUnkSink      =  4722948
  @pUnkSink     =  2109285
  Vtbl          =  2109285
  @Vtbl[0]      =  2115976
  g_ptrOutGoing =  0        << Before Call Of QueryInterface() On Sink
  g_ptrOutGoing =  4722948  << After Call Of QueryInterface() On Sink
  Call Dword Succeeded!
Leaving IConnectionPoint_Advise() And Still In One Piece!

Got KeyPress From Grid! 102=f
Got KeyPress From Grid! 114=r
Got KeyPress From Grid! 101=e
Got KeyPress From Grid! 100=d

Entering IConnectionPoint_Unadvise()
  dwCookie =  1
  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
  @pGrid.m_cRef = 0   << After
  Grid Was Deleted!
Leaving IGrid_Release()

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

     I wasn't going to present that program until later, after showing version 3, but I thought now would be a better time instead, because I'm discussing connection points.  I also mentioned somewhere above that there were problems with version 1.  Perhaps I'll mention some of them now and end my discussion of version 1.  And we can fix some of these problems in the next version.

     Let me pose this question.  What do you think would happen if the client attempted to instantiate two grid objects in the fnWndProc_OnCreate() message handler which creates the UI for the client app?  From the last example, and using the IConnectionPointContainer and IConnectionPoint interfaces directly, here s the code used to create a grid...

Code: [Select]
pGrid.Create(Wea.hWnd, strSetup, 10, 10, 570, 222, 25, 5, 20, "", 18, %FW_DONTCARE)     'IGrid Interface Method Call To Create Grid
pConPtCon = pGrid                                                                       'QueryInterface() For IConnectionPointContainer
EventGuid=$IID_IGridEvents                                                              'Convert Guid In Text Form To Raw Guid
Call pConPtCon.FindConnectionPoint(Byval Varptr(EventGuid), Byval Varptr(pConPt))       'Find Connection Point
Let pSink = Class  "CGridEvents"                                                        'Instantiate Event Sink Class
Call pConPt.Advise(Byval Objptr(pSink), dwCookie)                                       'Notify Grid Component of Sink Address

     I won't keep you in suspense.  Bad things will happen.  Recall above where we looked at the console output for the IConnectionPoint::Advise() method a global variable in the COM object g_ptrOutGoing got initialized with the address of the class in the client that implements the event sink.  Using the architecture to which I'm partial, i.e., a separate sink class for each grid, that would necessitate the storage within the COM object of multiple pointers to multiple sinks.  They certainly won't all go into scaler g_ptrOutGoing!  Let me show you what would actually happen.  Lets create two grids and two sinks...

Code: [Select]
Global pSink1         As IGridEvents
Global pGrid1         As IGrid
Global pSink2         As IGridEvents
Global pGrid2         As IGrid

Grid Creation Code...

Code: [Select]
'Grid #1
pGrid1.Create(Wea.hWnd, strSetup, 10, 10, 570, 222, 25, 5, 20, "", 18, %FW_DONTCARE)    'IGrid Interface Method Call To Create Grid #1
pConPtCon = pGrid1                                                                      'QueryInterface() For IConnectionPointContainer
EventGuid=$IID_IGridEvents                                                              'Convert Guid In Text Form To Raw Guid
Call pConPtCon.FindConnectionPoint(Byval Varptr(EventGuid), Byval Varptr(pConPt))       'Find Connection Point
Let pSink1 = Class  "CGridEvents1"                                                      'Instantiate Event Sink Class #1
Call pConPt.Advise(Byval Objptr(pSink1), dwCookie)                                      'Notify Grid Component of Sink #1 Address


'Grid #2
pGrid2.Create(Wea.hWnd,strSetup,10,300,570,218,12,5,28,"",18,%FW_DONTCARE)              'IGrid Interface Method Call To Create Grid #2
pConPtCon = pGrid2                                                                      'QueryInterface() For IConnectionPointContainer
EventGuid=$IID_IGridEvents                                                              'Convert Guid In Text Form To Raw Guid
Call pConPtCon.FindConnectionPoint(Byval Varptr(EventGuid), Byval Varptr(pConPt))       'Find Connection Point
Let pSink2 = Class  "CGridEvents2"                                                      'Instantiate Event Sink Class #2
Call pConPt.Advise(Byval Objptr(pSink2), dwCookie)                                      'Notify Grid Component of Sink #2 Address

In the above code snippet all the damage is being done in this line...

Code: [Select]
Call pConPt.Advise(Byval Objptr(pSink2), dwCookie)

The PowerBASIC ObjPtr() verb returns an interface pointer and its that number that is coming through in the Byval pUnkSink As Dword Ptr parameter of the Advise() method we looked at several paragraphs above.  And referring to that code you'll see the number is stored in g_ptrOutGoing.  Here is an example of what you might see for the setup of the connection point for grid #1....     

Code: [Select]
Entering IConnectionPoint_Advise()!  Grab Your Hardhat And Hang On Tight!
  pUnkSink      =  2887932
  @pUnkSink     =  2110933
  Vtbl          =  2110933
  @Vtbl[0]      =  2117192
  g_ptrOutGoing =  0  << Before Call Of QueryInterface() On Sink
  g_ptrOutGoing =  2887932  << After Call Of QueryInterface() On Sink
  Call Dword Succeeded!
Leaving IConnectionPoint_Advise() And Still In One Piece!

The 2887932 number would be the address of the class for Event Sink #1.  Note that g_ptrOutGoing is zero at the outset, and after the QueryInterface call 2887932 was stored in it.  Here is what you might see in the Advise() method output when the connection point was setup for grid #2...

Code: [Select]
Entering IConnectionPoint_Advise()!  Grab Your Hardhat And Hang On Tight!
  pUnkSink      =  2887764
  @pUnkSink     =  2111101
  Vtbl          =  2111101
  @Vtbl[0]      =  2117192
  g_ptrOutGoing =  2887932  << Before Call Of QueryInterface() On Sink
  g_ptrOutGoing =  2887764  << After Call Of QueryInterface() On Sink
  Call Dword Succeeded!
Leaving IConnectionPoint_Advise() And Still In One Piece!

Note in the above code that the address of the first sink, i.e., 2887932, gets overwritten by the address of the second sink!  No good will come of this!  I'll end this presentation of version #1 on that note, and it will give you something to ponder until I get to version #2 where we'll fix it!
Title: Re: Grid Custom Control Project - Converting It To COM
Post by: Frederick J. Harris on August 09, 2011, 09:38:52 PM
Just some final thoughts....

Don't try the above control, i.e., version 1 in Visual Basic or .NET.  It won't work!  You'll have to wait for version #3 for that!  Otherwise, it should work in C, C++, or PowerBASIC on x86 or x64 from Win2000 on up.
Title: Re: Grid Custom Control Project - Converting It To COM
Post by: Frederick J. Harris on August 13, 2011, 05:15:20 AM
Version #2 Of Com Grid Control

     We left off several days ago with a problem in version #1 of our COM based grid control where the code only provided one Dword Ptr variable, i.e., g_ptrOutGoing, to hold the address of client sinks.  There are two conditions where this could be made to work.  The first condition would be where only one grid object at a time could be created by the COM server.  This is pretty unacceptable to me, and I imagine to everyone else as well.  What good would Windows itself be if you could only instantiate one edit control at a time? 

     The second condition where it could be made to work is something of a design or architectural consideration in that if each grid were assigned a separate control id (they are), then the host app could simply maintain one sink object, and parse outbound interface calls made into the single sink for the control id of the grid making the call.  For that to work the function signatures of my model declarations in the server would need to be modified to include the control id of the grid making the Call Dword outbound interface call.  As I presented them in version #1, the control id wasn't used.  If this were done then the logic would be analogous to what takes place in typical Windows messaging involving the WM_COMMAND or WM_NOTIFY messages where the control id is one of the parameters.

     But, I mentioned previously that I didn't want to take that route.  I think I could sum up my reasons for not wanting to do it under the category of cleanliness; I think it would be cleaner to maintain my one sink per one grid rule. 

     That being the case, something obviously needs to be done to allow our server to maintain multiple pointers to client sinks.  The first thought that might come to mind for a solution would be an array of Dword pointers instead of the simple variable, i.e., g_ArrayPtrOutGoing(?).  But, as suggested by my question mark for an array dimension, how big should it be?  And more subtle perhaps but definitely with the potential to be most damaging, how would one then associate pointers loaded into the array with the correct grid window handle when a call needed to be made to a client sink?  After all, the grid will have a window handle coming through the window procedure and none of the other parameters relate in any obvious way to the address of the client sink which needs to be called.  So to make this work infallible logic would need to be written to come up with a way of relating the address of the sink in the client and the window handle of the grid which calls it.

     This is a problem that Windows Sdk coders are pretty familiar with, really, that is, associating data pertaining to an instance of a window with the window object itself, that is, its internal structure within Windows.  The Api maintains various mechanism to do this such as the .cbWndExtra bytes member of the WNDCLASS struct, user data, and window properties.  Note that within the grid server there is this class to represent a grid....

Code: [Select]
Type CGrid
  lpIGridVtbl                         As IGridVtbl Ptr
  lpICPCVtbl                          As IConnectionPointContainerVtbl Ptr
  lpICPVtbl                           As IConnectionPointVtbl Ptr
  hWndCtrl                            As Dword
  m_cRef                              As Long
End Type

We'll obviously have one of these created for each instance of the grid, and note that one of the members is a window handle of the grid filled out in IGrid_CreateGrid()...

Code: [Select]
  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

     Further note that when an IConnectionPoint::Advise() call comes in the server will certainly have access to a CGrid pointer through the 'this' pointer, and that would present an excellent opportunity for storing the address of the client's sink in some way within the grid's internal structure.   Here is what we had in v1 of the COM Control...

Code: [Select]
Function IConnectionPoint_Advise(Byval this As IConnectionPoint1 Ptr, Byval pUnkSink As Dword Ptr, Byval pdwCookie As Dword Ptr) As Long
  Local Vtbl As Dword Ptr
  Local hr As Long

  Vtbl=@pUnkSink
  Call Dword @Vtbl[0] Using ptrQueryInterface(pUnkSink,$IID_IFHGrid_Events,Varptr(g_ptrOutGoing)) To hr
  If SUCCEEDED(hr) Then
     @pdwCookie=1
  Else
     @pdwCookie=0
  End If
 
  Function=hr
End Function

In that code the address of g_ptrOutGoing was passed back to the client in a QueryInterface() call on the client's sink class, and was thereby initialized in the server for later callback purposes.  What we'll do here in our modification is pass through to the client a local instead, i.e., dwPtr below, and within the procedure immediately store it at offset 4 in the grid's .cbWndExtra bytes.  At offset 0 is a pointer to a GridData structure that maintains state for each instance of the grid.  Here's the modified code...
           


Code: [Select]
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 Grid Ptr
  Local hr As Long
                                                        'this'
  Decr this : Decr this   'the IConnectionPoint VTable pointer is at bytes 8 through 11 of the grid's memory allocation, so we need to 'back off'
  pGrid=this              'a distance of two 32 bit pointer slots to get a valid CGrid Ptr, which we can then use to access @pGrid.hWndCtrl. 
  Vtbl=@pUnkSink
  Call Dword @Vtbl[0] Using ptrQueryInterface(pUnkSink,$IID_IFHGrid_Events,Varptr(dwPtr)) To hr
  Call SetWindowLong(@pGrid.hWndCtrl,4,dwPtr)
  If SUCCEEDED(hr) Then
     @pdwCookie=1
  Else
     @pdwCookie=0
  End If

  Function=hr
End Function
     Before I provide the full code for version #2 of the control, I have to confess I made a few relatively minor changes to the Idl file, which will require a recompile of the type library.  Like before, I'll attach the updated FHGrid2.tlb file.  Here is the new idl file...

Code: [Select]
// fhGrid2.idl
import "unknwn.idl";

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

[object, uuid(20000000-0000-0000-0000-000000000067), oleautomation] interface IGridEvents : IUnknown
{
 HRESULT Grid_OnKeyPress([in] int iKeyCode, [in] int iKeyData, [in] int iCellRow, [in] int iGridRow, [in] int iCol);
 HRESULT Grid_OnKeyDown([in] int KeyCode, [in] int iKeyData, [in] int iCellRow, [in] int iGridRow, [in] int iCol);
 HRESULT Grid_OnLButtonDown([in] int iCellRow, [in] int iGridRow, [in] int iCol);
 HRESULT Grid_OnLButtonDblClk([in] int iCellRow, [in] int iGridRow, [in] int iCol);
 HRESULT Grid_OnPaste([in] int iCellRow, [in] int iGridRow, [in] int iCol);
 HRESULT Grid_OnVButtonClick([in] int iCellRow, [in] int iGridRow);
};

[uuid(20000000-0000-0000-0000-000000000068), helpstring("FHGrid2 TypeLib"), version(1.0)] library FHGrid2Library
{
 importlib("stdole32.tlb");
 interface IGrid;
 interface IGridEvents;
 [uuid(20000000-0000-0000-0000-000000000065)]
 coclass FHGrid2
 {
           interface IGrid;
  [source] interface IGridEvents;
 }
};
Title: Re: Grid Custom Control Project - Converting It To COM
Post by: Frederick J. Harris on August 13, 2011, 05:20:02 AM
     Without further ado here is version #2 of our grid COM Control (probably will need three posts to fit it all)...

Code: [Select]
#Compile                              Dll  "FHGrid2.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                              "HeaderCtrl.inc"
#Resource                             Typelib, 1, "FHGrid2.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.

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-000000000065}")
$IID_IFHGrid                          = Guid$("{20000000-0000-0000-0000-000000000066}")
$IID_IFHGrid_Events                   = Guid$("{20000000-0000-0000-0000-000000000067}")
$IID_LIBID_FHGrid                     = Guid$("{20000000-0000-0000-0000-000000000068}")

Type IGridVtbl
  QueryInterface                      As Dword Ptr
  AddRef                              As Dword Ptr
  Release                             As Dword Ptr
  Initialize                          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
  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 * 28
End Type


Type CGrid
  lpIGridVtbl                         As IGridVtbl Ptr
  lpICPCVtbl                          As IConnectionPointContainerVtbl Ptr
  lpICPVtbl                           As IConnectionPointVtbl Ptr
  hWndCtrl                            As Dword
  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

  #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
     Call DestroyWindow(@pGrid.hWndCtrl)
     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_Initialize(Byval this As IGrid Ptr) As Long
  Local szClassName As ZStr*16
  Local wc As WNDCLASSEX

  #If %Def(%DEBUG)
      Prnt ""
      Prnt "  Entering Initialize() -- IGrid_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
  If RegisterClassEx(wc)=%FALSE Then
     Function=%E_FAIL
     Exit Function
  End If

  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
  If RegisterClassEx(wc)=%FALSE Then
     Function=%E_FAIL
     Exit Function
  End If

  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
  If RegisterClassEx(wc)=%FALSE Then
     Function=%E_FAIL
     Exit Function
  End If

  szClassName="Grid"
  wc.lpszClassName=VarPtr(szClassName)             : wc.lpfnWndProc=CodePtr(fnGridProc)
  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(%DKGRAY_BRUSH)
  wc.lpszMenuName=%NULL
  #If %Def(%DEBUG)
  Prnt "    GetModuleHandle() = " & Str$(wc.hInstance)
  #EndIf
  If RegisterClassEx(wc)=%FALSE Then
     Function=%E_FAIL
     Exit Function
  End If

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

  Function=%True
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 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
  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

Title: Re: Grid Custom Control Project - Converting It To COM
Post by: Frederick J. Harris on August 13, 2011, 05:23:58 AM
continued...

Code: [Select]
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 iReturn,hr 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)
  dwPtr=GetWindowLong(hGrid,4)
  Vtbl=@dwPtr
  Select Case As Long wMsg
    Case %WM_CHAR
      #If %Def(%DEBUG)
      Print #fp, "    Got WM_CHAR Message In fnEditSubClass!"
      #EndIf
      Call Dword @Vtbl[3] Using ptrKeyPress(dwPtr, wParam, lParam, @pGridData.iEditedCellRow, @pGridData.iEditedRow, @pGridData.iEditedCol) To hr
      #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
      Call Dword @Vtbl[4] Using ptrKeyDown(dwPtr, wParam, lParam, @pGridData.iEditedCellRow, @pGridData.iEditedRow, @pGridData.iEditedCol) To hr
      #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
      Call Dword @Vtbl[7] Using ptrPaste(dwPtr, @pGridData.iEditedCellRow, @pGridData.iEditedRow, @pGridData.iEditedCol) To hr
      #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
      Call Dword @Vtbl[6] Using ptrLButtonDblClk(dwPtr, @pGridData.iEditedCellRow, @pGridData.iEditedRow, @pGridData.iEditedCol) To hr
      #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
      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                 'get rank of cell memory in
             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)
      dwPtr=GetWindowLong(hGrid,4)
      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
      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 si As SCROLLINFO

  #If %Def(%DEBUG)
  Print #fp,
  Print #fp, "  Entering fnGridProc_OnCommand()"
  Print #fp, "    Lowrd(Wea.wParam) = " Lowrd(Wea.wParam)
  #EndIf
  If Lowrd(Wea.wParam)>20000 Then
     pGridData=GetWindowLong(Wea.hWnd,0)
     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=GetWindowLong(Wea.hWnd,4)
     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()"
  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



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

  #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
     Call DestroyWindow(@pGrid.hWndCtrl)
     #If %Def(%DEBUG)
     Prnt "    @pGrid.m_cRef = 0 And Will Now Delete pGrid!"
     #EndIf
     Call CoTaskMemFree(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


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

  #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
     Call DestroyWindow(@pGrid.hWndCtrl)
     #If %Def(%DEBUG)
     Prnt "    @pGrid.m_cRef = 0 And Will Now Delete pGrid!"
     #EndIf
     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 Vtbl,dwPtr As Dword Ptr
  Local pGrid As CGrid Ptr
  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)
  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
  Call SetWindowLong(@pGrid.hWndCtrl,4,dwPtr)
  If SUCCEEDED(hr) Then
     #If %Def(%DEBUG)
     Prnt "    Call Dword Succeeded!"
     #EndIf
     @pdwCookie=1
  Else
     @pdwCookie=0
  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)
  #EndIf
  Decr this : Decr this
  pGrid=this
  #If %Def(%DEBUG)
  Prnt "    @pGrid.hWndCtrl = " & Str$(@pGrid.hWndCtrl)
  #EndIf
  dwPtr=GetWindowLong(@pGrid.hWndCtrl,4)
  Vtbl=@dwPtr
  #If %Def(%DEBUG)
  Prnt "    dwPtr           = " & Str$(dwPtr)
  #EndIf
  Call Dword @Vtbl[2] Using ptrRelease(dwPtr) To iReturn
  #If %Def(%DEBUG)
  If SUCCEEDED(iReturn) Then
     Prnt "    IGrid_Events::Release() Succeeded!"
  End If
  Prnt "    Release() Returned " & Str$(iReturn)
  Prnt "  Leaving IConnectionPoint_Unadvise()" : Prnt ""
  #EndIf

  Function=%NOERROR
End Function


Function IConnectionPoint_EnumConnections(Byval this As Dword, Byval ppEnum As Dword) As Long
  Function=%E_NOTIMPL
End Function
Title: Re: Grid Custom Control Project - Converting It To COM
Post by: Frederick J. Harris on August 13, 2011, 05:26:41 AM
continued...

Code: [Select]
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.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))
        #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
     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
     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.Initialize                           = CodePtr(IGrid_Initialize)
     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)

     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 v2"
        szVerIndProgID  =  "FHGrid2.Grid"
        szProgID        =  "FHGrid2.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  =  "FHGrid2.Grid"
     szProgID        =  "FHGrid2.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\v2\Output.txt" For Output As #fp
      Print #fp, "Entering DllMain() -- %DLL_PROCESS_ATTACH"
      #EndIf
      Call DisableThreadLibraryCalls(hInstance)
      g_hModule         =  hInstance
      g_CtrlId          =  1500
    Case %DLL_PROCESS_DETACH
      #If %Def(%DEBUG)
      Print #fp, "Leaving DllMain() -- %DLL_PROCESS_DETACH"
      Close #fp
      #EndIf
  End Select

  DllMain=%TRUE
End Function
Title: Re: Grid Custom Control Project - Converting It To COM
Post by: Frederick J. Harris on August 13, 2011, 05:31:06 AM
Well, that's it!  Made it in three posts!

Don't forget to change the path to the debug output file in DllMain() if you compile it.  I hard coded the path because I was having trouble finding the output file when RegSvr32 started it, and it required a lot of debugging to get the registry code right.

You can compile and register this new version and leave version #1 registered, because this one is Prog Id "FHGrid2.Grid" and also has different clsids...

Code: [Select]
$CLSID_FHGrid                         = Guid$("{20000000-0000-0000-0000-000000000065}")
$IID_IFHGrid                          = Guid$("{20000000-0000-0000-0000-000000000066}")
$IID_IFHGrid_Events                   = Guid$("{20000000-0000-0000-0000-000000000067}")
$IID_LIBID_FHGrid                     = Guid$("{20000000-0000-0000-0000-000000000068}")

     Version #1's numbers ended in 60, 61, 62, and 63.  Rather than using Guidgen to create random guids I make up my own so I can easily find them in the registry and delete them.  For production code though it would be a good idea to follow the rules and use Guidgen or its equivalent.

     Here is a client to try this code with.   I named it PBClient1_v2.bas, and it creates two grids.  First the inc file...

Code: [Select]
'PBClient1_v2.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

Interface IGrid $IID_IFHGrid : Inherit IAutomation
  Method Initialize()
  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 GridEvents1 As Event
  Interface IGridEvents $IID_IGridEvents :  Inherit IAutomation
    Method Grid_OnKeyPress(Byval KeyCode As Long)
      Prnt "Got KeyPress From Grid!" & Str$(KeyCode) & "=" & Chr$(KeyCode)
    End Method

    Method Grid_OnKeyDown(Byval KeyCode As Long)
      ' Insert your code here
    End Method

    Method Grid_OnLButtonDown(Byval iRow As Long, Byval iCol As Long)
      ' Insert your code here
    End Method

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

    Method Grid_OnPaste(Byval iRow 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))
    End Method
  End Interface
End Class


Class GridEvents2 As Event
  Interface IGridEvents $IID_IGridEvents :  Inherit IAutomation
    Method Grid_OnKeyPress(Byval KeyCode As Long)
      Prnt "Got KeyPress From Grid!" & Str$(KeyCode) & "=" & Chr$(KeyCode)
    End Method

    Method Grid_OnKeyDown(Byval KeyCode As Long)
      ' Insert your code here
    End Method

    Method Grid_OnLButtonDown(Byval iRow As Long, Byval iCol As Long)
      ' Insert your code here
    End Method

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

    Method Grid_OnPaste(Byval iRow 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))
    End Method
  End Interface
End Class

Then the main source...

Code: [Select]
'PBClient1_v2.bas
#Compile              Exe "PBClient1_v2.exe"   
#Dim                  All
$CLSID_FHGrid         = GUID$("{20000000-0000-0000-0000-000000000065}")
$IID_IFHGrid          = GUID$("{20000000-0000-0000-0000-000000000066}")
$IID_IGridEvents      = GUID$("{20000000-0000-0000-0000-000000000067}")
%IDC_RETRIEVE1        = 1500
%IDC_UNLOAD_GRID1     = 1505
%IDC_RETRIEVE2        = 1510
%IDC_UNLOAD_GRID2     = 1515
%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
#Include              "Windows.inc"
#Include              "ObjBase.inc"
#Include              "PBClient1_v2.inc"
Global pSink1         As IGridEvents
Global pGrid1         As IGrid
Global pSink2         As IGridEvents
Global pGrid2         As IGrid


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 fnWndProc_OnCreate(Wea As WndEventArgs) As Long
  Local strSetup,strFontName,strCoordinate As BStr
  Local pCreateStruct As CREATESTRUCT Ptr
  Local hCtl As Dword
  Register i As Long
  Register j As Long

  Call AllocConsole()
  Prnt "Entering fnWndProc_OnCreate() In Host"
  pCreateStruct=wea.lParam
  wea.hInst=@pCreateStruct.hInstance

  'Grid #1
  Let pGrid1 = NewCom "FHGrid2.Grid"
  Call pGrid1.Initialize()
  strFontName="Times New Roman"
  strSetup="120:Column 1:^,130:Column 2:^,140:Column 3:^,150:Column 4:^,160:Column 5:^"
  pGrid1.CreateGrid(Wea.hWnd,strSetup,10,10,570,218,12,5,28,strFontName,18,%FW_DONTCARE)
  Let pSink1 = Class  "GridEvents1"
  Events From pGrid1 Call pSink1
  For i=1 To 10
    For j=1 To 5
      strCoordinate="(" & Trim$(Str$(i)) & "," & Trim$(Str$(j)) & ")"
      pGrid1.SetData(i,j,strCoordinate)
    Next j
  Next i
  pGrid1.Refresh()
  hCtl=CreateWindow("button","Retrieve Cell (3,2)",%WS_CHILD Or %WS_VISIBLE,75,245,200,30,Wea.hWnd,%IDC_RETRIEVE1,Wea.hInst,ByVal 0)
  hCtl=CreateWindow("button","Unload Grid",%WS_CHILD Or %WS_VISIBLE,325,245,200,30,Wea.hWnd,%IDC_UNLOAD_GRID1,Wea.hInst,ByVal 0)

  'Grid #2
  Let pGrid2 = NewCom "FHGrid2.Grid"
  strFontName="Courier New"
  strSetup="120:Column 1:^,130:Column 2:^,140:Column 3:^,150:Column 4:^,160:Column 5:^"
  pGrid2.CreateGrid(Wea.hWnd,strSetup,10,300,570,218,12,5,28,strFontName,18,%FW_DONTCARE)
  Let pSink2 = Class  "GridEvents2"
  Events From pGrid2 Call pSink2
  For i=1 To 10
    For j=1 To 5
      strCoordinate="(" & Trim$(Str$(i)) & "," & Trim$(Str$(j)) & ")"
      pGrid2.SetData(i,j,strCoordinate)
    Next j
  Next i
  pGrid2.Refresh()
  hCtl=CreateWindow("button","Retrieve Cell (3,2)",%WS_CHILD Or %WS_VISIBLE,75,530,200,30,Wea.hWnd,%IDC_RETRIEVE2,Wea.hInst,ByVal 0)
  hCtl=CreateWindow("button","Unload Grid",%WS_CHILD Or %WS_VISIBLE,325,530,200,30,Wea.hWnd,%IDC_UNLOAD_GRID2,Wea.hInst,ByVal 0)
  Prnt "Leaving fnWndProc_OnCreate() In Host"

  fnWndProc_OnCreate=0
End Function


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_RETRIEVE1
      pGrid1.FlushData()
      strData=pGrid1.GetData(3,2)
      Prnt "Cell 3,2 Contains " & strData
    Case %IDC_RETRIEVE2
      pGrid2.FlushData()
      strData=pGrid2.GetData(3,2)
      Prnt "Cell 3,2 Contains " & strData
    Case %IDC_UNLOAD_GRID1
      Events End pSink1
      Set pGrid1=Nothing : Set pSink1=Nothing
      Call EnableWindow(GetDlgItem(Wea.hWnd,%IDC_RETRIEVE1),%False)
      Call EnableWindow(GetDlgItem(Wea.hWnd,%IDC_UNLOAD_GRID1),%False)
      Call InvalidateRect(Wea.hWnd, Byval 0, %True)
    Case %IDC_UNLOAD_GRID2
      Events End pSink2
      Set pGrid2=Nothing : Set pSink2=Nothing
      Call EnableWindow(GetDlgItem(Wea.hWnd,%IDC_RETRIEVE2),%False)
      Call EnableWindow(GetDlgItem(Wea.hWnd,%IDC_UNLOAD_GRID2),%False)
      Call InvalidateRect(Wea.hWnd, Byval 0, %True)
  End Select
  Prnt "Leaving fnWndProc_OnCommand()"

  fnWndProc_OnCommand=0
End Function


Function fnWndProc_OnClose(Wea As WndEventArgs) As Long
  Prnt "Entering fnWndProc_OnClose() In Host"

  'Grid #1
  If IsObject(pGrid1) Then
     Set pGrid1=Nothing
  End If
  If IsObject(pSink1) Then
     Events End pSink1
     Set pSink1=Nothing
  End If

  'Grid #2
  If IsObject(pGrid2) Then
     Set pGrid2=Nothing
  End If
  If IsObject(pSink2) Then
     Events End pSink2
     Set pSink2=Nothing
  End If
  Call CoFreeUnusedLibraries()
  Call DestroyWindow(Wea.hWnd)
  Call PostQuitMessage(0)
  Prnt "Leaving fnWndProc_OnClose() In Host"

  fnWndProc_OnClose=0
End Function


Function fnWndProc(ByVal hWnd As Long,ByVal wMsg As Long,ByVal wParam As Long,ByVal lParam As Long) As Long
  Static 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_CLOSE    :   MsgHdlr(2).dwFnPtr=CodePtr(fnWndProc_OnClose)
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,620,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

     And here then is a console output run of  PBClient1_v2 showing clearly its new functionality...

Code: [Select]
Entering fnWndProc_OnCreate() In Host
  Entering DllGetClassObjectImpl()
    Entering IClassFactory_QueryInterface()
      Entering IClassFactory_AddRef()
        g_lObjs =  1
      Leaving IClassFactory_AddRef()
      this =  2689732
    Leaving IClassFactory_QueryInterface()
    IClassFactory_QueryInterface() For iid Succeeded!
  Leaving DllGetClassObjectImpl()

  Entering IClassFactory_CreateInstance()
    pGrid                      =  4457936
    Varptr(@pGrid.lpIGridVtbl) =  4457936
    Varptr(@pGrid.lpICPCVtbl)  =  4457940
    Varptr(@pGrid.lpICPVtbl)   =  4457944
    @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 =  4457936
    Leaving IGrid_QueryInterface()
    @ppv                       =  4457936  << After QueryInterface() Call
  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 =  4457936
  Leaving IGrid_QueryInterface()
 
  Entering IGrid_Release()
    @pGrid.m_cRef =  2  << Before
    @pGrid.m_cRef =  1  << After
  Leaving IGrid_Release()
 
  Successfully Created FHGrid2.Grid! :  pGrid1 =  4457936

  Entering Initialize() -- IGrid_Initialize()
    GetModuleHandle() =  2621440
  Leaving Initialize()

  Entering IGrid_CreateGrid()
    this           =  4457936
    hContainer     =  525212
    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          =  197568
  Leaving IGrid_CreateGrid()

  pSink1         =  4464900                          '<<< This would be the base allocation for the "GridEvents1" Class
  Objptr(pSink1) =  4464900                          '<<< which is also the location for the sink interface pointer

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

  Entering IConnectionPointContainer_FindConnectionPoint()
    this  =  4457940
    @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 =  4457944
  Leaving IConnectionPointContainer_FindConnectionPoint()

  Entering IConnectionPoint_Advise()!  Grab Your Hardhat And Hang On Tight!
    this            =  4457944
    pGrid           =  4457936
    @pGrid.hControl =  197568
    pUnkSink        =  4464900                       '<<< Here is where the address of the "GridEvents1" class came into Advise()
    @pUnkSink       =  2111301                       '<<< for Grid #1
    Vtbl            =  2111301
    @Vtbl[0]        =  2117560
    dwPtr           =  4464900
    Call Dword Succeeded!
  Leaving IConnectionPoint_Advise() And Still In One Piece!

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

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

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

  Entering DllGetClassObjectImpl()
    Entering IClassFactory_QueryInterface()
      Entering IClassFactory_AddRef()
        g_lObjs =  2
      Leaving IClassFactory_AddRef()
      this =  2689732
    Leaving IClassFactory_QueryInterface()
    IClassFactory_QueryInterface() For iid Succeeded!
  Leaving DllGetClassObjectImpl()

  Entering IClassFactory_CreateInstance()
    pGrid                      =  4468968
    Varptr(@pGrid.lpIGridVtbl) =  4468968
    Varptr(@pGrid.lpICPCVtbl)  =  4468972
    Varptr(@pGrid.lpICPVtbl)   =  4468976
    @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 =  4468968
    Leaving IGrid_QueryInterface()
    @ppv                       =  4468968  << After QueryInterface() Call
  Leaving IClassFactory_CreateInstance()

  Entering IClassFactory_Release()
    g_lObjs =  2
  Leaving IClassFactory_Release()

  Successfully Created FHGrid2.Grid! :  pGrid2 =  4468968

  Entering IGrid_CreateGrid()
    this           =  4468968
    hContainer     =  525212
    strSetup       =  120:Column 1:^,130:Column 2:^,140:Column 3:^,150:Column 4:^,160:Column 5:^
    x              =  10
    y              =  300
    cx             =  570
    cy             =  218
    iRows          =  12
    iCols          =  5
    iRowHt         =  28
    strFontName    = Courier New
    GetLastError() =  0
    hGrid          =  852706
  Leaving IGrid_CreateGrid()

  pSink2         =  4464732                     '<<< ...and this would be the address of the "GridEvents2" Class
  Objptr(pSink2) =  4464732

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

  Entering IConnectionPointContainer_FindConnectionPoint()
    this  =  4468972
    @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 =  4468976
  Leaving IConnectionPointContainer_FindConnectionPoint()

  Entering IConnectionPoint_Advise()!  Grab Your Hardhat And Hang On Tight!
    this            =  4468976
    pGrid           =  4468968
    @pGrid.hControl =  852706
    pUnkSink        =  4464732                  '<<< ...and here is where the address of "GridEvents2" came into the Advise()
    @pUnkSink       =  2111469                  '<<< method of Grid #2.
    Vtbl            =  2111469
    @Vtbl[0]        =  2117560
    dwPtr           =  4464732
    Call Dword Succeeded!
  Leaving IConnectionPoint_Advise() And Still In One Piece!

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

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

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


Got KeyPress From Grid! 102=f
Got KeyPress From Grid! 114=r
Got KeyPress From Grid! 101=e
Got KeyPress From Grid! 100=d

Entering fnWndProc_OnCommand()
  Cell 3,2 Contains fred
Leaving fnWndProc_OnCommand()

Got KeyPress From Grid! 104=h
Got KeyPress From Grid! 97=a
Got KeyPress From Grid! 114=r
Got KeyPress From Grid! 114=r
Got KeyPress From Grid! 105=i
Got KeyPress From Grid! 115=s

Entering fnWndProc_OnCommand()
  Cell 3,2 Contains harris
Leaving fnWndProc_OnCommand()


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

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

  Entering IConnectionPoint_Unadvise()
    this            =  4457944
    @pGrid.hWndCtrl =  197568
    dwPtr           =  4464900
    IGrid_Events::Release() Succeeded!
    Release() Returned  1
  Leaving IConnectionPoint_Unadvise()

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

  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
    @pGrid.m_cRef = 0   << After
    Grid Was Deleted!
  Leaving IGrid_Release()
Leaving fnWndProc_OnCommand()


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

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

  Entering IConnectionPoint_Unadvise()
    this            =  4468976
    @pGrid.hWndCtrl =  852706
    dwPtr           =  4464732
    IGrid_Events::Release() Succeeded!
    Release() Returned  1
  Leaving IConnectionPoint_Unadvise()

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

  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
    @pGrid.m_cRef = 0   << After
    Grid Was Deleted!
  Leaving IGrid_Release()
Leaving fnWndProc_OnCommand()

Entering fnWndProc_OnClose() In Host
  Entering DllCanUnloadNow()
    I'm Outta Here! (dll is unloaded)
  Leaving DllCanUnloadNow()
Leaving fnWndProc_OnClose() In Host
Title: Re: Grid Custom Control Project - Converting It To COM
Post by: Frederick J. Harris on August 13, 2011, 05:34:52 AM
     Well, that problem has I believe been solved.  The next problem to solve is harder, and I ran into this one as soon as I tried to use the control in Visual Basic.   In all the clients I've shown so far we first started the grid creation by creating an instance of the control through PowerBASIC's NewCom function, then we called its Initialize() method, followed by a creation call such as CreateGrid() or whatever I used above.   Having a Windows 'Custom Control' mindset, that seemed a reasonable way to proceed.  The problem is that it imposes a particular order in which these steps must be followed that Visual Basic doesn't honor.  That language is setup in such a manner that the creation of the object and its linkage to the sink must be setup simultaneously.  I'm getting ahead of myself here, but here is a .NET 3.5 Visual Basic program that won't work with the code I've shown so far...

Code: [Select]
Public Class frmFHGrid3
  Public WithEvents pGrid As New FHGrid3Library.FHGrid3

  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.Create(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 btnGetText_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnGetText.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 System.Object, ByVal e As System.EventArgs) Handles btnDestroyGrid.Click
    pGrid = Nothing
  End Sub
End Class

The problem is this global/public declaration, which is where .NET will set up both the object and its connection to a sink before the CreateWindowEx() call that creates the grid!

Code: [Select]
Public WithEvents pGrid As New FHGrid3Library.FHGrid3

Don't forget that we are now storing the Sink pointer within the instantiated grid Window Class.   When Visual Basic calls IConnectionPoint::Advise() there will be no window created as of yet into which my Advise() method in my server can store a client sink's address.  This is a bad one, and will cause us to have to do some ripping and tearing and rearranging!  So we'll save that for version #3!
Title: Re: Grid Custom Control Project - Converting It To COM
Post by: Dominic Mitchell on August 13, 2011, 03:08:30 PM
This is a topic I would really like to get into, but I am too busy with Phoenix at the moment.

Quote
In that code the address of g_ptrOutGoing was passed back to the client in a QueryInterface() call on the client's sink class,
and was thereby initialized in the server for later callback purposes.  What we'll do here in our modification is pass through
to the client a local instead, i.e., dwPtr below, and within the procedure immediately store it at offset 4 in the grid's .
A global variable was bad, but this is no better.  You seem to have forgotten that, for an instance of an object, more than one
client can be connected to the same outgoing interface. This is why the cookie is very important.  It is also why this code

Code: [Select]
  IF SUCCEEDED(hr) THEN
     #IF %DEF(%DEBUG)
     Prnt "    Call Dword Succeeded!"
     #ENDIF
     @pdwCookie=1
  ELSE
     @pdwCookie=0
  END IF
 

leaves me scratching my head.  The cookie in this code is almost useless.

Why not store a pointer to an array or linked-list of connections on the grid object itself? For example,

Code: [Select]
TYPE CGrid
  lpIGridVtbl                         AS IGridVtbl PTR
  lpICPCVtbl                          AS IConnectionPointContainerVtbl PTR
  lpICPVtbl                           AS IConnectionPointVtbl PTR
 
  m_pConnections                      AS DWORD
   
  hWndCtrl                            AS DWORD
  m_cRef                              AS LONG
END TYPE
         
Where connection is  defined as     

Code: [Select]
TYPE Connection
  dwCookie  AS DWORD
  pAdvise   AS DWORD
  riid      AS GUID       ' Outgoing interface
END TYPE

Then IConnectionPoint::Advise and IConnectionPoint::Unadvise would be coded as shown below. 
The code below uses an array(not a PowerBASIC "array", because I never use that).
Notice that the lookup is based on the cookie.

Code: [Select]

'-------------------------------------------------------------------------------
'
' PROCEDURE: treeIConnectionPoint_Advise
' PURPOSE:   Establishes a connection between the connection point object
'            and the client's sink.
' RETURN:
'
'-------------------------------------------------------------------------------

FUNCTION treeIConnectionPoint_Advise _
  ( _
  BYVAL pThis     AS DWORD, _ ' [IN] IConnectionPoint interface pointer
  BYVAL pUnkSink  AS DWORD, _ ' [IN] Pointer to the IUnknown interface on the client's advise sink
        pdwCookie AS DWORD _  ' [OUT] Pointer to a returned token that uniquely identifies this connection
  ) AS LONG

  LOCAL pCIFace     AS CIFace PTR
  LOCAL pTreeCtl    AS ITreeControl PTR
  LOCAL plCount     AS LONG PTR
  LOCAL pConnect    AS Connection PTR
  LOCAL pSink       AS DWORD
  LOCAL dwCookie    AS DWORD
  LOCAL iConnect    AS LONG
  LOCAL hr          AS LONG

  EnterCriticalSection g_lpcs

  pCIFace  = pThis
  pTreeCtl = @pCIFace.pObject

SaveToLog "IConnectionPoint::Advise"

  IF (pUnkSink = %NULL) OR (VARPTR(pdwCookie) = %NULL) THEN
    FUNCTION = %E_POINTER
    EXIT FUNCTION
  END IF

  hr = %CONNECT_E_CANNOTCONNECT

  ' Check for the right interface on the sink
  hr = IUnknown_QueryInterface(pUnkSink, @pCIFace.riid, pSink)
  IF hr = %S_OK THEN
    IF @pTreeCtl.m_pConnections THEN
      plCount  = @pTreeCtl.m_pConnections
      iConnect = @plCount
    END IF
    dwCookie = TreeControl_GetNextCookie(pThis)
    @pTreeCtl.m_pConnections = Tree_ItemInsert(GetProcessHeap(), 1, @pTreeCtl.m_pConnections, SIZEOF(@pConnect), iConnect)
    IF @pTreeCtl.m_pConnections THEN
      pConnect = @pTreeCtl.m_pConnections + 4
      @pConnect[iConnect].dwCookie = dwCookie
      @pConnect[iConnect].riid     = @pCIFace.riid
      ComPtrAssign @pConnect[iConnect].pAdvise, pSink
      hr = %S_OK
    ELSE
      hr = %E_OUTOFMEMORY
    END IF
  END IF

  pdwCookie = dwCookie

  LeaveCriticalSection g_lpcs

  FUNCTION = hr

END FUNCTION

'-------------------------------------------------------------------------------

FUNCTION treeIConnectionPoint_Unadvise _
  ( _
  BYVAL pThis     AS DWORD, _ ' [IN] IConnectionPoint interface pointer
  BYVAL dwCookie  AS DWORD _  ' [IN] Connection token previously returned from IConnectionPoint::Advise
  ) AS LONG

  LOCAL pCIFace     AS CIFace PTR
  LOCAL pTreeCtl    AS ITreeControl PTR
  LOCAL plCount     AS LONG PTR
  LOCAL pConnect    AS Connection PTR
  LOCAL iConnect    AS LONG
  LOCAL hr          AS LONG

  EnterCriticalSection g_lpcs

  pCIFace  = pThis
  pTreeCtl = @pCIFace.pObject

SaveToLog "IConnectionPoint::Unadvise"

  IF dwCookie = 0 THEN
    FUNCTION = %E_INVALIDARG
    EXIT FUNCTION
  END IF

  hr = %CONNECT_E_NOCONNECTION

  IF @pTreeCtl.m_pConnections THEN
    plCount  = @pTreeCtl.m_pConnections
    pConnect = @pTreeCtl.m_pConnections + 4
    iConnect = 0

    DO
      IF iConnect >= @plCount THEN EXIT DO
      IF @pConnect[iConnect].dwCookie = dwCookie THEN
        @pConnect[iConnect].dwCookie  = 0
        ComPtrAssign @pConnect[iConnect].pAdvise, %NULL
        @pTreeCtl.m_pConnections = Tree_ItemDelete(GetProcessHeap(), 1, @pTreeCtl.m_pConnections, SIZEOF(@pConnect), iConnect)
        hr = %S_OK
        EXIT DO
      END IF
      INCR iConnect
    LOOP

  END IF

  LeaveCriticalSection g_lpcs

  FUNCTION = hr

END FUNCTION

Quote
At offset 0 is a pointer to a GridData structure that maintains state for each instance of the grid.

To clarify, this would be each instance of the window. Information such as default font, size and position,
miscellaneous bits cannot be stored here.  Depending on the value of the miscellaneous bits, if the control
is not inplace activated, there will no window but rather a metafile image.   

The GridData structure should have a pointer to the grid object for easy access when notifying the client
of events that happen in the window.

Quote
  'Grid #1
  LET pGrid1 = NEWCOM "FHGrid2.Grid"
  CALL pGrid1.Initialize()
  strFontName="Times New Roman"
  strSetup="120:Column 1:^,130:Column 2:^,140:Column 3:^,150:Column 4:^,160:Column 5:^"
  pGrid1.CreateGrid(Wea.hWnd,strSetup,10,10,570,218,12,5,28,strFontName,18,%FW_DONTCARE)

In my opinion, this is a very odd way to create an ActiveX control.
Why do you need to do NEWCOM followed by a CreateGrid method?


Title: Re: Grid Custom Control Project - Converting It To COM
Post by: Frederick J. Harris on August 13, 2011, 07:33:15 PM
Quote
This is a topic I would really like to get into, but I am too busy with Phoenix at the moment.

Yes, keep working on Phoenix.  I'd like to have one of those when you have it ready.

I imagine we'll have time to discuss this all.  I've been thinking about this and working on it on and off for years. 

Quote
You seem to have forgotten that, for an instance of an object, more than one
client can be connected to the same outgoing interface.

I didn't forget it.  I simply don't understand its use, purpose, or relavance in the case of an in process visual control as opposed to an out of process server which can be set up in various ways to either create one process which all connections share or launch a new process for each connection.  That is why I gave the story in either my version #1 or version #2 of the control about the stock market object keeping track of multiple connection points and multiple connections to each connection point.  The purpose of that story was to introduce the issue and provide an arguement that it simply didn't apply in the case of visual COM based controls.  I admit I might be wrong.  I could be wrong about just about anything.

However, let me phrase my arguement this way.  Perhaps you can explain to me the errors in this arguement.  Lets forget COM for a moment and just consider five button controls on an Sdk window.  And keep in mind that I'll be making an analogy between buttons and COM Controls/ActiveX controls.  When the user clicks button #1 Windows sends the Window Procedure a WM_COMMAND message with the identifier, i.e., control id of the button, in a parameter of the message.  What it doesn't do is send five messages, one to each button, informing it that button #1 was clicked.  No doubt Windows 'knows' that the parent form/dialog has five buttons on it - its probably storing their handles in some sort of memory structure like you suggest, but it nontheless only sends one message - not five. 

It appears to me that the Connection Point concept was made extremely general so that it could handle any type of client/server topology, and one of those designs/topologies is indeed one where a server will be notifying multiple sinks and maintaing pointers to them in some sort of array type structure.  But it also appears to me that other cases exist where there is a simple one to one relationship between client sink and server.  That is the scenario I feel exists in the case of visual COM objects.  As I said, I may simply be wrong and I accept that.  I fully realize you know more about this than I do Dominic, so perhaps you could explain to me how I am wrong. 

So far, in all the tests I have made, the one thing I haven't checked yet is launching multiple client processes loading my grid at the same time.  In other words, in my version #2 which I just posted last night  (August 12, 2011) around midnight, I provided I think PBClient1_v2.bas that instantiates two grids on the form, and my console output using PowerBASIC's COM implementation shows correct reference counting, object creation and destruction, and dll unloading.  But what if I start five PBClient1_v2.exes at the same time?  I'll try it shortly.  Perhaps that is where my design will fail.  I think not - but I could be wrong of course.  I haven't tried that yet.

Just this morning I was thinking of something you toild me last year I think Dominic.  You couldn't understand why I was putting my code using CodePtr() to attach the methods to the VTables in DllGetClassObject().  I believe you felt that ought to go in CreateInstance().  My reason for putting it in DllGetClassObject() was that I felt the attachments only needed to be performed once since the function addresses wouldn't change during a program load.  However, in instantiating two instances of my grid I see PowerBASIC doesn't appear to be using CoGetClassObject() but rather CoCreateInstance() two times, with the class factory being loaded and released twice.  Therefore, I think I'm going to move that code to DllMain() so the attachment will only occur once - when the dll is loaded.  Of course it will occur uselessly when RegisterServer() is called by RegSvr32, but that's no big deal.

In terms of your last comment about  NewCom() followed by creating the grid, I'll be changing that significantly in version #3 so that my control works in Visual Basic.  Also, in terms of your comment about the loading of a default metafile, don't forget I'm not creating this control to provide drag and drop embedding functionality in visual designers at design time.  I'm hoping it will work fine with you Phoenix but will provide no design time functionality. 
Title: Re: Grid Custom Control Project - Converting It To COM
Post by: Frederick J. Harris on August 13, 2011, 09:03:00 PM
     I've just experimented with PBClient1_v2.bas (a client which instantiates two grids on a form), and I started two instances of the program.  Since each had its own process and each allocated a console, I ended up with four windows on my screen - two consoles and two GUI programs with a total of four grids.  Far as I can tell, everything is working correctly.  First time I tested that.

     Consider my 'one sink per one object' rule for a moment.  In a client instantiating two grids there will be a sink class for each grid, i.e., CGridEvents1 and CGridEvents2...

Code: [Select]
Class CGridEvents1 As Event
  Interface IGridEvents $IID_IGridEvents :  Inherit IAutomation
    Method Grid_OnKeyPress(Byval KeyCode As Long)
      Prnt "Got KeyPress From Grid!" & Str$(KeyCode) & "=" & Chr$(KeyCode)
    End Method

    Method Grid_OnKeyDown(Byval KeyCode As Long)
      ' Insert your code here
    End Method

    Method Grid_OnLButtonDown(Byval iRow As Long, Byval iCol As Long)
      ' Insert your code here
    End Method

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

    Method Grid_OnPaste(Byval iRow 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))
    End Method
  End Interface
End Class


Class CGridEvents2 As Event
  Interface IGridEvents $IID_IGridEvents :  Inherit IAutomation
    Method Grid_OnKeyPress(Byval KeyCode As Long)
      Prnt "Got KeyPress From Grid!" & Str$(KeyCode) & "=" & Chr$(KeyCode)
    End Method

    Method Grid_OnKeyDown(Byval KeyCode As Long)
      ' Insert your code here
    End Method

    Method Grid_OnLButtonDown(Byval iRow As Long, Byval iCol As Long)
      ' Insert your code here
    End Method

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

    Method Grid_OnPaste(Byval iRow 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))
    End Method
  End Interface
End Class

One might consider this to be wasteful and conducive to bloat, but consider that if multiple grids send event notifications to one sink, then one will need conditional decision making logic to parse out the correct object to which a call applies, i.e....

Code: [Select]
Class CGridEventsForAllGrids As Event
  Interface IGridEvents $IID_IGridEvents :  Inherit IAutomation
    Method Grid_OnKeyPress(Byval KeyCode As Long, Byval iCtrlId As Long)
      If iCtrlId=x Then
         Prnt "Got KeyPress From Grid x!" & Str$(KeyCode) & "=" & Chr$(KeyCode)
      Else
         Prnt "Got KeyPress From Grid y!" & Str$(KeyCode) & "=" & Chr$(KeyCode)
      End If
    End Method

    Method Grid_OnKeyDown(Byval KeyCode As Long, Byval iCtrlId As LongiCtrl)
      If iCtrlId=x Then
         Prnt "Got KeyPress From Grid x!" & Str$(KeyCode) & "=" & Chr$(KeyCode)
      Else
         Prnt "Got KeyPress From Grid y!" & Str$(KeyCode) & "=" & Chr$(KeyCode)
      End If
    End Method

    Method Grid_OnLButtonDown(Byval iRow As Long, Byval iCol As Long, Byval iCtrlId As Long)
      If iCtrlId=x Then
         Prnt "Got KeyPress From Grid x!" & Str$(KeyCode) & "=" & Chr$(KeyCode)
      Else
         Prnt "Got KeyPress From Grid y!" & Str$(KeyCode) & "=" & Chr$(KeyCode)
      End If
    End Method

    Method Grid_OnLButtonDblClk(Byval iRow As Long, Byval iCol As Long, Byval iCtrlId As Long)
      If iCtrlId=x Then
         Prnt "Got KeyPress From Grid x!" & Str$(KeyCode) & "=" & Chr$(KeyCode)
      Else
         Prnt "Got KeyPress From Grid y!" & Str$(KeyCode) & "=" & Chr$(KeyCode)
      End If
    End Method

    Method Grid_OnPaste(Byval iRow As Long, Byval iCol As Long, Byval iCtrlId As Long)
      If iCtrlId=x Then
         Prnt "Got KeyPress From Grid x!" & Str$(KeyCode) & "=" & Chr$(KeyCode)
      Else
         Prnt "Got KeyPress From Grid y!" & Str$(KeyCode) & "=" & Chr$(KeyCode)
      End If
    End Method

    Method Grid_OnVButtonClick(Byval iCellRow As Long, Byval iGridRow As Long, Byval iCtrlId As Long)
      If iCtrlId=x Then
         MsgBox("You Clicked In Grid x For Row #" & Str$(iGridRow))
      Else
        MsgBox("You Clicked In Grid y For Row #" & Str$(iGridRow))
      End If
    End Method
  End Interface
End Class

My father had an expression - 'its six of one and half a dozen of another', to mean it doesn't make
much difference, and in this case that is the way I see it.  The amount of code will be roughly
equivalent, but the code is cleaner and the logic more obvious if one sticks to my 'one sink per one
object' rule.

     I think your idea of storing a pointer to my sink within the GridData Type I have is an excellent idea.  It pertains to each instance of the grid just as every other member does, so why not?  Yes, I'll implement that.   And I've moved my CodePtr() code which attaches member functions to the VTables out of DllGetClassObject() as you recommended last year Dominic.  However, I'm not sure you'll feel where I've moved it to is better! :(

     If you could come up with an idea of a client program which would cause my COM Object to fail in some way Dominic, I'll try to implement it.  Consider that in Version #3 of the control which I haven't yet posted I'll be attaching the sink at object creation and my Create() member will be setting the rows, columns, fonts, etc.  Somewhat different from versions 1 and 2.
Title: Re: Grid Custom Control Project - Converting It To COM
Post by: Frederick J. Harris on August 13, 2011, 10:09:17 PM
A book that has been extremely useful to me in learning about COM is Guy And Henry Eddon’s book “Inside Distributed COM” by Microsoft Press.   I found it for two or three dollars in a local used book Store and the CD was unopened!   Anyway, here is something they have to say that might pertain to the issues you and I are discussing…

Quote
Multicasting With Connection Points

“While it is typical, a one to one relationship is not the rule between a client and a connectable object.  The connection point architecture is generic enough to support a connectable object that fires events at multiple sinks or to support a sink that gets hooked up to several connectable objects.”

Their point of departure for that statement is somewhat different from mine, however, because I’m maintaining and arguing that for visual COM based controls (such as my grid control) implementing connection points a ‘one to one’ relationship is the only architecture that makes sense.

Eddon's book is the only one I've found that uses raw Win32 non-Atl code to show a full implementation of the connection point architecture with all the enumerators fully implemented.   Most books show or discuss a partial implementation (like mine) and then go on to state that a full implementation is far to complex to develop without tool support such as the Active Template Library ( Atl ) or Microsoft Foundation Classes ( Mfc ).  Of course, none of that helps us PowerBASIC coders!
Title: Re: Grid Custom Control Project - Converting It To COM
Post by: Dominic Mitchell on August 13, 2011, 10:43:28 PM
Quote
However, let me phrase my arguement this way.  Perhaps you can explain to me the errors
in this arguement.  Lets forget COM for a moment and just consider five button controls
on an Sdk window.  And keep in mind that I'll be making an analogy between buttons and
COM Controls/ActiveX controls.
Your analogy is flawed. A button(server) and can only be connected to one client(its parent)
at a time.

It does not have to be multiple clients connecting to your outgoing interface, it can be the
same client calling IConnectionPoint::Advise/Unadvise more than once.

Take the following scenario:
1) An instance of your grid on a main form.
2) IConnectionPoint::Advise is called from main form to monitor some of the events.
3) A second temporary form is created that will interact with the grid in some way.
4) This secondary form might be some type of editor(created and destroyed many times) while app is running.
4) Second form calls IConnectionPoint::Advise to monitor events that are not necessarily the same as those monitored by main form.
5) Second form calls IConnectionPoint::Unadvise when it closes.

What do you think is going to happen when the second form closes?
Title: Re: Grid Custom Control Project - Converting It To COM
Post by: Frederick J. Harris on August 14, 2011, 06:36:33 PM
Yep, it'll crash sooner or later.  Towards the end of my version #1 of the COM based grid control I believe I stated pretty clearly that these control examples will be based on a one to one relationship between sink and server.  In other words, it would work similarly to the messaging in a standard window procedure.

I agonized over this decision for quite some time.  The context of my quandary over this is that I wished to present the code necessary to show how a custom control could be converted to a COM based control.  Using COM, object construction, lifetime management, messaging, and destruction are considerably different than with custom controls.  With a custom control, the typical behavior is for the control to send notifications back to its parent wrapped up in the WM_NOTIFY message.  I think a fair number of PowerBASIC programmers are familiar with this.  Now it is true that if one wanted to do so one could add extra complexity to a custom control to send multiple messages back to various window procedures within the client app when a single event occurred in the control.  To do so the control would simply need to manage some kind of array of window handles much like your code manages a dynamic array of sink objects within a tree view control or tree view structure.  However, while I have no way of knowing for sure, I expect this has seldom if ever been done or implemented with custom controls.  Perhaps someone will inform me differently.

Therefore, when I looked at the connection point design and saw that it allowed for what you just described, i.e., an instance of a control calling into multiple sinks, my take on it was not particularly positive.   In terms of benefit - cost analysis, my thoughts were, "This looks pretty complicated.  What are the benefits and what are the costs?"

The benefits appeared to me to be too low to justify the costs.  Nonetheless, since it was a part of COM's design to be flexible enough to allow for this architecture, I felt I should at least give somewhat more than passing mention of it in this tutorial.  That is why I devoted at least a whole page to discussing it near the end of version #1 of the grid control where I gave the stock market example and showed some code to give the reader an example of how the control might be set up to manage multiple sinks.  My feelings were that if any reader was interested enough in the topic he/she could use those code ideas I presented to pursue the topic further. 

My opinion of the example you gave is that it is pretty 'contrived'.  I would have never thought to do something like that.   I'll likely keep it in mind in my future coding, however.  It might very well be an ideal solution for some applications.  If that is the case then a control with the ability to manage multiple sinks and fire events at them is a good idea. 

My intention in presenting this grid custom control example and converting it to COM was to show that there is indeed a 'middle ground' between simple IUnknown based worker objects and full blown OCXs  with 16+ interfaces implemented that work in the VB4 - 6 design environment.  In coming up with that 'middle ground' solution I had to accept that some parts of the COM model were fundamental and had to be implemented, and other parts were optional and could remain unimplemented.   COM allows for this, i.e., %E_NOTIMPL.  I think Microsoft eventually came to that conception also, realizing that a component developer shouldn't be required to implement more interfaces than is required to achieve the design goals of a component. 
Title: Re: Grid Custom Control Project - Converting It To COM
Post by: Frederick J. Harris on August 15, 2011, 04:24:36 PM
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.
Title: Re: Grid Custom Control Project - Converting It To COM
Post by: Dominic Mitchell on August 16, 2011, 01:24:16 PM
Quote

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.
Title: Re: Grid Custom Control Project - Converting It To COM
Post by: Frederick J. Harris on August 16, 2011, 04:32:29 PM
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.
Title: Re: Grid Custom Control Project - Converting It To COM
Post by: Dominic Mitchell on August 16, 2011, 05:29:23 PM
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.
Title: Re: Grid Custom Control Project - Converting It To COM
Post by: Frederick J. Harris on August 16, 2011, 08:31:39 PM
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.   
Title: Re: Grid Custom Control Project - Converting It To COM
Post by: Frederick J. Harris on August 17, 2011, 07:08:10 PM
     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]
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]
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]
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]
%MAX_CONNECTIONS    = 4   'Maximum number of sinks which can be hooked up to connection point
....
....

Code: [Select]
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]
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]
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]
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]
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]
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]
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]
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]
'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

Title: Re: Grid Custom Control Project - Converting It To COM
Post by: Frederick J. Harris on August 17, 2011, 07:15:25 PM
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]
#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
Title: Re: Grid Custom Control Project - Converting It To COM
Post by: Frederick J. Harris on August 17, 2011, 07:18:34 PM
Code: [Select]
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
Title: Re: Grid Custom Control Project - Converting It To COM
Post by: Frederick J. Harris on August 17, 2011, 07:23:35 PM
Code: [Select]
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
Title: Re: Grid Custom Control Project - Converting It To COM
Post by: Frederick J. Harris on August 17, 2011, 07:27:15 PM
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.
Title: Re: Grid Custom Control Project - Converting It To COM
Post by: Frederick J. Harris on August 22, 2011, 07:34:23 PM
     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]
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


Title: Re: Grid Custom Control Project - Converting It To COM
Post by: Frederick J. Harris on August 22, 2011, 07:39:27 PM
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]
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]
#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…
Title: Re: Grid Custom Control Project - Converting It To COM
Post by: Frederick J. Harris on August 22, 2011, 07:45:13 PM
Code: [Select]
//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]
//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]
//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]
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]
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]
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]
//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]
@pGrid.m_cRef =  3  << After

continued....
Title: Re: Grid Custom Control Project - Converting It To COM
Post by: Frederick J. Harris on August 22, 2011, 07:51:20 PM
....continued

Here’s the program run…

Code: [Select]
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]
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]
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]
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]
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]
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]
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....

Title: Re: Grid Custom Control Project - Converting It To COM
Post by: Frederick J. Harris on August 22, 2011, 08:06:38 PM
Code: [Select]
'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........
Title: Re: Grid Custom Control Project - Converting It To COM
Post by: Frederick J. Harris on August 22, 2011, 08:16:16 PM
Code: [Select]
Entering fnWndProc_OnCreate()
  Entering DllGetClassObjectImpl()
    Entering IClassFactory_QueryInterface()
      Entering IClassFactory_AddRef()
        g_lObjs =  1
      Leaving IClassFactory_AddRef()
      this =  2693828
    Leaving IClassFactory_QueryInterface()
    IClassFactory_QueryInterface() For iid Succeeded!
  Leaving DllGetClassObjectImpl()

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

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

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

  Entering IClassFactory_Release()
    g_lObjs =  1
  Leaving IClassFactory_Release()

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

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

  pVnt =  5499240

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

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

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

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

  pVnt =  4345408

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

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

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

  pVnt =  4345432

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

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

  Objptr(pSink) =  4338092

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

  dwCookie      =  0
Leaving fnWndProc_OnCreate()


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

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


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

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


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

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

    hr =  0

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

    iCnt =  3
    pVnt =  4345408

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

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

    iCnt =  0
    pVnt =  5499240

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

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

    iCnt =  3
  Leaving DestroyGrid()

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

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


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

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

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

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

     If you followed my discussions above