Grid Custom Control Project - Converting It To COM

[Frederick J. Harris]

Code Select Expand


' 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