Converting Data Bound Grid Control Code To PowerBASIC Windows 10

Started by Frederick J. Harris, September 19, 2014, 02:47:05 PM

Previous topic - Next topic

0 Members and 1 Guest are viewing this topic.

Frederick J. Harris


'Program              =    MSFlexGrid_JRI
#Compile              Exe  "MSFlexGrid_JRI"
#Register             None
#Dim                  All
'%DEBUG               = 1
%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

Type WndEventArgs
  wParam              As Long
  lParam              As Long
  hWnd                As Dword
  hInst               As Dword
End Type

Type GridInterfaces
  pGrid               As Dword Ptr
  pSink               As Dword Ptr
End Type

Type EditFlags
  iRecords            As Long
  pEdits              As Byte Ptr
End Type

'$DB_PATH             = "C:\Program Files (x86)\Microsoft Visual Studio\VB98\db1.mdb"
$DB_PATH              = "C:\Program Files\Microsoft Visual Studio\VB98\db1.mdb"
$DB_DRIVER            = "Microsoft Access Driver (*.mdb)"
#Include              "Windows.inc"  ' use Jose Roca's includes
#Include              "OleCon.inc"
#Include              "SqlIncs.inc"
#Include              "CSql.inc"
#Include              "MSFlexGridLib.inc"
#Include              "MSFlexGridLibEvents.inc"
%ID_CONTAINER         = 2000

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


Sub GridSetup(Byref pGrid As IMSFlexGrid, Byval iRecCt As Long)
  pGrid.SelectionMode     = 0
  pGrid.AllowUserResizing = %AllowUserResizeSettings.flexResizeColumns
  pGrid.FontName          = "Times New Roman"
  pGrid.FontSize          = 10
  pGrid.Cols              = 9
  pGrid.Rows              = iRecCt
  pGrid.ColWidth(0)       = 200
  pGrid.ColWidth(1)       = 7000
  pGrid.ColWidth(2)       = 1350
  pGrid.ColWidth(3)       = 1600
  pGrid.ColWidth(4)       = 700
  pGrid.ColWidth(5)       = 3000
  pGrid.ColWidth(6)       = 3000
  pGrid.ColWidth(7)       = 2000
  pGrid.ColWidth(8)       = 4000
  pGrid.Col               = 1
  pGrid.Row               = 0
  pGrid.Text              = "Title"
  pGrid.Col               = 2
  pGrid.Text              = "Year Published"
  pGrid.Col               = 3
  pGrid.Text              = "ISBN"
  pGrid.Col               = 4
  pGrid.Text              = "PubID"
  pGrid.Col               = 5
  pGrid.Text              = "Description"
  pGrid.Col               = 6
  pGrid.Text              = "Notes"
  pGrid.Col               = 7
  pGrid.Text              = "Subject"
  pGrid.Col               = 8
  pGrid.Text              = "Comments"
End Sub



Function blnGetRecordCount(Byref pSql As ISql, Byref iRecCt As Long) As Long
  Local szQuery As ZStr*64
  Local hStmt As Dword
  Local iJnk As Long

  szQuery="SELECT Count(*) As RecordCount FROM Titles"
  Call SQLAllocHandle(%SQL_HANDLE_STMT,pSql.hConn(),hStmt)
  Call SQLBindCol(hStmt,1,%SQL_C_ULONG,iRecCt,0,iJnk)
  Call SQLExecDirect(hStmt,szQuery,%SQL_NTS)
  Call SQLFetch(hStmt)
  Call SQLFreeHandle(%SQL_HANDLE_STMT,hStmt)
  If iRecCt Then
     Function=%True
  Else
     Function=%False
  End If
End Function



