IT-Consultant: Frederick J. Harris > Fred's COM (Component Object Model) Tutorials

Grid Custom Control Project - Converting It To COM

(1/13) > >>

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: ---#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

--- End code ---

Frederick J. Harris:
2nd Half...


--- Code: ---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

--- End code ---

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
 

Navigation

[0] Message Index

[#] Next page

Go to full version