IT-Consultant: Frederick J. Harris > Fred's COM (Component Object Model) Tutorials
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: ---#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