Function blnLoadTitles(Byref pSql As ISql, Byref pGrid As IMSFlexGrid) As Long
  Local szQuery        As ZStr * 256
  Local szTitle        As ZStr * 256
  Local szISBN         As ZStr * 24
  Local iYrPub         As Integer
  Local iPubID         As Long
  Local szDescription  As ZStr * 128
  Local szNotes        As ZStr * 128
  Local szSubject      As ZStr * 128
  Local szComments     As ZStr * 256
  Local iVar           As Long
  Local hStmt          As Dword
  Local iLen()         As Long
  Register i           As Long

  #If %Def(%Debug)
  Prnt "  Entering blnLoadTitles()"
  #Endif
  szQuery = "SELECT Title, [Year Published], ISBN, PubID, Description, Notes, Subject, Comments FROM Titles ORDER BY ISBN;
  Redim iLen(8) As Long
  Call SQLAllocHandle(%SQL_HANDLE_STMT,pSql.hConn(),hStmt)
  Call SQLBindCol(hStmt,1,%SQL_C_WCHAR,szTitle,510,iLen(1))
  Call SQLBindCol(hStmt,2,%SQL_C_SHORT,iYrPub,0,iLen(2))
  Call SQLBindCol(hStmt,3,%SQL_C_WCHAR,szISBN,46,iLen(3))
  Call SQLBindCol(hStmt,4,%SQL_C_LONG,iPubID,0,iLen(4))
  Call SQLBindCol(hStmt,5,%SQL_C_WCHAR,szDescription,110,iLen(5))
  Call SQLBindCol(hStmt,6,%SQL_C_WCHAR,szNotes,110,iLen(6))
  Call SQLBindCol(hStmt,7,%SQL_C_WCHAR,szSubject,110,iLen(7))
  Call SQLBindCol(hStmt,8,%SQL_C_WCHAR,szComments,510,iLen(8))
  iVar=SQLExecDirect(hStmt,szQuery,%SQL_NTS)
  If iVar=%SQL_SUCCESS Or iVar=%SQL_SUCCESS_WITH_INFO Then
     i=1
     pGrid.ColAlignment(1)=1
     Do While SQLFetch(hStmt)<>%SQL_NO_DATA
        pGrid.Row=i
        pGrid.Col=1 : If iLen(1) Then pGrid.Text=szTitle
        pGrid.Col=2 : If iLen(2) Then pGrid.Text=Str$(iYrPub)
        pGrid.Col=3 : If iLen(3) Then pGrid.Text=szISBN
        pGrid.Col=4 : If iLen(4) Then pGrid.Text=Str$(iPubID)
        pGrid.Col=5 : If iLen(5) Then pGrid.Text=szDescription
        pGrid.Col=6 : If iLen(6) Then pGrid.Text=szNotes
        pGrid.Col=7 : If iLen(7) Then pGrid.Text=szSubject
        pGrid.Col=8 : If iLen(8) Then pGrid.Text=szComments
        Incr i
     Loop
     Call SQLFreeHandle(%SQL_HANDLE_STMT,hStmt)
  Else
     Call SQLFreeHandle(%SQL_HANDLE_STMT,hStmt)
     Function=%False : Exit Function
  End If
  pGrid.Refresh()
  Erase iLen()
  #If %Def(%Debug)
  Prnt "    " & szQuery
  Prnt "  Leaving blnLoadTitles()"
  #Endif

  Function=%True
End Function



