Last but not least here is a PowerBASIC client that will work with a registered FHGrid.dll in x86 flavor. Of course, one could do a registry free load too. This is the one that came in 25K. Note there is a Combo Box in Column 5. To make the combo box column easier toi use pull cols 1, 2 or 3 left to make them smaller. This will cause the horizontal scrollbar to disappear. Then widen column 5. If you want, stretch the other columns back. Just thought I'd mention that because it might not be immediately obvious.
#Compile Exe "PBClient32.exe"
#Dim All
%UNICODE = 1
'%Debug = 1 ' Uncomment this to produce a console window for Debug Output.
#If %Def(%UNICODE)
Macro ZStr = WStringz
Macro BStr = WString
%SIZEOF_CHAR = 2
#Else
Macro ZStr = Asciiz
Macro BStr = String
%SIZEOF_CHAR = 1
#EndIf
$CLSID_FHGrid = GUID$("{30000000-0000-0000-0000-000000000000}")
$IID_IFHGrid = GUID$("{30000000-0000-0000-0000-000000000001}")
$IID_IGridEvents = GUID$("{30000000-0000-0000-0000-000000000002}")
%IDC_RETRIEVE = 1500
%IDC_GET_SELECTED_ROW = 1505
%IDC_GET_ROW_COUNT = 1510
%IDC_SET_ROW_COUNT = 1515
%IDC_GET_HCELL = 1520
%IDC_COLOR_SOME_ROWS = 1525
%IDC_UNLOAD_GRID = 1530
%IDC_TEST_LBUTTONDOWN = 1525
%NUMBER_ROWS = 12
%NUMBER_COLUMNS = 5
#Include "Win32Api.inc"
Type GridInterfaces
pGrid1 As Dword Ptr
dwCookie1 As Dword
End Type
Type WndEventArgs
wParam As Long
lParam As Long
hWnd As Dword
hInst As Dword
End Type
Declare Function FnPtr(wea As WndEventArgs) As Long
Type MessageHandler
wMessage As Long
dwFnPtr As Dword
End Type
Macro CObj(pUnk, dwAddr) = Poke Dword, Varptr(pUnk), dwAddr
#If %Def(%Debug)
Sub Prnt(strLn As BStr)
Local iLen, iWritten As Long
Local hStdOutput As Dword
Local strNew As BStr
hStdOutput=GetStdHandle(%STD_OUTPUT_HANDLE)
strNew=strLn + $CrLf
iLen = Len(strNew)
WriteConsole(hStdOutput, Byval Strptr(strNew), iLen, iWritten, Byval 0)
End Sub
#EndIf
Interface IGrid $IID_IFHGrid : Inherit IAutomation
Method CreateGrid _
( _
Byval hParent As Long, _
Byval strSetup As BStr, _
Byval x As Long, _
Byval y As Long, _
Byval cx As Long, _
Byval cy As Long, _
Byval iRows As Long, _
Byval iCols As Long, _
Byval iRowHt As Long, _
Byval iSelectionBackColor As Long, _
Byval iSelectionTextColor As Long, _
Byval strFontName As BStr, _
Byval iFontSize As Long, _
Byval iFontWeight As Long _
)
Method SetRowCount(Byval iRowCount As Long, Byval blnForce As Long)
Method GetRowCount() As Long
Method SetData(Byval iRow As Long, Byval iCol As Long, Byval strData As WString)
Method GetData(Byval iRow As Long, Byval iCol As Long) As WString
Method FlushData()
Method Refresh()
Method GetVisibleRows() As Long
Method GethGrid() As Long
Method GethCell(Byval iRow As Long, Byval iCol As Long) As Long
Method GethComboBox(Byval iCol As Long) As Long
Method SetCellAttributes(Byval iRow As Long, Byval iCol As Long, Byval iBackColor As Long, Byval iTextColor As Long) As Long
Method DeleteRow(Byval iRow As Long)
End Interface
Class CGridEvents As Event
Instance hMain As Dword
Class Method Create()
#If %Def(%Debug)
Prnt " Called Class Method Create()!"
#EndIf
hMain=FindWindow("Grid Test","Grid Test")
#If %Def(%Debug)
Prnt " hMain = " & Str$(hMain)
Prnt " Leaving Class Method Create()
#EndIf
End Method
Interface IGridEvents $IID_IGridEvents : Inherit IAutomation
Method Grid_OnKeyPress(Byval iKeyCode As Long, Byval iKeyData As Long, Byval iRow As Long, Byval iCol As Long, Byref blnCancel As Long)
#If %Def(%Debug)
Prnt "Got KeyPress From CGridEvents1!" & Str$(iKeyCode) & "=" & Chr$(iKeyCode)
#EndIf
End Method
Method Grid_OnKeyDown(Byval iKeyCode As Long, Byval iKeyData As Long, Byval iCellRow As Long, Byval iGridRow As Long, Byval iCol As Long, Byref blnCancel As Long)
#If %Def(%Debug)
Prnt "Got KeyDown From CGridEvents!" & Str$(iKeyCode) & "=" & Chr$(iKeyCode)
#EndIf
End Method
Method Grid_OnLButtonDown(Byval iCellRow As Long, Byval iGridRow As Long, Byval iCol As Long)
#If %Def(%Debug)
Prnt "Got WM_LBUTTONDOWN In Grid Cell From CGridEvents1" & "(" & Trim$(Str$(iGridRow)) & "," & Trim$(Str$(iCol)) & ")"
#EndIf
End Method
Method Grid_OnLButtonDblClk(Byval iCellRow As Long, Byval iGridRow As Long, Byval iCol As Long)
' Insert your code here
End Method
Method Grid_OnPaste(Byval iCellRow As Long, Byval iGridRow As Long, Byval iCol As Long)
' Insert your code here
End Method
Method Grid_OnRowSelection(Byval iRow As Long, Byval iAction As Long)
#If %Def(%Debug)
Prnt " Entering Grid_OnRowSelection(GridEvents)"
Prnt " iRow = " & Str$(iRow)
Prnt " iAction = " & Str$(iAction)
#EndIf
If iAction Then
Call SetWindowLong(hMain,4,iRow)
Else
Call SetWindowLong(hMain,4,0)
End If
#If %Def(%Debug)
Prnt " Leaving Grid_OnRowSelection(GridEvents)"
#EndIf
End Method
Method Grid_OnDelete(Byval iRow As Long)
Local pGridInterfaces As GridInterfaces Ptr
Local pGrid As IGrid
#If %Def(%Debug)
Prnt " Entering Grid_OnDelete()"
Prnt " iRow = " & Str$(iRow)
#EndIf
pGridInterfaces=GetWindowLong(hMain,0)
If pGridInterfaces Then
If @pGridInterfaces.pGrid1 Then
CObj(pGrid,@pGridInterfaces.pGrid1)
Call pGrid.AddRef()
Call pGrid.DeleteRow(iRow)
Call pGrid.Refresh()
End If
End If
#If %Def(%Debug)
Prnt " Leaving Grid_OnDelete()"
#EndIf
End Method
End Interface
End Class
Function fnWndProc_OnCreate(Wea As WndEventArgs) As Long 'Offset Item in WNDCLASSEX::cbWndExtraBytes
Local pConnectionPointContainer As IConnectionPointContainer '================================================
Local pGridInterfaces As GridInterfaces Ptr '0 - 3 GridInterfaces Ptr - pGridInterfaces
Local pConnectionPoint As IConnectionPoint '4 - 7 Row Selected
Local pCreateStruct As CREATESTRUCT Ptr '8 - 11 hGrid
Local strSetup,strCoordinate As BStr
Local pSink As IGridEvents
Local EventGuid As Guid
Local dwCookie As Dword
Local szName As ZStr*16
Local pGrid As IGrid
Local hCtl As Dword
Register i As Long
Register j As Long
Local hr As Long
#If %Def(%Debug)
Call AllocConsole()
Prnt "Entering fnWndProc_OnCreate()"
#EndIf
pCreateStruct=wea.lParam : wea.hInst=@pCreateStruct.hInstance
pGridInterfaces=GlobalAlloc(%GPTR,sizeof(GridInterfaces))
If pGridInterfaces=0 Then
MsgBox("Memory Allocation Failure")
Function=-1 : Exit Function
End If
Call SetWindowLong(Wea.hWnd,0,pGridInterfaces)
hCtl=CreateWindow("button","Get Cell (3,2) Data",%WS_CHILD Or %WS_VISIBLE,10,10,200,30,Wea.hWnd,%IDC_RETRIEVE,Wea.hInst,ByVal 0)
hCtl=CreateWindow("button","Get Selected Row",%WS_CHILD Or %WS_VISIBLE,10,50,200,30,Wea.hWnd,%IDC_GET_SELECTED_ROW,Wea.hInst,ByVal 0)
hCtl=CreateWindow("button","Get Row Count",%WS_CHILD Or %WS_VISIBLE,10,90,200,30,Wea.hWnd,%IDC_GET_ROW_COUNT,Wea.hInst,ByVal 0)
hCtl=CreateWindow("button","Set Row Count",%WS_CHILD Or %WS_VISIBLE,10,130,200,30,Wea.hWnd,%IDC_SET_ROW_COUNT,Wea.hInst,ByVal 0)
hCtl=CreateWindow("button","Get hCell",%WS_CHILD Or %WS_VISIBLE,10,170,200,30,Wea.hWnd,%IDC_GET_HCELL,Wea.hInst,ByVal 0)
hCtl=CreateWindow("button","Color Some Cells",%WS_CHILD Or %WS_VISIBLE,10,210,200,30,Wea.hWnd,%IDC_COLOR_SOME_ROWS,Wea.hInst,ByVal 0)
hCtl=CreateWindow("button","Destroy Grid",%WS_CHILD Or %WS_VISIBLE,10,250,200,30,Wea.hWnd,%IDC_UNLOAD_GRID,Wea.hInst,ByVal 0)
Let pGrid = NewCom "FHGrid.Grid"
#If %Def(%Debug)
Prnt " Objptr(pGrid) = " & Str$(Objptr(pGrid))
#EndIf
If IsObject(pGrid) Then
@pGridInterfaces.pGrid1=Objptr(pGrid)
pGrid.AddRef()
strSetup="110:Column 1:^:edit,110:Column 2:^:edit,110:Column 3:^:edit,110:Column 4:^:edit,110:Column 5:^:combo"
pGrid.CreateGrid(Wea.hWnd,strSetup,250,10,570,273,%NUMBER_ROWS,%NUMBER_COLUMNS,28,0,0,"Times New Roman",18,%FW_DONTCARE)
If ObjResult=%S_OK Then
pConnectionPointContainer = pGrid
If IsObject(pConnectionPointContainer) Then
EventGuid=$IID_IGridEvents
pConnectionPointContainer.FindConnectionPoint(Byval Varptr(EventGuid), Byval Varptr(pConnectionPoint))
If ObjResult=%S_OK Then
Let pSink = Class "CGridEvents"
#If %Def(%Debug)
Prnt " Objptr(pSink) = " & Str$(Objptr(pSink))
#EndIf
If IsObject(pSink) Then
pConnectionPoint.Advise(Byval Objptr(pSink), dwCookie)
If ObjResult=%S_OK Then
@pGridInterfaces.dwCookie1=dwCookie
#If %Def(%Debug)
Prnt " dwCookie = " & Str$(dwCookie)
#EndIf
hCtl=pGrid.GethGrid()
#If %Def(%Debug)
Prnt " hGrid = " & Str$(hCtl)
#EndIf
Call SetWindowLong(Wea.hWnd,8,hCtl)
For i=1 To %NUMBER_ROWS
For j=1 To %NUMBER_COLUMNS
strCoordinate="(" & Trim$(Str$(i)) & "," & Trim$(Str$(j)) & ")"
pGrid.SetData(i, j, strCoordinate)
Next j
Next i
pGrid.Refresh()
hCtl=pGrid.GethComboBox(5)
szName="Frederick" : Call SendMessage(hCtl,%CB_INSERTSTRING,-1,Varptr(szName))
szName="Elsie" : Call SendMessage(hCtl,%CB_INSERTSTRING,-1,Varptr(szName))
szName="Scott" : Call SendMessage(hCtl,%CB_INSERTSTRING,-1,Varptr(szName))
szName="Lorrie" : Call SendMessage(hCtl,%CB_INSERTSTRING,-1,Varptr(szName))
szName="Joseph" : Call SendMessage(hCtl,%CB_INSERTSTRING,-1,Varptr(szName))
szName="Frank" : Call SendMessage(hCtl,%CB_INSERTSTRING,-1,Varptr(szName))
End If
End If
End If
End If
End If
End If
#If %Def(%Debug)
Prnt "Leaving fnWndProc_OnCreate()"
#EndIf
fnWndProc_OnCreate=0
End Function
Sub DestroyGrid(Wea As WndEventArgs)
Local pConnectionPointContainer As IConnectionPointContainer
Local pGridInterfaces As GridInterfaces Ptr
Local pConnectionPoint As IConnectionPoint
Local dwCookie As Dword
Local EventGuid As Guid
Local pGrid As IGrid
Local hr As Long
#If %Def(%Debug)
Prnt " Entering DestroyGrid()"
#EndIf
pGridInterfaces=GetWindowLong(Wea.hWnd,0)
If pGridInterfaces Then
If @pGridInterfaces.pGrid1 Then
CObj(pGrid,@pGridInterfaces.pGrid1)
@pGridInterfaces.pGrid1=0
If IsObject(pGrid) Then
pConnectionPointContainer=pGrid
If IsObject(pConnectionPointContainer) Then
EventGuid=$IID_IGridEvents
hr=pConnectionPointContainer.FindConnectionPoint(Byval Varptr(EventGuid), Byval Varptr(pConnectionPoint))
If SUCCEEDED(hr) Then
dwCookie=@pGridInterfaces.dwCookie1
@pGridInterfaces.dwCookie1=0
hr=pConnectionPoint.Unadvise(dwCookie)
If SUCCEEDED(hr) Then
#If %Def(%DEBUG)
Prnt " pConnectionPoint.Unadvise(dwCookie) Succeeded!"
#EndIf
End If
End If
End If
End If
Else
#If %Def(%Debug)
Prnt " Must Have Already Released pGrid!"
#EndIf
End If
End If
#If %Def(%Debug)
Prnt " Leaving DestroyGrid()"
#EndIf
End Sub
Function fnWndProc_OnCommand(Wea As WndEventArgs) As Long
Local pGridInterfaces As GridInterfaces Ptr
Register i As Long,j As Long
Local strData As BStr
Local iCnt,hr As Long
Local pGrid As IGrid
pGridInterfaces=GetWindowLong(Wea.hWnd,0)
If pGridInterfaces Then
Select Case As Long Lowrd(Wea.wParam)
Case %IDC_RETRIEVE
#If %Def(%Debug)
Prnt "Entering fnWndProc_OnCommand()"
Prnt " Case %IDC_RETRIEVE"
#EndIf
CObj(pGrid,@pGridInterfaces.pGrid1)
Call pGrid.AddRef()
pGrid.FlushData()
strData=pGrid.GetData(3,2)
#If %Def(%Debug)
Prnt " Cell 3,2 Contains " & strData
Prnt "Leaving fnWndProc_OnCommand()"
#Else
MsgBox("Cell (3, 2) Contains " & strData & ".")
#EndIf
Case %IDC_GET_SELECTED_ROW
If GetWindowLong(Wea.hWnd,4) Then
MsgBox("Selected Row = " & Str$(GetWindowLong(Wea.hWnd,4)))
Else
MsgBox("No Row Selected!")
End If
Case %IDC_GET_ROW_COUNT
CObj(pGrid,@pGridInterfaces.pGrid1)
Call pGrid.AddRef()
MsgBox("pGrid.GetRowCount() = " & Str$(pGrid.GetRowCount()) & ".")
Case %IDC_SET_ROW_COUNT
CObj(pGrid,@pGridInterfaces.pGrid1)
Call pGrid.AddRef()
Call pGrid.SetRowCount(25,%True)
If ObjResult=%S_OK Then
For i=1 To 25
For j=1 To 5
strData="(" & Trim$(Str$(i)) & "," & Trim$(Str$(j)) & ")"
pGrid.SetData(i,j,strData)
Next j
Next i
pGrid.Refresh()
MsgBox "pGrid->SetRowCount() Succeeded!",%MB_OK,"Report"
End If
Case %IDC_COLOR_SOME_ROWS
If Hiwrd(Wea.wParam)=%BN_CLICKED Then
#If %Def(%Debug)
Prnt "Entering fnWndProc_OnCommand()"
Prnt " Case %IDC_COLOR
#EndIf
CObj(pGrid,@pGridInterfaces.pGrid1)
pGrid.AddRef()
pGrid.FlushData()
For i=1 To 5 ' back, text
pGrid.SetCellAttributes(3,i,&H000000FF,&H00FFFFFF) ' red, white
Next i
For i=1 To 5
pGrid.SetCellAttributes(4,i,&H0000FF00,&H00FFFFFF) ' green, white
Next i
For i=1 To 5
pGrid.SetCellAttributes(5,i,&H00FF0000,&H00FFFFFF) ' blue, white
Next i
For i=1 To 5
pGrid.SetCellAttributes(6,i,RGB(255,255,0),&H00000001) ' yellow, black
Next i
For i=1 To 5
pGrid.SetCellAttributes(7,i,RGB(0,255,255),&H00000001) ' light bluish, black
Next i
pGrid.Refresh()
#If %Def(%Debug)
Prnt "Leaving fnWndProc_OnCommand()"
#EndIf
End If
Case %IDC_GET_HCELL
Local hCell As Dword
CObj(pGrid,@pGridInterfaces.pGrid1)
Call pGrid.AddRef()
hCell=pGrid.GethCell(3,2)
If ObjResult=%S_OK Then
MsgBox "pGrid.GethCell(3,2) = " & Str$(hCell) & ".", %MB_OK, "Report"
End If
Case %IDC_UNLOAD_GRID
#If %Def(%Debug)
Prnt "Entering fnWndProc_OnCommand()"
Prnt " Case %IDC_UNLOAD_GRID"
#EndIf
Call DestroyGrid(Wea)
Call EnableWindow(GetDlgItem(Wea.hWnd,%IDC_RETRIEVE),%False)
Call EnableWindow(GetDlgItem(Wea.hWnd,%IDC_GET_SELECTED_ROW),%False)
Call EnableWindow(GetDlgItem(Wea.hWnd,%IDC_GET_ROW_COUNT),%False)
Call EnableWindow(GetDlgItem(Wea.hWnd,%IDC_SET_ROW_COUNT),%False)
Call EnableWindow(GetDlgItem(Wea.hWnd,%IDC_GET_HCELL),%False)
Call EnableWindow(GetDlgItem(Wea.hWnd,%IDC_COLOR_SOME_ROWS),%False)
Call EnableWindow(GetDlgItem(Wea.hWnd,%IDC_UNLOAD_GRID),%False)
Call InvalidateRect(Wea.hWnd,Byval %Null, %True)
#If %Def(%Debug)
Prnt "Leaving fnWndProc_OnCommand()"
#EndIf
End Select
End If
fnWndProc_OnCommand=0
End Function
Function fnWndProc_OnDestroy(Wea As WndEventArgs) As Long
Local pGridInterfaces As GridInterfaces Ptr
Local blnFree As Long
#If %Def(%Debug)
Prnt "Entering fnWndProc_OnDestroy()"
#EndIf
Call DestroyGrid(Wea)
pGridInterfaces=GetWindowLong(Wea.hWnd,0)
#If %Def(%Debug)
Prnt " pGridInterfaces = " & Str$(pGridInterfaces)
#EndIf
blnFree=GlobalFree(pGridInterfaces)
#If %Def(%Debug)
Prnt " blnFree(pGridInterfaces) = " & Str$(blnFree)
#EndIf
Call CoFreeUnusedLibraries()
Call PostQuitMessage(0)
#If %Def(%Debug)
Prnt "Leaving fnWndProc_OnDestroy()"
#EndIf
Function=0
End Function
Sub AttachMessageHandlers()
Dim MsgHdlr(2) As Global MessageHandler 'Associate Windows Message With Message Handlers
MsgHdlr(0).wMessage=%WM_CREATE : MsgHdlr(0).dwFnPtr=CodePtr(fnWndProc_OnCreate)
MsgHdlr(1).wMessage=%WM_COMMAND : MsgHdlr(1).dwFnPtr=CodePtr(fnWndProc_OnCommand)
MsgHdlr(2).wMessage=%WM_DESTROY : MsgHdlr(2).dwFnPtr=CodePtr(fnWndProc_OnDestroy)
End Sub
Function fnWndProc(ByVal hWnd As Long,ByVal wMsg As Long,ByVal wParam As Long,ByVal lParam As Long) As Long
Local wea As WndEventArgs
Register iReturn As Long
Register i As Long
For i=0 To 2
If wMsg=MsgHdlr(i).wMessage Then
wea.hWnd=hWnd: wea.wParam=wParam: wea.lParam=lParam
Call Dword MsgHdlr(i).dwFnPtr Using FnPtr(wea) To iReturn
fnWndProc=iReturn
Exit Function
End If
Next i
fnWndProc=DefWindowProc(hWnd,wMsg,wParam,lParam)
End Function
Function WinMain(ByVal hIns As Long,ByVal hPrev As Long,ByVal lpCL As Asciiz Ptr,ByVal iShow As Long) As Long
Local szAppName As ZStr*16
Local wc As WndClassEx
Local hWnd As Dword
Local Msg As tagMsg
szAppName="Grid Test" : Call AttachMessageHandlers()
wc.lpszClassName=VarPtr(szAppName) : wc.lpfnWndProc=CodePtr(fnWndProc)
wc.cbClsExtra=0 : wc.cbWndExtra=12
wc.style=%CS_HREDRAW Or %CS_VREDRAW : wc.hInstance=hIns
wc.cbSize=SizeOf(wc) : wc.hIcon=LoadIcon(%NULL, ByVal %IDI_APPLICATION)
wc.hCursor=LoadCursor(%NULL, ByVal %IDC_ARROW) : wc.hbrBackground=%COLOR_BTNFACE+1
wc.lpszMenuName=%NULL
Call RegisterClassEx(wc)
hWnd=CreateWindowEx(0,szAppName,szAppName,%WS_OVERLAPPEDWINDOW,200,100,840,340,0,0,hIns,ByVal 0)
Call ShowWindow(hWnd,iShow)
While GetMessage(Msg,%NULL,0,0)
TranslateMessage Msg
DispatchMessage Msg
Wend
#If %Def(%Debug)
MsgBox("Last Chance To Get What You Can!")
#EndIf
Function=msg.wParam
End Function