' PBClient6.bas
'
' Here we'll try setting pGrid and pConnectionPoint to Nothing within DestroyGrid(), to
' reinforce our knowledge of the effects of Release() calls verses the Nothing keyword
' in terms of object destruction. Here is the console output from making those changes
' in DestroyGrid() ...
'
' Entering fnWndProc_OnDestroy()
' Entering DestroyGrid()
' Entering IGrid_QueryInterface()
' Trying To Get IConnectionPoint
' this = 4457760
' Entering IConnectionPoint_AddRef()
' @pGrid.m_cRef = 1 << Before
' @pGrid.m_cRef = 2 << After
' Leaving IConnectionPoint_AddRef()
' this = 4457768
' Leaving IGrid_QueryInterface()
'
' Entering IConnectionPoint_Unadvise()
' this = 4457768
' dwCookie = 0
' @pGrid.hWndCtrl = 9961994
' dwPtr = 4465020
' IGrid_Events::Release() Succeeded!
' Release() Returned 0
' Leaving IConnectionPoint_Unadvise()
'
' Entering IGrid_Release()
' @pGrid.m_cRef = 2 << Before
' @pGrid.m_cRef = 1 << After
' Leaving IGrid_Release()
'
' Entering IConnectionPoint_Release()
' @pGrid.m_cRef = 1 << Before
' 0 4189112 0
' 1 4189116 0
' 2 4189120 0
' 3 4189124 0
' @pGrid.m_cRef = 0 And Will Now Delete pGrid!
' Leaving IConnectionPoint_Release()
' Leaving DestroyGrid()
'
' Entering DllCanUnloadNow()
' I'm Outta Here! (dll is unloaded)
' Leaving DllCanUnloadNow()
' Leaving fnWndProc_OnDestroy()
'
' If you compare with PBClient5, you'll see the only difference is that Release() calls
' were triggered by setting pGrid and pConnectionPoint to Nothing, and of course these
' Release() calls occurred within the execution of the DestroyGrid() procedure, as
' opposed to their occurrence afterwards through PowerBASIC's stack clean up code.
'
#Compile Exe "PBClient6.exe"
#Dim All
%UNICODE = 1
#If %Def(%UNICODE)
Macro ZStr = WStringz
Macro BStr = WString
%SIZEOF_CHAR = 2
#Else
Macro ZStr = Asciiz
Macro BStr = String
%SIZEOF_CHAR = 1
#EndIf
$CLSID_FHGrid = GUID$("{20000000-0000-0000-0000-000000000084}")
$IID_IFHGrid = GUID$("{20000000-0000-0000-0000-000000000085}")
$IID_IGridEvents = GUID$("{20000000-0000-0000-0000-000000000086}")
%IDC_RETRIEVE = 1500
%IDC_COLOR = 1505
%IDC_UNLOAD_GRID = 1510
%IDC_GET_SELECTED_ROW = 1515
#Include "Win32Api.inc" ' Uses PowerBASIC Includes
Type WndEventArgs
wParam As Long
lParam As Long
hWnd As Dword
hInst As Dword
End Type
Declare Function FnPtr(wea As WndEventArgs) As Long
Type MessageHandler
wMessage As Long
dwFnPtr As Dword
End Type
Global MsgHdlr() As MessageHandler
Macro CObj(pUnk, dwAddr) = Poke Dword, Varptr(pUnk), dwAddr ' used to convert an address to an object. this could
' be a new feature suggestion!
Sub Prnt(strLn As BStr)
Local iLen, iWritten As Long
Local hStdOutput As Dword
Local strNew As BStr
hStdOutput=GetStdHandle(%STD_OUTPUT_HANDLE)
strNew=strLn + $CrLf
iLen = Len(strNew)
WriteConsole(hStdOutput, Byval Strptr(strNew), iLen, iWritten, Byval 0)
End Sub
Interface IGrid $IID_IFHGrid : Inherit IAutomation ' This is the Grid's Interface (a standard incoming Interface, i.e.,
Method CreateGrid _ ' method calls are coming into the grid from the client).
( _
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 SetData(Byval iRow As Long, Byval iCol As Long, Byval strData As WString)
Method GetData(Byval iRow As Long, Byval iCol As Long) As WString
Method FlushData()
Method Refresh()
Method GetCtrlId() As Long
Method GethGrid() As Long
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()
Prnt " Called Class Method Create()!"
hMain=FindWindow("PBClient6","PBClient6")
Prnt " hMain = " & Str$(hMain)
Prnt " Leaving Class Method Create()
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)
Prnt "Got KeyPress From CGridEvents1!" & Str$(iKeyCode) & "=" & Chr$(iKeyCode)
End Method
Method Grid_OnKeyDown(Byval iKeyCode As Long, Byval iKeyData As Long, Byval iRow As Long, Byval iCol As Long, Byref blnCancel As Long)
Prnt "Got KeyDown From CGridEvents1!" & Str$(iKeyCode) & "=" & Chr$(iKeyCode)
End Method
Method Grid_OnLButtonDown(Byval iCellRow As Long, Byval iGridRow As Long, Byval iCol As Long)
Prnt "Got WM_LBUTTONDOWN In Grid Cell From CGridEvents1" & "(" & Trim$(Str$(iGridRow)) & "," & Trim$(Str$(iCol)) & ")"
End Method
Method Grid_OnLButtonDblClk(Byval iCellRow As Long, Byval iGridRow As Long, Byval iCol As Long)
' Insert your code here
End Method
Method Grid_OnPaste(Byval iCellRow As Long, Byval iGridRow As Long, Byval iCol As Long)
' Insert your code here
End Method
Method Grid_OnRowSelection(Byval iRow As Long, Byval iAction As Long)
Prnt " Entering Grid_OnRowSelection(GridEvents)"
Prnt " iRow = " & Str$(iRow)
Prnt " iAction = " & Str$(iAction)
If iAction Then
Call SetWindowLong(hMain,8,iRow)
Else
Call SetWindowLong(hMain,8,0)
End If
Prnt " Leaving Grid_OnRowSelection(GridEvents)"
End Method
Method Grid_OnDelete(Byval iRow As Long)
Local pGrid As IGrid
Local dwPtr As Dword
Prnt " Entering Grid_OnDelete()"
Prnt " iRow = " & Str$(iRow)
dwPtr=GetWindowLong(hMain,0)
CObj(pGrid,dwPtr)
Call pGrid.AddRef()
Call pGrid.DeleteRow(iRow)
Call pGrid.Refresh()
Prnt " Leaving Grid_OnDelete()"
End Method
End Interface
End Class
Function fnWndProc_OnCreate(Wea As WndEventArgs) As Long 'Offset Item
Local pConnectionPointContainer As IConnectionPointContainer '=====================================================================
Local pConnectionPoint As IConnectionPoint '0 - 3 IGrid Ptr - pGrid
Local pCreateStruct As CREATESTRUCT Ptr '4 - 7 dwCookie
Local strSetup,strCoordinate As BStr '8 - 11 iSelectedRow
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
Call AllocConsole()
Prnt "Entering fnWndProc_OnCreate()"
pCreateStruct=wea.lParam : wea.hInst=@pCreateStruct.hInstance
Let pGrid = NewCom "FHGrid8.Grid"
Prnt " Objptr(pGrid) = " & Str$(Objptr(pGrid))
Call SetWindowLong(Wea.hWnd,0,Objptr(pGrid))
pGrid.AddRef()
strSetup="120:Column 1:^:edit,130:Column 2:^:edit,140:Column 3:^:edit,150:Column 4:^:edit,160:Column 5:^:combo"
pGrid.CreateGrid(Wea.hWnd,strSetup,190,10,570,218,12,5,28,0,0,"Times New Roman",18,%FW_DONTCARE)
pConnectionPointContainer = pGrid
EventGuid=$IID_IGridEvents
Call pConnectionPointContainer.FindConnectionPoint(Byval Varptr(EventGuid),Byval Varptr(pConnectionPoint))
Let pSink = Class "CGridEvents"
Prnt " Objptr(pSink) = " & Str$(Objptr(pSink))
Call pConnectionPoint.Advise(Byval Objptr(pSink), dwCookie)
Prnt " dwCookie = " & Str$(dwCookie)
Call SetWindowLong(Wea.hWnd,4,dwCookie)
For i=1 To 12
For j=1 To 5
strCoordinate="(" & Trim$(Str$(i)) & "," & Trim$(Str$(j)) & ")"
pGrid.SetData(i, j, strCoordinate)
Next j
Next i
pGrid.Refresh()
hCtl=CreateWindow("button","Retrieve Cell (3,2)",%WS_CHILD Or %WS_VISIBLE,10,20,150,30,Wea.hWnd,%IDC_RETRIEVE,Wea.hInst,ByVal 0)
hCtl=CreateWindow("button","Color Some Rows",%WS_CHILD Or %WS_VISIBLE,10,70,150,30,Wea.hWnd,%IDC_COLOR,Wea.hInst,ByVal 0)
hCtl=CreateWindow("button","Get Selected Row",%WS_CHILD Or %WS_VISIBLE,10,120,150,30,Wea.hWnd,%IDC_GET_SELECTED_ROW,Wea.hInst,ByVal 0)
hCtl=CreateWindow("button","Unload Grid",%WS_CHILD Or %WS_VISIBLE,10,170,150,30,Wea.hWnd,%IDC_UNLOAD_GRID,Wea.hInst,ByVal 0)
hCtl=pGrid.GethComboBox(5) ' this line and method gets the handle to the combo box put in the 5th column of the grid
Prnt " hCtl = " & Str$(hCtl)
szName="Frederick" : Call SendMessage(hCtl,%CB_INSERTSTRING,-1,Varptr(szName)) ' put some strings in the combo box
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))
Prnt "Leaving fnWndProc_OnCreate()"
fnWndProc_OnCreate=0
End Function
Sub DestroyGrid(Wea As WndEventArgs)
Local pConnectionPoint As IConnectionPoint
Local dwCookie,dwPtr As Dword
Local pGrid As IGrid
Prnt " Entering DestroyGrid()"
dwPtr=GetWindowLong(Wea.hWnd,0)
If dwPtr Then
CObj(pGrid,dwPtr)
pConnectionPoint=pGrid
dwCookie=GetWindowLong(Wea.hWnd,4)
Call pConnectionPoint.Unadvise(dwCookie)
Call SetWindowLong(Wea.hWnd,0,0)
Call SetWindowLong(Wea.hWnd,4,0)
Let pGrid = Nothing
Let pConnectionPoint = Nothing
Else
Prnt " pGrid Was Already Released!"
End If
Prnt " Leaving DestroyGrid()"
End Sub
Function fnWndProc_OnCommand(Wea As WndEventArgs) As Long
Local strData As BStr
Local pGrid As IGrid
Local dwPtr As Dword
Local iCnt As Long
Register i As Long
Select Case As Long Lowrd(Wea.wParam)
Case %IDC_RETRIEVE
Prnt "Entering fnWndProc_OnCommand()"
Prnt " Case %IDC_RETRIEVE"
dwPtr=GetWindowLong(Wea.hWnd,0)
Prnt " dwPtr = " & Str$(dwPtr)
CObj(pGrid,dwPtr)
Call pGrid.AddRef() To iCnt
Prnt " iCnt = " & Str$(iCnt)
pGrid.FlushData()
strData=pGrid.GetData(3,2)
Prnt " Cell 3,2 Contains " & strData
Prnt "Leaving fnWndProc_OnCommand()"
Case %IDC_COLOR
If Hiwrd(Wea.wParam)=%BN_CLICKED Then
Prnt "Entering fnWndProc_OnCommand()"
Prnt " Case %IDC_COLOR
dwPtr=GetWindowLong(Wea.hWnd,0)
Prnt " dwPtr = " & Str$(dwPtr)
CObj(pGrid,dwPtr)
Call pGrid.AddRef() To iCnt
Prnt " iCnt = " & Str$(iCnt)
pGrid.FlushData()
For i=1 To 5
pGrid.SetCellAttributes(3,i,&H000000FF,&H00FFFFFF)
Next i
For i=1 To 5
pGrid.SetCellAttributes(4,i,&H0000FF00,&H00FFFFFF)
Next i
For i=1 To 5
pGrid.SetCellAttributes(5,i,&H00FF0000,&H00FFFFFF)
Next i
For i=1 To 5
pGrid.SetCellAttributes(6,i,RGB(255,255,0),&H00000001)
Next i
pGrid.Refresh()
Prnt "Leaving fnWndProc_OnCommand()"
End If
Case %IDC_GET_SELECTED_ROW
If GetWindowLong(Wea.hWnd,8) Then
MsgBox("Selected Row = " & Str$(GetWindowLong(Wea.hWnd,8)))
Else
MsgBox("No Row Selected!")
End If
Case %IDC_UNLOAD_GRID
Prnt "Entering fnWndProc_OnCommand()"
Prnt " Case %IDC_UNLOAD_GRID"
Call DestroyGrid(Wea)
Call EnableWindow(GetDlgItem(Wea.hWnd,%IDC_RETRIEVE),%False)
Call EnableWindow(GetDlgItem(Wea.hWnd,%IDC_UNLOAD_GRID),%False)
Call EnableWindow(GetDlgItem(Wea.hWnd,%IDC_COLOR),%False)
Call EnableWindow(GetDlgItem(Wea.hWnd,%IDC_GET_SELECTED_ROW),%False)
Call InvalidateRect(Wea.hWnd,Byval %Null, %True)
Prnt "Leaving fnWndProc_OnCommand()"
End Select
fnWndProc_OnCommand=0
End Function
Function fnWndProc_OnDestroy(Wea As WndEventArgs) As Long
Prnt "Entering fnWndProc_OnDestroy()"
Call DestroyGrid(Wea)
Call CoFreeUnusedLibraries()
Call PostQuitMessage(0)
Prnt "Leaving fnWndProc_OnDestroy()"
Function=0
End Function
Function fnWndProc(ByVal hWnd As Long,ByVal wMsg As Long,ByVal wParam As Long,ByVal lParam As Long) As Long
Local wea As WndEventArgs
Register iReturn As Long
Register i As Long
For i=0 To 2
If wMsg=MsgHdlr(i).wMessage Then
wea.hWnd=hWnd: wea.wParam=wParam: wea.lParam=lParam
Call Dword MsgHdlr(i).dwFnPtr Using FnPtr(wea) To iReturn
fnWndProc=iReturn
Exit Function
End If
Next i
fnWndProc=DefWindowProc(hWnd,wMsg,wParam,lParam)
End Function
Sub AttachMessageHandlers()
ReDim MsgHdlr(2) As MessageHandler 'Associate Windows Message With Message Handlers
MsgHdlr(0).wMessage=%WM_CREATE : MsgHdlr(0).dwFnPtr=CodePtr(fnWndProc_OnCreate)
MsgHdlr(1).wMessage=%WM_COMMAND : MsgHdlr(1).dwFnPtr=CodePtr(fnWndProc_OnCommand)
MsgHdlr(2).wMessage=%WM_DESTROY : MsgHdlr(2).dwFnPtr=CodePtr(fnWndProc_OnDestroy)
End Sub
Function WinMain(ByVal hIns As Long,ByVal hPrev As Long,ByVal lpCL As Asciiz Ptr,ByVal iShow As Long) As Long
Local szAppName As ZStr*16
Local wc As WndClassEx
Local hWnd As Dword
Local Msg As tagMsg
Call AttachMessageHandlers() : szAppName="PBClient6"
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,790,280,0,0,hIns,ByVal 0)
Call ShowWindow(hWnd,iShow)
While GetMessage(Msg,%NULL,0,0)
TranslateMessage Msg
DispatchMessage Msg
Wend : MsgBox("Last Chance To Get What You Can!")
Function=msg.wParam
End Function