Function fnWndProc_OnCreate(Wea As WndEventArgs) As Long
  Local pGridInterfaces As GridInterfaces Ptr
  Local lpCreateStruct As CREATESTRUCT Ptr
  Local pEvents As DMSFlexGridEventsImpl
  Local pEditFlags As EditFlags Ptr
  Local hContainer,hHeap As Dword
  Local pFlexGrid As IMSFlexGrid
  Local iRecordCount As Long
  Local hr,hCtl As Long
  Local pSql As ISql

  #If %Def(%Debug)
  Call AllocConsole()
  Prnt "Entering fnWndProc_OnCreate()"
  #EndIf
  lpCreateStruct=Wea.lParam : Wea.hInst=@lpCreateStruct.hInstance
  Call OC_WinInit()
  hHeap=GetProcessHeap()
  pGridInterfaces=HeapAlloc(hHeap,%HEAP_ZERO_MEMORY,sizeof(GridInterfaces))
  If pGridInterfaces=0 Then
     MsgBox("Memory Allocation Failure")
     Function=-1 : Exit Function
  End If
  Call SetWindowLong(Wea.hWnd,0,pGridInterfaces)
  hContainer=CreateWindowEx _
  ( _
    0, _
    $OC_ClassNAME, _
    "MSFlexGridLib.MSFlexGrid;RTLKEY:72E67120-5959-11cf-91F6-C2863C385E30", _
    %WS_CHILD OR %WS_VISIBLE, _
    10, _
    10, _
    850, _
    500, _
    Wea.hWnd, _
    %ID_CONTAINER, _
    Wea.hInst, _
    Byval %NULL _
  )
  If hContainer=0 Then
     #If %Def(%Debug)
     Prnt "  hContainer=0"
     #EndIf
     Function=-1 : Exit Function
  End If
  pFlexGrid=OC_GetDispatch(hContainer)
  If IsObject(pFlexGrid) Then
     #If %Def(%Debug)
     Prnt "  pFlexGrid Is Something!"
     #EndIf
     pFlexGrid.AddRef()
     @pGridInterfaces.pGrid=Objptr(pFlexGrid)
     pEvents = Class "CDMSFlexGridEvents"
     If IsObject(pEvents) Then
        @pGridInterfaces.pSink=Objptr(pEvents)
        Events From pFlexGrid Call pEvents
        pSql=Class "CSql"
        pSql.strDBQ=$DB_PATH
        pSql.strDriver=$DB_DRIVER
        Call pSql.ODBCConnect()
        If pSql.blnConnected Then
           If blnGetRecordCount(pSql, iRecordCount) Then
              #If %Def(%Debug)
              Prnt "  pFlexGrid    = " & Str$(Objptr(pFlexGrid))
              Prnt "  iRecordCount = " & Str$(iRecordCount)
              #EndIf
              iRecordCount=iRecordCount*1.01
              pEditFlags=HeapAlloc(hHeap,%HEAP_ZERO_MEMORY,sizeof(EditFlags))
              #If %Def(%Debug)
              Prnt "  iRecordCount = " & Str$(iRecordCount)
              Prnt "  pEditFlags   = " & Str$(pEditFlags)
              #EndIf
              If pEditFlags Then
                 SetWindowLong(Wea.hWnd,4,pEditFlags)
                 @pEditFlags.iRecords=iRecordCount
                 @pEditFlags.pEdits=HeapAlloc(hHeap,%HEAP_ZERO_MEMORY,iRecordCount+1)
                 #If %Def(%Debug)
                 Prnt "  @pEditFlags.iRecords = " & Str$(@pEditFlags.iRecords)
                 Prnt "  @pEditFlags.pEdits   = " & Str$(@pEditFlags.pEdits)
                 #EndIf
                 If @pEditFlags.pEdits Then
                    Call GridSetup(pFlexGrid,iRecordCount)
                    Call blnLoadTitles(pSql, pFlexGrid)
                 End If
              End If
           End If
           pSql.ODBCDisconnect()
        End If
        #If %Def(%Debug)
        Prnt "  pGridInterfaces = " & Str$(pGridInterfaces)
        Prnt "  Objptr(pEvents) = " & Str$(Objptr(pEvents))
        #EndIf
     End If
  End If
  #If %Def(%Debug)
  Prnt "Leaving fnWndProc_OnCreate()" & $CrLf
  #EndIf

  fnWndProc_OnCreate=0
End Function



