Grid Custom Control Project - Converting It To COM

[Frederick J. Harris]

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…

[Frederick J. Harris]

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


[Frederick J. Harris]

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


[Frederick J. Harris]

Here is a zip containing the dll custom control, a host to take a look at it, and the source for the control...

[James C. Fuller]

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
 

[Frederick J. Harris]

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.

[James C. Fuller]

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

[Frederick J. Harris]

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.

[James C. Fuller]

Fred,
  It's a dll, version 3.0; no longer available and probably not supported any more.

James

[Frederick J. Harris]

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

[Frederick J. Harris]

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

[Frederick J. Harris]

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

[Frederick J. Harris]

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!

[Frederick J. Harris]

     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…

[Frederick J. Harris]

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