'FHGrid2.bas 'Compiles With Either PowerBASIC Or Jose Roca's Includes.
' 'Needs PB Win 10 and FHGrid9.dll, i.e., "FHGrid9.Grid"
#Compile Exe "FHGrid2"
#Dim All
#Register None
%UNICODE = 1
'%DEBUG = 1
#If %Def(%UNICODE)
Macro ZStr = WStringz
Macro BStr = WString
%SIZEOF_CHAR = 2
#Else
Macro ZStr = Asciiz
Macro BStr = String
%SIZEOF_CHAR = 1
#EndIf
'$DB_PATH = "C:\Program Files (x86)\Microsoft Visual Studio\VB98\Biblio.mdb"
$DB_PATH = "C:\Program Files\Microsoft Visual Studio\VB98\Biblio.mdb"
$DB_DRIVER = "Microsoft Access Driver (*.mdb)"
$CLSID_FHGrid = GUID$("{20000000-0000-0000-0000-000000000088}")
$IID_IFHGrid = GUID$("{20000000-0000-0000-0000-000000000089}")
$IID_IGridEvents = GUID$("{20000000-0000-0000-0000-00000000008A}")
#Include "Windows.inc"
#Include "SqlIncs.inc"
#Include "CSql.inc"
Type GridInterfaces
pGrid As Dword Ptr
pSink As Dword Ptr
End Type
Type EditFlags
iRecords As Long
pEdits As Byte Ptr
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
Global MsgHdlr() As MessageHandler
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()
hMain=FindWindow("Test My Grid","Test My Grid")
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)
Local pEditFlags As EditFlags Ptr
pEditFlags=GetWindowLong(hMain,4)
If pEditFlags And @pEditFlags.pEdits Then
@pEditFlags.@pEdits[iRow] = @pEditFlags.@pEdits[iRow] Or 2^(iCol-1)
End If
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)
' Insert your code here
End Method
Method Grid_OnLButtonDown(Byval iCellRow As Long, Byval iGridRow As Long, Byval iCol As Long)
' Insert your code here
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)
' Insert Code Here
End Method
Method Grid_OnDelete(Byval iRow As Long)
Local pGridInterfaces As GridInterfaces Ptr
Local pEditFlags As EditFlags Ptr
Local strQuery As BStr
Local strISBN As BStr
Local pGrid As IGrid
Local hStmt As Dword
Local pSql As ISql
#If %Def(%Debug)
Prnt "Entering Grid_OnDelete()"
Prnt " iRow = " & Str$(iRow)
#EndIf
MousePtr 11
pGridInterfaces=GetWindowLong(hMain,0)
If pGridInterfaces Then
If @pGridInterfaces.pGrid Then
CObj(pGrid,@pGridInterfaces.pGrid)
Call pGrid.AddRef()
pEditFlags=GetWindowLong(hMain,4)
If pEditFlags Then
Call UpdateDatabase(@pEditFlags.iRecords, @pEditFlags.pEdits, pGrid)
pSql=Class "CSql"
pSql.strDBQ=$DB_PATH
pSql.strDriver=$DB_DRIVER
Call pSql.ODBCConnect()
If pSql.blnConnected Then
#If %Def(%Debug)
Prnt " Got In Where pSQl.blnConnected = True!"
#EndIf
Call SQLAllocHandle(%SQL_HANDLE_STMT,pSql.hConn(),hStmt)
strISBN=pGrid.GetData(iRow,3)
strQuery="DELETE FROM Titles Where ISBN=" & Chr$(39) & strISBN & Chr$(39) & ";"
#If %Def(%Debug)
Prnt " " & strQuery
#EndIf
Call SQLExecDirect(hStmt,Byval Strptr(strQuery),%SQL_NTS)
Call SQLFreeHandle(%SQL_HANDLE_STMT,hStmt)
Call pSQL.ODBCDisconnect()
Call pGrid.DeleteRow(iRow)
Call pGrid.Refresh()
End If
End If
End If
End If
MousePtr 1
#If %Def(%Debug)
Prnt "Leaving Grid_OnDelete()"
#EndIf
End Method
End Interface
End Class
Function blnGetRecordCount(Byref Sql 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,Sql.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 Sql As ISql, Byref pGrid As IGrid) 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 * 56
Local szNotes As ZStr * 56
Local szSubject As ZStr * 56
Local szComments As ZStr * 256
Local iReturn As Long
Local hStmt As Dword
Local iLen() As Long
Register i As Long
#If %Def(%Debug)
Prnt " Entering blnLoadTitles()"
#Endif
Redim iLen(8) As Long
szQuery = "SELECT Title, [Year Published], ISBN, PubID, Description, Notes, Subject, Comments FROM Titles;
Call SQLAllocHandle(%SQL_HANDLE_STMT,Sql.hConn(),hStmt)
Call SQLBindCol(hStmt,1,%SQL_C_WCHAR,szTitle,510,iLen(1)) ' In using ODBC one declares a variable for
Call SQLBindCol(hStmt,2,%SQL_C_SHORT,iYrPub,0,iLen(2)) ' each field being retrieved from the data
Call SQLBindCol(hStmt,3,%SQL_C_WCHAR,szISBN,46,iLen(3)) ' source. The address of this variable is
Call SQLBindCol(hStmt,4,%SQL_C_LONG,iPubID,0,iLen(4)) ' given to the db driver in SQLBindCol()
Call SQLBindCol(hStmt,5,%SQL_C_WCHAR,szDescription,110,iLen(5)) ' calls - one for each field/column. Then
Call SQLBindCol(hStmt,6,%SQL_C_WCHAR,szNotes,110,iLen(6)) ' one calls SQLExecDirect() to retrieve a
Call SQLBindCol(hStmt,7,%SQL_C_WCHAR,szSubject,110,iLen(7)) ' database cursor. It is through this data-
Call SQLBindCol(hStmt,8,%SQL_C_WCHAR,szComments,510,iLen(8)) ' base cursor one loops with calls of
iReturn=SQLExecDirect(hStmt,szQuery,%SQL_NTS) ' SQLFetch() to retrieve a row of data into
If iReturn=%SQL_SUCCESS Or iReturn=%SQL_SUCCESS_WITH_INFO Then ' the bound variables bound with SQLBindCol().
i=1 ' When the SQLFetch() call is made, those
Do While SQLFetch(hStmt)<>%SQL_NO_DATA ' iLen() variables seen in the last para-
If iLen(1) Then pGrid.SetData(i,1,szTitle) ' meter of the SQLBindCol() calls receive the byte
If iLen(2) Then pGrid.SetData(i,2,Str$(iYrPub)) ' count of data read out of the row from the database
If iLen(3) Then pGrid.SetData(i,3,szISBN) ' cursor. If a zero ends up in there it means that
If iLen(4) Then pGrid.SetData(i,4,Str$(iPubID)) ' for the respective field that field was NULL. How-
If iLen(5) Then pGrid.SetData(i,5,szDescription) ' ever, that variable may and almost certainly is
If iLen(6) Then pGrid.SetData(i,6,szNotes) ' holding whatever was put there from a previous call
If iLen(7) Then pGrid.SetData(i,7,szSubject) ' of SQLFetch(). So if you use that data from the
If iLen(8) Then pGrid.SetData(i,8,szComments) ' bound variable when the corresponding iLen(i)
Incr i ' variable is telling you nothing was read, you are
Loop ' going to get yourself into trouble. That's why
Call SQLFreeHandle(%SQL_HANDLE_STMT,hStmt) ' I'm checking every iLen(i) before I write the
Else ' bound variable's data into the grid.
Call SQLFreeHandle(%SQL_HANDLE_STMT,hStmt)
Erase iLen()
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 ' Offset What's Stored There
Local pGridInterfaces As GridInterfaces Ptr ' ===============================
Local pCreateStruct As CREATESTRUCT Ptr ' 0 - 3 pGridInterfaces
Local pEditFlags As EditFlags Ptr ' 4 - 7 pEditFlags
Local pSink As IGridEvents
Local iRecordCount As Long
Local strSetup As BStr
Local pGrid As IGrid
Local hHeap As Dword
Local pSql As ISql
#If %Def(%Debug)
Call AllocConsole()
Prnt "Entering fnWndProc_OnCreate()"
#EndIf
pCreateStruct=wea.lParam : wea.hInst=@pCreateStruct.hInstance
hHeap=GetProcessHeap()
pGridInterfaces=HeapAlloc(hHeap,%HEAP_ZERO_MEMORY,sizeof(GridInterfaces))
If pGridInterfaces Then
Call SetWindowLong(Wea.hWnd,0,pGridInterfaces)
pGrid = NewCom "FHGrid9.Grid"
If IsObject(pGrid) Then
@pGridInterfaces.pGrid=Objptr(pGrid)
pGrid.AddRef()
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 " iRecordCount = " & Str$(iRecordCount)
#EndIf
iRecordCount=iRecordCount*1.01
hHeap=GetProcessHeap()
pEditFlags=HeapAlloc(hHeap,%HEAP_ZERO_MEMORY,sizeof(EditFlags))
#If %Def(%Debug)
Prnt " iRecordCount = " & Str$(iRecordCount)
Prnt " pEditFlags = " & Str$(pEditFlags)
#EndIf
If pEditFlags Then
@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
SetWindowLong(Wea.hWnd,4,pEditFlags)
strSetup= _
"300:Title:^:edit," & _
"200:Year Published:^:edit," & _
"150:ISBN:^:edit," & _
"90:PubID:^:edit," & _
"200:Description:^:edit," & _
"90:Notes:^:edit," & _
"100:Subject:^:edit," & _
"110:Comments:^:edit"
pGrid.CreateGrid(Wea.hWnd,strSetup,10,10,850,500,iRecordCount,8,20,0,0,"Times New Roman",12,%FW_LIGHT)
If ObjResult=%S_OK Then
pSink = Class "CGridEvents"
Events From pGrid Call pSink
@pGridInterfaces.pSink=Objptr(pSink)
Call blnLoadTitles(pSql, pGrid)
End If
End If
End If
End If
pSql.ODBCDisconnect()
End If
Else
MsgBox("Couldn't Create FHGrid9!")
Function=-1 : Exit Function
End If
Else
MsgBox("Memory Allocation Failure")
Function=-1 : Exit Function
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 IGrid) As Long
Local strQuery, strField, strPrimaryKey As BStr
Local iReturn As Long
Local hStmt As Dword
Register i As Long
#If %Def(%Debug)
Prnt ""
Prnt " Entering blnUpdateRecord()"
Prnt " Record #" & Str$(iRecord) & " Was Edited"
Prnt " @pRecord = " & Str$(@pRecord)
Prnt ""
#EndIf
strQuery="UPDATE Titles SET " ' In this code we loop through the bits at @pRecord looking
For i=0 To 7 ' for any that have been set in Grid_OnKeyPress(). We use
If IsTrue(@pRecord And 2^i) Then ' the bitwise And operator for that. An And operation against
Select Case As Long i ' a set bit will return true. So the loop will And 1 against
Case 0 ' @pRecord, then 2, then 4, then 8, then 16, etc. When we
strField=pGrid.GetData(iRecord,1) ' make a hit we concatenate that respective string into
If InStr(1,strField,Chr$(39)) Then ' strQuery, and collect the data from the grid cell for that
Replace Chr$(39) With "''" In strField ' column and row.
End If
strQuery = strQuery & "Title=" & Chr$(39) & strField & Chr$(39) & ","
Case 1
strField=pGrid.GetData(iRecord,2)
strQuery = strQuery & "[Year Published]=" & strField & ","
Case 3
strField=pGrid.GetData(iRecord,4)
strQuery = strQuery & "PubID=" & strField & ","
Case 4
strField=pGrid.GetData(iRecord,5)
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
strField=pGrid.GetData(iRecord,6)
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
strField=pGrid.GetData(iRecord,7)
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
strField=pGrid.GetData(iRecord,8)
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)
strPrimaryKey=" WHERE ISBN=" & Chr$(39) & pGrid.GetData(iRecord,3) & 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
#EndIf
Call SQLFreeHandle(%SQL_HANDLE_STMT,hStmt)
#If %Def(%Debug)
Prnt " Leaving blnUpdateRecord()"
#EndIf
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 IGrid) As Long
Local strQuery, strField As BStr
Local iReturn As Long
Local hStmt As Dword
Register i As Long
#If %Def(%Debug)
Prnt $CrLf
Prnt " Entering blnInsertRecord()"
Prnt " Record #" & Str$(iRecord) & " Was Edited"
Prnt " @pRecord = " & Str$(@pRecord)
Prnt $CrLf
#EndIf
strQuery="INSERT INTO Titles (" ' This is exactly like blnUpdateRecord() above in its logic, but
For i=0 To 7 ' we're constructing an SQL INSERT statement here. We loop through
If IsTrue(@pRecord And 2^i) Then ' all the bits in the record passed in as a parameter and search for
Select Case As Long i ' dirty bits. When we find one we add the field name to the INSERT
Case 0 ' statement, and get the associated data from the grid for whatever
strQuery=strQuery+"Title," ' column/field we made the 'hit'. When we're done we call
Case 1 ' SQLExecDirect() to see if we can get the record in.
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
strField=pGrid.GetData(iRecord,1)
If InStr(1,strField,Chr$(39)) Then
Replace Chr$(39) With "''" In strField
End If
strQuery = strQuery & Chr$(39) & strField & Chr$(39) & ","
Case 1
strField=pGrid.GetData(iRecord,2)
strQuery = strQuery & strField & ","
Case 2
strField=pGrid.GetData(iRecord,3)
If InStr(1,strField,Chr$(39)) Then
Replace Chr$(39) With "''" In strField
End If
strQuery = strQuery & Chr$(39) & strField & Chr$(39) & ","
Case 3
strField=pGrid.GetData(iRecord,4)
strQuery = strQuery & strField & ","
Case 4
strField=pGrid.GetData(iRecord,5)
If InStr(1,strField,Chr$(39)) Then
Replace Chr$(39) With "''" In strField
End If
strQuery = strQuery & Chr$(39) & strField & Chr$(39) & ","
Case 5
strField=pGrid.GetData(iRecord,6)
If InStr(1,strField,Chr$(39)) Then
Replace Chr$(39) With "''" In strField
End If
strQuery = strQuery & Chr$(39) & strField & Chr$(39) & ","
Case 6
strField=pGrid.GetData(iRecord,7)
If InStr(1,strField,Chr$(39)) Then
Replace Chr$(39) With "''" In strField
End If
strQuery = strQuery & Chr$(39) & strField & Chr$(39) & ","
Case 7
strField=pGrid.GetData(iRecord,8)
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 IGrid)
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 @pEdit[i] is anything other than zero, we know the user
If @pEdits[i] Then ' pressed a key while the caret was in some cell. Therefore,
blnDataEdited=%True ' something was edited or inserted. In that case we're going
Exit For ' to have to get inside the If just below and see just what
End If ' the user did. Every record (byte at @pEdits[i]) will have
Next i ' to be tested for a 'dirty' bit or bits. When we find a
If blnDataEdited Then ' non-zero byte, we'll pass that byte and record number to
Sql=Class "CSql" ' blnUpdateRecord() to see if an UPDATE Query will update
Sql.strDBQ=$DB_PATH ' that record. It might fail. For example, it would
Sql.strDriver=$DB_DRIVER ' fail if the user added a new record to the end of the
Call Sql.ODBCConnect() ' grid's pre-existing data. In that case an INSERT Query
If Sql.blnConnected Then ' might do the trick. So we then try blnInsertRecord().
#If %Def(%Debug)
Prnt " Sql.blnConnected = True!"
#Endif
For i=1 To iRecords ' If that fails we simply give up and notify the user that
If @pEdits[i] Then ' his money will be refunded and we give up.
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 ' What blnUpdateRecord() and blnInsertRecord() do is construct
End If ' either an UPDATE or INSERT Query from the 'dirty' bits
@pEdits[i]=0 ' found at @pEdit[i]. So its basically a string concat-
End If ' enation job. Note that Sql was passed to there from here,
Next i ' and whatever the outcome was, we close it here.
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 pEditFlags As EditFlags Ptr
Local pSink As IGridEvents
Local pGrid As IGrid
Local hHeap As Dword
Local bFree As Long
#If %Def(%Debug)
Prnt "Entering fnWndProc_OnDestroy()"
#EndIf
pGridInterfaces=GetWindowLong(Wea.hWnd,0)
If pGridInterfaces Then
If @pGridInterfaces.pSink Then
CObj(pSink,@pGridInterfaces.pSink)
Events End pSink : Set pSink=Nothing
End If
If @pGridInterfaces.pGrid Then
CObj(pGrid,@pGridInterfaces.pGrid)
pGrid.FlushData()
hHeap=GetProcessHeap()
pEditFlags=GetWindowLong(Wea.hWnd,4)
If pEditFlags Then
#If %Def(%Debug)
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(@pEditFlags.pEdits) = " & Str$(bFree)
#EndIf
End If
bFree=HeapFree(hHeap,0,pEditFlags)
#If %Def(%Debug)
Prnt " bFree(pEditFlags) = " & Str$(bFree)
#EndIf
End If
Set pGrid=Nothing
End If
bFree=HeapFree(hHeap,0,pGridInterfaces)
End If
Call CoFreeUnusedLibraries()
Call PostQuitMessage(0)
#If %Def(%Debug)
Prnt "Leaving fnWndProc_OnDestroy()"
#EndIf
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 1
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(1) As MessageHandler 'Associate Windows Message With Message Handlers
MsgHdlr(0).wMessage=%WM_CREATE : MsgHdlr(0).dwFnPtr=CodePtr(fnWndProc_OnCreate)
MsgHdlr(1).wMessage=%WM_DESTROY : MsgHdlr(1).dwFnPtr=CodePtr(fnWndProc_OnDestroy)
End Sub
Function WinMain(ByVal hInstance As Long, ByVal hPrevIns As Long, ByVal lpCmdLn As ZStr 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="Test My Grid" : Call AttachMessageHandlers()
wc.lpszClassName=VarPtr(szAppName) : wc.lpfnWndProc=CodePtr(fnWndProc)
wc.cbWndExtra=8 : wc.hInstance=hInstance
wc.cbSize=SizeOf(wc) : wc.hIcon=LoadIcon(%NULL, ByVal %IDI_APPLICATION)
wc.hCursor=LoadCursor(%NULL, ByVal %IDC_ARROW) : wc.hbrBackground=%COLOR_BTNFACE+1
Call RegisterClassEx(wc)
hWnd=CreateWindowEx(0,szAppName,szAppName,%WS_OVERLAPPEDWINDOW,200,100,880,570,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