Function blnUpdateRecord(Byval iRecord As Long, Byval pRecord As Byte Ptr, Byref Sql As ISql, Byref pGrid As IMSFlexGrid) As Long
  Local strQuery, strField, strPrimaryKey As BStr
  Local iReturn As Long
  Local hStmt As Dword
  Register i As Long

  #If %Def(%Debug)
  Prnt "    Entering blnUpdateRecord()"
  Prnt "      Record #" & Str$(iRecord) & " Was Edited"
  Prnt "      @pRecord = " & Str$(@pRecord)
  #EndIf
  pGrid.Row=iRecord
  strQuery="UPDATE Titles SET "
  For i=0 To 7
    If IsTrue(@pRecord And 2^i) Then
       Select Case As Long i
         Case 0
           pGrid.Col=1
           strField=pGrid.Text()
           If InStr(1,strField,Chr$(39)) Then
              Replace Chr$(39) With "''" In strField
           End If
           strQuery = strQuery & "Title=" & Chr$(39) & strField & Chr$(39) & ","
         Case 1
           pGrid.Col=2
           strField=pGrid.Text()
           strQuery = strQuery & "[Year Published]=" & strField & ","
         Case 3
           pGrid.Col=4
           strField=pGrid.Text()
           strQuery = strQuery & "PubID=" & strField & ","
         Case 4
           pGrid.Col=5
           strField=pGrid.Text()
           If InStr(1,strField,Chr$(39)) Then
              Replace Chr$(39) With "''" In strField
           End If
           strQuery = strQuery & "Description=" & Chr$(39) & strField & Chr$(39) & ","
         Case 5
           pGrid.Col=6
           strField=pGrid.Text()
           If InStr(1,strField,Chr$(39)) Then
              Replace Chr$(39) With "''" In strField
           End If
           strQuery = strQuery & "Notes=" & Chr$(39) & strField & Chr$(39) & ","
         Case 6
           pGrid.Col=7
           strField=pGrid.Text()
           If InStr(1,strField,Chr$(39)) Then
              Replace Chr$(39) With "''" In strField
           End If
           strQuery = strQuery & "Subject=" & Chr$(39) & strField & Chr$(39) & ","
         Case 7
           pGrid.Col=8
           strField=pGrid.Text()
           If InStr(1,strField,Chr$(39)) Then
              Replace Chr$(39) With "''" In strField
           End If
           strQuery = strQuery & "Comments=" & Chr$(39) & strField & Chr$(39) & ","
       End Select
    End If
  Next i
  strQuery=Left$(strQuery,Len(strQuery)-1)
  pGrid.Col=3
  strPrimaryKey=" WHERE ISBN=" & Chr$(39) & pGrid.Text() & Chr$(39) & ";"
  strQuery=strQuery+strPrimaryKey
  #If %Def(%Debug)
  Prnt "      strQuery = " & strQuery
  #EndIf
  Call SQLAllocHandle(%SQL_HANDLE_STMT,Sql.hConn(),hStmt)
  iReturn=SQLExecDirect(hStmt,Byval Strptr(strQuery),%SQL_NTS)
  If iReturn<>%SQL_SUCCESS And iReturn<>%SQL_SUCCESS_WITH_INFO Then
     Sql.ODBCGetDiagRec(hStmt)
     #If %Def(%Debug)
     Prnt "      iReturn                = " & Str$(iReturn)
     Prnt "      %SQL_SUCCESS           = " & Str$(%SQL_SUCCESS)
     Prnt "      %SQL_SUCCESS_WITH_INFO = " & Str$(%SQL_SUCCESS_WITH_INFO)
     Prnt "      Sql.iNativeErrCode     = " & Str$(Sql.iNativeErrCode)
     Prnt "      Sql.strErrMsg          = " & Sql.strErrMsg
     Prnt "      Sql.strErrCode         = " & Sql.strErrCode
     Prnt "    Leaving blnUpdateRecord()"
     #EndIf
     Call SQLFreeHandle(%SQL_HANDLE_STMT,hStmt)
     Function=%False : Exit Function
  End If
  Call SQLFreeHandle(%SQL_HANDLE_STMT,hStmt)
  #If %Def(%Debug)
  Prnt "    Leaving blnUpdateRecord()"
  #EndIf

  Function=%True
End Function



Function blnInsertRecord(Byval iRecord As Long, Byval pRecord As Byte Ptr, Byref Sql As ISql, Byref pGrid As IMSFlexGrid) As Long
  Local strQuery, strField As BStr
  Local iReturn As Long
  Local hStmt As Dword
  Register i As Long

  #If %Def(%Debug)
  Prnt "  Entering blnInsertRecord()"
  Prnt "    Record #" & Str$(iRecord) & " Was Edited"
  Prnt "    @pRecord = " & Str$(@pRecord)
  Prnt $CrLf
  #EndIf
  pGrid.Row=iRecord
  strQuery="INSERT INTO Titles ("
  For i=0 To 7
    If IsTrue(@pRecord And 2^i) Then
       Select Case As Long i
         Case 0
           strQuery=strQuery+"Title,"
         Case 1
           strQuery=strQuery+"[Year Published],"
         Case 2
           strQuery=strQuery+"ISBN,"
         Case 3
           strQuery=strQuery+"PubID,"
         Case 4
           strQuery=strQuery+"Description,"
         Case 5
           strQuery=strQuery+"Notes,"
         Case 6
           strQuery=strQuery+"Subject,"
         Case 7
           strQuery=strQuery+"Comments,"
       End Select
    End If
  Next i
  strQuery=Left$(strQuery,Len(strQuery)-1)+") VALUES ("
  For i=0 To 7
    If IsTrue(@pRecord And 2^i) Then
       Select Case As Long i
         Case 0  ' Title
           pGrid.Col=1
           strField=pGrid.Text()
           If InStr(1,strField,Chr$(39)) Then
              Replace Chr$(39) With "''" In strField
           End If
           strQuery = strQuery & Chr$(39) & strField & Chr$(39) & ","
         Case 1  ' [Year Published]
           pGrid.Col=2
           strField=pGrid.Text()
           strQuery = strQuery & strField & ","
         Case 2  ' ISBN
           pGrid.Col=3
           strField=pGrid.Text()
           If InStr(1,strField,Chr$(39)) Then
              Replace Chr$(39) With "''" In strField
           End If
           strQuery = strQuery & Chr$(39) & strField & Chr$(39) & ","
         Case 3  ' PubID
           pGrid.Col=4
           strField=pGrid.Text()
           strQuery = strQuery & strField & ","
         Case 4  ' Description
           pGrid.Col=5
           strField=pGrid.Text()
           If InStr(1,strField,Chr$(39)) Then
              Replace Chr$(39) With "''" In strField
           End If
           strQuery = strQuery & Chr$(39) & strField & Chr$(39) & ","
         Case 5  ' Notes
           pGrid.Col=6
           strField=pGrid.Text()
           If InStr(1,strField,Chr$(39)) Then
              Replace Chr$(39) With "''" In strField
           End If
           strQuery = strQuery & Chr$(39) & strField & Chr$(39) & ","
         Case 6  ' Subject
           pGrid.Col=7
           strField=pGrid.Text()
           If InStr(1,strField,Chr$(39)) Then
              Replace Chr$(39) With "''" In strField
           End If
           strQuery = strQuery & Chr$(39) & strField & Chr$(39) & ","
         Case 7  ' Comments
           pGrid.Col=8
           strField=pGrid.Text()
           If InStr(1,strField,Chr$(39)) Then
              Replace Chr$(39) With "''" In strField
           End If
           strQuery = strQuery & Chr$(39) & strField & Chr$(39) & ","
       End Select
    End If
  Next i
  strQuery=Left$(strQuery,Len(strQuery)-1) & ");"
  #If %Def(%Debug)
  Prnt "    strQuery = " & strQuery
  #EndIf
  Call SQLAllocHandle(%SQL_HANDLE_STMT,Sql.hConn(),hStmt)
  iReturn=SQLExecDirect(hStmt,Byval Strptr(strQuery),%SQL_NTS)
  If iReturn<>%SQL_SUCCESS And iReturn<>%SQL_SUCCESS_WITH_INFO Then
     Sql.ODBCGetDiagRec(hStmt)
     #If %Def(%Debug)
     Prnt "    iReturn                = " & Str$(iReturn)
     Prnt "    %SQL_SUCCESS           = " & Str$(%SQL_SUCCESS)
     Prnt "    %SQL_SUCCESS_WITH_INFO = " & Str$(%SQL_SUCCESS_WITH_INFO)
     Prnt "    Sql.iNativeErrCode     = " & Str$(Sql.iNativeErrCode)
     Prnt "    Sql.strErrMsg          = " & Sql.strErrMsg
     Prnt "    Sql.strErrCode         = " & Sql.strErrCode
     #Else
         iReturn=MsgBox(Sql.strErrMsg, %MB_ICONERROR, "I Don't Want To Sugar Coat It ...")
     #EndIf
     Call SQLFreeHandle(%SQL_HANDLE_STMT,hStmt)
     Function=%False : Exit Function
  End If
  Call SQLFreeHandle(%SQL_HANDLE_STMT,hStmt)
  #If %Def(%Debug)
  Prnt "  Leaving blnInsertRecord()"
  Prnt $CrLf
  #EndIf

  Function=%True
End Function



Sub UpdateDatabase(Byval iRecords As Long, Byval pEdits As Byte Ptr, Byref pGrid As IMSFlexGrid)
  Local blnDataEdited, iReturn As Long
  Register i As Long
  Local Sql As ISql

  #If %Def(%Debug)
  Prnt "  Entering UpdateDatabase()"
  Prnt "    iRecords = " & Str$(iRecords)
  Prnt "    pEdits   = " & Str$(pEdits)
  #EndIf
  For i = 1 To iRecords
    If @pEdits[i] Then
       blnDataEdited=%True
       Exit For
    End If
  Next i
  If blnDataEdited Then
     Sql=Class "CSql"
     Sql.strDBQ=$DB_PATH
     Sql.strDriver=$DB_DRIVER
     Call Sql.ODBCConnect()
     If Sql.blnConnected Then
        #If %Def(%Debug)
        Prnt "    Sql.blnConnected  = True!"
        #Endif
        For i=1 To iRecords
          If @pEdits[i] Then
             If IsFalse(blnUpdateRecord(i,Varptr(@pEdits[i]),Sql,pGrid)) Then
                If IsFalse(blnInsertRecord(i,Varptr(@pEdits[i]),Sql,pGrid)) Then
                   iReturn=MsgBox _
                   ( _
                     "Failed To Update/Insert Record #" & Str$(i) & "!", _
                     %MB_ICONERROR, _
                     "I Don't Want To Sugar Coat It!" _
                   )
                End If
             End If
             @pEdits[i]=0
          End If
        Next i
        Sql.ODBCDisconnect()
     End If
  End If
  #If %Def(%Debug)
  Prnt "  Leaving UpdateDatabase()"
  #EndIf
End Sub



Function fnWndProc_OnDestroy(Wea As WndEventArgs) As Long
  Local pGridInterfaces As GridInterfaces Ptr
  Local pEvents As DMSFlexGridEventsImpl
  Local pEditFlags As EditFlags Ptr
  Local pGrid As IMSFlexGrid
  Local hHeap As Dword
  Local bFree As Long

  #If %Def(%Debug)
  Prnt $CrLf & "Entering fnWndProc_OnDestroy()"
  #EndIf
  pGridInterfaces=GetWindowLong(Wea.hWnd,0)
  #If %Def(%Debug)
  Prnt "  pGridInterfaces = " & Str$(pGridInterfaces)
  #EndIf
  If pGridInterfaces Then
     If @pGridInterfaces.pSink Then
        CObj(pEvents,@pGridInterfaces.pSink)
        Events End pEvents
        Set pEvents=Nothing
     End If
     If @pGridInterfaces.pGrid Then
        CObj(pGrid,@pGridInterfaces.pGrid)
        hHeap=GetProcessHeap()
        pEditFlags=GetWindowLong(Wea.hWnd,4)
        If pEditFlags Then
           #If %Def(%Debug)
           Prnt "  pFlexGrid  = " & Str$(Objptr(pGrid))
           Prnt "  pEditFlags = " & Str$(pEditFlags)
           Prnt "  @pEditFlags.iRecords = " & Str$(@pEditFlags.iRecords)
           #EndIf
           If @pEditFlags.pEdits Then
              #If %Def(%Debug)
              Prnt "  @pEditFlags.pEdits = " & Str$(@pEditFlags.pEdits)
              #EndIf
              Call UpdateDatabase(@pEditFlags.iRecords, @pEditFlags.pEdits, pGrid)
              bFree=HeapFree(hHeap,0,@pEditFlags.pEdits)
              #If %Def(%Debug)
              Prnt "  bFree = " & Str$(bFree)
              #EndIf
           End If
           bFree=HeapFree(hHeap,0,pEditFlags)
           #If %Def(%Debug)
           Prnt "  bFree = " & Str$(bFree)
           #EndIf
        End If
        Set pGrid=Nothing
     End If
     bFree=HeapFree(hHeap,0,pGridInterfaces)
  End If
  Call PostQuitMessage(0)
  #If %Def(%Debug)
  Prnt "Leaving fnWndProc_OnDestroy()"
  #EndIf

  fnWndProc_OnDestroy=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

  Select Case As Long wMsg
    Case %WM_CREATE
      Wea.hWnd=hWnd : Wea.wParam=wParam : Wea.lParam=lParam
      fnWndProc=fnWndProc_OnCreate(Wea)
      Exit Function
    Case %WM_DESTROY
      Wea.hWnd=hWnd : Wea.wParam=wParam : Wea.lParam=lParam
      fnWndProc=fnWndProc_OnDestroy(Wea)
      Exit Function
  End Select

  fnWndProc=DefWindowProc(hWnd, wMsg, wParam, lParam)
End Function



Function WinMain(ByVal hInstance As Long, ByVal hPrevInst As Long, ByVal lpCmdLn As ZStr Ptr, ByVal iShow As Long) As Long
  Local szAppName As ZStr*16
  Local wc As WNDCLASSEX
  Local Msg As tagMsg
  Local hWnd As Dword

  szAppName="OCX Test"                              : wc.cbSize=SizeOf(wc)
  wc.lpfnWndProc=CodePtr(fnWndProc)                 : wc.cbWndExtra=8
  wc.hInstance=hInstance                            : wc.hIcon=LoadIcon(%NULL,ByVal %IDI_APPLICATION)   
  wc.hCursor=LoadCursor(%NULL, ByVal %IDC_ARROW)    : wc.hbrBackground=%COLOR_BTNFACE+1
  wc.lpszClassName=VarPtr(szAppName)
  Call RegisterClassEx(wc)
  hWnd=CreateWindowEx(0,szAppName,"Try MSFlexGrid",%WS_OVERLAPPEDWINDOW Xor %WS_MAXIMIZEBOX,200,100,880,560,0,0,hInstance,ByVal 0)
  Call ShowWindow(hWnd,iShow)
  While GetMessage(Msg,%NULL,0,0)
    Call TranslateMessage(Msg)
    Call DispatchMessage(Msg)
  Wend
  #If %Def(%Debug)
  MsgBox("Come And Get It Before I Throw It Out!")
  #EndIf

  Function=msg.wParam
End Function

  •  

Frederick J. Harris

I'll not post CSql.inc or SqlIncs.inc because they are the same ones I previously posted above for the example with my grid, i.e., FHGrid9.dll.  And I've certainly and emphatically learned my lesson of not trying to post anymore of Jose's verbose TypeLib Browser generated files.  In terms of MSFlexGridLib.inc and MSFlexGridLibEvents.inc, I'll just post the changes, and you the reader will have to attempt to incorporate them into compilable code.  Here are the changes to MSFlexGridLibEvents.inc ...


[CODE]
' ########################################################################################
' Class CDMSFlexGridEvents
' Interface name = DMSFlexGridEvents
' IID = {609602E0-531B-11CF-91F6-C2863C385E30}
' Event interface for Microsoft FlexGrid Control
' Attributes = 4112 [&H1010] [Hidden] [Dispatchable]
' Code generated by the TypeLib Browser 5.0.1 (c) 2011 by José Roca
' Date: 05 Sep 2014   Time: 09:17:50
' ########################################################################################

CLASS CDMSFlexGridEvents GUID$("{16980577-F116-4460-85AD-71B208AD9996}") AS EVENT
Instance hMain As Dword

  Class Method Create()
    #If %Def(%Debug)
    Prnt "  Entering Class Method Create() Of Class_DMSFlexGridEvents()"
    #EndIf
    hMain=FindWindow("OCX Test","Try MSFlexGrid")
    #If %Def(%Debug)
    Prnt "    hMain = " & Str$(hMain)
    Prnt "  Leaving Class Method Create() Of Class_DMSFlexGridEvents()"
    #EndIf
  End Method

INTERFACE DMSFlexGridEventsImpl GUID$("{609602E0-531B-11CF-91F6-C2863C385E30}") AS EVENT : INHERIT IDispatch


   

 
   ' =====================================================================================
   Method KeyPress <-603> (Byref KeyAscii As Integer)
     Local pGridInterfaces As GridInterfaces Ptr
     Local pEditFlags As EditFlags Ptr
     Local pFlexGrid As IMSFlexGrid
     Local pDisp As IDispatch
     Local strText As WString
     Local iRow,iCol As Long

     pGridInterfaces=GetWindowLong(hMain,0)
     If pGridInterfaces Then
        If @pGridInterfaces.pGrid Then
           CObj(pFlexGrid,@pGridInterfaces.pGrid)
           pFlexGrid.AddRef()
           pDisp=pFlexGrid
           If IsObject(pDisp) Then
              Object Get pDisp.Row To iRow
              Object Get pDisp.Col To iCol
              pEditFlags=GetWindowLong(hMain,4)
              If pEditFlags And @pEditFlags.pEdits Then
                 @pEditFlags.@pEdits[iRow] = @pEditFlags.@pEdits[iRow] Or 2^(iCol-1)
              End If
              If KeyAscii=8 Then
                 Object Get pDisp.Text() To strText
                 strText=Left$(strText,Len(strText)-1)
                 Object Let pDisp.Text()=strText
              Else
                 Object Get pDisp.Text() To strText
                 strText=strText+Chr$(KeyAscii)
                 Object Let pDisp.Text()=strText
              End If
           End If
        End If
     End If
   End Method
   ' =====================================================================================


So the only thing needing to be insert is the Method Create() and KeyPress() event procedures.
  •