Programming Guide:xppguide
Programming techniques using threads Foundation
Thread usage and creating a user defined-Thread class is discussed in detail in the chapter Building an Animation classwhere a variety of program-logic related issues is outlined. This chapter deals with programming techniques and implementation issues relevant for applying multi-threading in your programs.
Calculating statistics from databases
The calculation of a statistic is a common task in database applications and it provides a good example for a variety of issues relevant for multiple thread usage. In its broadest sense, the term "statistic" implies that a program has to pass through all records of a database and compute a result from its field values. For example, a question that can be answered by computing a sales statistic might be; "What is the gross revenue of last year?". Let us take this question as starting point in this discussion and look at a simple implementation:
01: LOCAL nRevenue
02:
03: USE Sales
04:
05: SUM FIELD->SALES TO nRevenue ;
06: FOR Year( FIELD->SALESDATE ) = Year( Date() ) - 1
07:
08: CLOSE Sales
09:
10: ? nRevenue
The code shows five major characteristics common to all statistics: we need variables to hold the result (line #1), a database is opened (line #3), the statistic is computed (lines #5 and #6), the database is closed (line #8) and the result is displayed (line #10). What the code does not show, but what is also a common feature of all statistics, is that the calculation can be very time consuming until the result can be displayed. Let us assume now that a user would like to do some other things while the statistic is being calculated in lines #5 and #6. There is no chance in the above implementation to accomplish this unless we use a thread that runs the time consuming part of the code.
Keep the term "time consuming" in mind. It is the key for identifying the code that must be isolated in order to be executed in a separate thread. In the example, it is the SUM command that takes time and we convert it to its functional equivalent before we run it in a thread.
The modified example shown below does the same as before:
01: LOCAL nRevenue, bEval, bFor
02:
03: USE Sales
04:
05: nRevenue := 0
06: bEval := {|| nRevenue += FIELD->SALES }
07: bFor := {|| Year( FIELD->SALESDATE ) = Year( Date() ) - 1}
08:
09: DbEval( bEval, bFor )
10:
11: CLOSE Sales
12:
13: ? nRevenue
The statistic is defined in two code blocks that are passed to the DbEval() function (line #9). The function steps through the database and computes the result by evaluating the code blocks. That means: we have a function name (DbEval), two variables (bEval, bFor) used as parameters for the function, and this is all we need to run a thread. When we create a thread object, line #9 could run in the thread:
08: oThread := Thread():new()
09: oThread:start( "DbEval", bEval, bFor )
The DbEval() function is executed in the thread and gets two parameters passed by the thread object. This looks correct, but the code will bomb with the error message "Unknown/Invalid symbol for alias"! The reason why it will produce a runtime error is due to the fact that work areas are thread-local resources in Xbase++. Although the database is opened in line #3, its fields are not visible when the code blocks are evaluated in the second thread. The expressions FIELD->SALES and FIELD->SALESDATE lead to the error because the fields exist only in the current thread, not in the second one.
To resolve this problem, we have to open the database in the second thread before DbEval() is actually executed. The easiest way for this is by assigning two additional code blocks to the thread object:
01: LOCAL nRevenue, bEval, bFor, oThread
02:
03: USE Sales
04:
05: nRevenue := 0
06: bEval := {|| nRevenue += FIELD->SALES }
07: bFor := {|| Year( FIELD->SALESDATE ) = Year( Date() ) - 1}
08:
09: oThread := Thread():new()
10: oThread:atStart := {|| DbUseArea(,,"Sales") }
11: oThread:atEnd := {|| DbCloseArea() }
11: oThread:start( "DbEval", bEval, bFor )
12:
13: Browse() // <... do something else ...>
14:
15: CLOSE Sales
16: oThread:synchronize(0)
17: ? nRevenue
The code blocks assigned to the instance variables :atStart and :atEnd (lines #10 and #11) are evaluated by the Thread object when the thread starts and when it ends, respectively. They are perfect to use for tasks that are required only once in a thread, like opening and closing a database, for example.
The statistic is now calculated independently from any other code which means that a user can do something else while the thread computes the result. To demonstrate this in the example code, the function Browse() is called in line #13 which allows the user to view the Sales database while the thread iterates through the same file and computes the statistic. There is no possibility, however, that the current thread (Browse()) interferes with the second thread (DbEval()) when changing the record pointer of the database, since the file is opened twice (lines #3 and #10) and each thread maintains its own work area (thread-local). When the user is done with browsing, the result of the calculation is displayed after calling :synchronize(0) in line #16 (remember: always make sure a thread has ended!).
The example shows that you can execute basically any Xbase++ function in a thread without having to build a specialized Thread class. The DbEval() function is a very good candidate for a separate thread because it iterates through a database on its own.
This, again, can be pretty time consuming, depending on how many records exist that must be processed. However, this does not really matter as long as the user can do other things and does not have to wait until DbEval() returns. Since the task for DbEval() is defined in a code block, you can perform calculations of any complexity using this approach. All you have to make sure is to open/close the necessary database(s) in the thread when it starts/ends.
Average and standard deviation
After we have seen how to calculate a simple statistic from a database in a separate thread, we will discuss now a more complex example. Normally, a single figure, like a total, is not sufficient to give a full picture, there are more things to look at. Average, percentage, total count or standard deviation are common figures in statistical analysis and they are quite useful for obtaining meaningful information from a set of data. Assume the question "How many cars did we sell in the first quarter of this year, what was the average price and what was the total revenue compared to the last quarter?".
To compute such figures fast, we must get as much information as possible by passing once through a database since skipping through a file is the "most expensive" operation. This implies that we have to program a function that computes multiple results by passing once through a database. Let us first see what this means in terms of code. The function programmed in the following example calculates the standard deviation, total count and total sum for a numeric database field.
01: PROCEDURE Main
02: LOCAL nStdDev, nTotal, nCount, bFor
03:
04: USE Cars
05:
06: bFor := {|| Month(FIELD->SELLDATE) < 4 }
07:
08: nStdDev := DbStdDev( "SELLPRICE", bFor, @nTotal, @nCount )
09:
10: ? "# of cars sold:", nCount
11: ? "Gross income :", nTotal
12: ? "Average price :", nTotal / nCount
13: ? "Std. deviation:", nStdDev
14: RETURN
15:
16:
17: FUNCTION DbStdDev( cFieldName, bFor, nSum, nCnt )
18: LOCAL nPos := Fieldpos( cFieldName )
19: LOCAL nSqr := 0
20:
21: nSum := 0
22: nCnt := 0
23:
24: DbEval( {|n| n := FieldGet( nPos ), ;
25: nSum += n , ;
26: nSqr += n ^ 2 , ;
27: nCnt ++ ;
28: }, bFor )
29:
30: RETURN Sqrt( ( (nCnt*nSqr) - (nSum^2) ) / ;
31: (nCnt * (nCnt-1) ) )
The common single-threaded approach to calculate multiple results with one function is to pass parameters with the reference operator (@) to the function (line #8) where they are used for computation (lines #21-#27). The results are displayed after the function returns (line #10-#13). However, it is not possible to pass a parameter by reference to a function that is executed in a thread. This would mean to use the @ operator when calling the :start() method of a Thread object and in this case, the operator is ignored. The parameter would "arrive" in the thread but its value would remain unchanged in the calling routine when the thread ends.
There are two possibilities to make the function DbStdDev() "threadable". We could replace the LOCAL variables nTotal and nCount with a two element array. If it holds the value zero in both elements, the array elements can be used for the calculations done in lines #25 and #26. In this case, function DbStdDev() would receive the array as third parameter and the fourth could be dropped.
Although this possibility is feasible, it is not optimal in terms of performance because accessing an array element is slightly slower than acessing a LOCAL variable. Since the access takes place within the DbEval() code block, the "slightly slower" can accumulate to a considerable loss in speed, depending on the size of the database. The better approach is, therefore, to embed the LOCAL variables in a code block and pass it to the :start() method. This is done in the following code which shows the modifications that allow the DbStdDev() function to be executed in a thread. Note the lines #6 and #36 when you read the code:
01: PROCEDURE Main
02: LOCAL nStdDev, nTotal, nCount, bFor, bAssign, oThread
03:
04: bFor := {|| Month(FIELD->SELLDATE) < 4 }
05:
06: bAssign := {|n1,n2| nTotal:=n1, nCount:=n2 }
07:
08: oThread := Thread():new()
09: oThread:atStart := {|| DbUseArea(,,"Cars") }
10: oThread:atEnd := {|| DbCloseArea() }
11:
12: oThread:start( "DbStdDev", "SELLPRICE", bFor, bAssign )
13: oThread:synchronize(0)
14:
15: nStdDev := oThread:result
16:
17: ? "# of cars sold:", nCount
18: ? "Gross income :", nTotal
19: ? "Average price :", nTotal / nCount
20: ? "Std. deviation:", nStdDev
21: RETURN
22:
23:
24: FUNCTION DbStdDev( cFieldName, bFor, bAsgn )
25: LOCAL nPos := Fieldpos( cFieldName )
26: LOCAL nSqr := 0
27: LOCAL nSum := 0
28: LOCAL nCnt := 0
29:
30: DbEval( {|n| n := FieldGet( nPos ), ;
31: nSum += n , ;
32: nSqr += n ^ 2 , ;
33: nCnt ++ ;
34: }, bFor )
35:
36: Eval( bAsgn, nSum, nCnt )
37:
38: RETURN Sqrt( ( (nCnt*nSqr) - (nSum^2) ) / ;
39: (nCnt * (nCnt-1) ) )
The code demonstrates an elegant solution to work around the shortcoming of the reference operator when a function is to run in a thread. The programming technique of embedding LOCAL variables in a code block can be used whenever LOCALs must be accessible outside the function where they are declared. By embedding the two LOCALs nTotal and nCount in line #6, they remain accessible inside the code block, and the values computed in DbStdDev() are assigned to the variables in line #36 where the code block is evaluated and receives the computed data as parameters.
Function DbStdDev() is very useful for statistical analysis since it computes three key figures (total count, total sum, standard deviation) that can be used to derive other key figures easily, like average or percentage, for example. During significant "number crunching" -which can be very time consuming- the user can do other things while the thread is running. As a matter of fact, you could insert whatever code you like between line #12 and #13 where the new thread is started and synchronized with the current thread. Note also line #15: the return value of DbStdDev() is obtained from the Thread object. It stores the return value of the function executed in the thread in its instance variable :result.
About threads and event loops
After we have seen how easy it is to calculate extensive statistics in a separate thread, or asynchronously, we have to look at ways how to present the results in a better way. Up to now, the examples have used the Qout() function (? command) to display the results which is not appropriate in a pure GUI application. When we choose an XbpDialog object as the application window, computed results are easily displayed using XbpStatic objects. Let us assume that a user can enter data in an XbpDialog window while a thread computes the statistic. When the thread is done, an additional window pops up and displays the result. That means, there is more than one thread and more than one window, or Xbase Part, involved.
If you plan to use Xbase Parts in more than one thread, there are two rules you have to keep in mind:
Each thread that creates Xbase Parts must run an event loop.
Xbase Parts receive events only in the thread that has created them.
Both rules are equally important when you design your programs to use multiple windows and multiple threads. If you don't comply with these rules, your application will not work. It will rather appear to you that some parts of your program work while others "hang", or don't do anything at all. However, there are two approaches you could follow: A) one thread computes the statistic and displays the result, or B) one thread displays all windows, another computes the statistic.
You can find working examples for both approaches at the end of this section. We will focus on the differences in program logic rather than discussing the entire code (most of it is required for the user interface which is not covered in this chapter).
One window per thread
The first approach is programmed in MAIN1.PRG where the Main procedure creates the application window and a thread is started via a pushbutton. The thread calculates the statistic and displays the results in a window when the database is entirely scanned. The following diagram illustrates the program flow.
Thread A (the Main() procedure) opens a database, creates the application window and runs an event loop. When a pushbutton is clicked, thread B is started via the :activate code block (not indicated in the diagram). The new thread opens a database, computes a statistic, creates a window and runs an event loop. Thus, we have (at least) two event loops running parallel. The first addresses events to the window created in thread A and the second loop sends events to the window of thread B. Thread B ends when its event loop is exited, i.e. when the second window is closed. The program is terminated when the application window is closed because this exits the event loop in thread A and ends the Main() procedure.
Multiple windows in one thread
Opening multiple windows in one thread is a common situation and you have most likely done this already. However, we have to deal now with the situation that we do not know how long the calculation of the statistic will take. That means, we have to detect when the thread ends and only then should a new window pop up to display the results. We cannot create the new window in thread B because it would not receive events (remember rule #1).
In the example program MAIN2.PRG this problem is solved elegantly. Have a look at the next diagram, which shows the program flow of MAIN2.PRG (by the way, it does the same as MAIN1.PRG but uses a different programming technique):
The entire screen output is confined to thread A while thread B executes the invisible part of the program. As in the previous example, the new thread is started via :activate code block of a pushbutton. The thread does its "number crunching" task and posts a user-defined event to thread A, just before it ends. Well, to be exact, the event is not posted to thread A but to a window created in thread A: the application window. Let us see first how this looks in the code and discuss the implications afterwards (only the relevant parts are shown below):
01: /*
02: * Code running in thread A
03: */
04:
05: #define xbeUser_Eval xbeP_User + 1
06:
07: SetAppWindow( oDlg )
08:
09: DO WHILE .T.
10: nEvent := AppEvent( @mp1, @mp2, @oXbp )
11: IF nEvent == xbeUser_Eval
12: Eval( mp1 )
13: ELSE
14: oXbp:handleEvent( nEvent, mp1, mp2 )
15: ENDIF
16: ENDDO
17:
18:
19: /*
20: * Code executed at the end of thread B
21: */
22: bUser := {|| ResultWindow( <...> ) }
23:
24: oThread:atEnd := ;
25: {|| DbCloseArea() , ;
26: PostAppEvent( xbeUser_Eval, bUser,, SetAppWindow() ) }
At first we define a new event constant in line #5 as a precondition for the program logic. This user-defined event constant must use xbeP_User as offset, otherwise it might interfere with events created by Xbase++. The application window is made accessible for all threads in line #7 where it is passed to SetAppWindow(). Note that oDlg stands for an XbpDialog window created in thread A before the program enters the event loop in lines #9 to #16. This loop runs until the program ends.
Now, what happens when thread B is done with the calculation? The code to be executed at thread B's end is defined as code block that is assigned to the:atEnd instance variable so that it is executed automatically. Within the code block in line #26, the database is closed and the user-defined event constant is posted to SetAppWindow(). The PostAppEvent() function receives as second parameter the code block defined in line #22. It calls a function which creates the window displaying the results of the statistic. Because SetAppWindow() returns a window created in thread A, the event is retrieved from the event queue of thread A in line #10 and the code block bUser arrives in the first message parameter mp1of the AppEvent() function. This again closes the circle: the code block is evaluated in line #12 which causes the result window to be created in thread A and to receive events in thread A's event loop.
User-defined events provide a very powerful programming technique. They can be used to control a single-threaded application but they show their real strength in a multi-threaded program. When you know which thread an Xbase Part was created in, you can post events along with arbitrary values across thread boundaries, just by using a particular Xbase Part as addressee of the event (remember rule #2 stated at the beginning of this section).
Here you find two samples that implement the different approaches discussed in this chapter. First you find source code that is common to both samples. Then you find those pieces of code where the approaches differ.
Source Code common to both samples:
//////////////////////////////////////////////////////////////////////
//
// Copyright:
// Alaska Software, (c) 2011. All rights reserved.
//
// Contents:
// Build the application window for the sales statistic example
//
//////////////////////////////////////////////////////////////////////
#include "Gra.ch"
#include "Xbp.ch"
#include "Appevent.ch"
#include "Font.ch"
#include "Controls.ch"
FUNCTION CreateAppWindow
LOCAL oDlg, oXbp, drawingArea, aEditControls := {}, oXbp1, oXbp2
LOCAL aPos, aSize
SET DEFAULT TO ..\..\source\samples\data\misc
USE CARS.DBF
aSize := {320,215}
aPos := CenterPos( aSize, AppDesktop():currentSize() )
oDlg := XbpDialog():new( AppDesktop(), ,aPos ,aSize , , .F.)
oDlg:border := XBPDLG_DLGBORDER
oDlg:maxButton:= .F.
oDlg:taskList := .T.
oDlg:title := "Thread example (Cars)"
oDlg:create()
drawingArea := oDlg:drawingArea
drawingArea:setFontCompoundName( FONT_HELV_SMALL )
oXbp1 := XbpStatic():new( drawingArea, , {8,40}, {160,136} )
oXbp1:caption := "Car sold"
oXbp1:clipSiblings := .T.
oXbp1:type := XBPSTATIC_TYPE_GROUPBOX
oXbp1:create()
oXbp := XbpStatic():new( oXbp1, , {16,88}, {48,24} )
oXbp:caption := "Producer:"
oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT
oXbp:create()
oXbp := XbpSLE():new( oXbp1, , {72,88}, {72,24} )
oXbp:bufferLength := 15
oXbp:tabStop := .T.
oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( CARS->PRODUCER ), CARS->PRODUCER := x ) }
oXbp:create():setData()
oXbp:setName( SLE_PRODUCER )
AAdd ( aEditControls, oXbp )
oXbp := XbpStatic():new( oXbp1, , {16,48}, {48,24} )
oXbp:caption := "Make:"
oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT
oXbp:create()
oXbp := XbpSLE():new( oXbp1, , {72,48}, {72,24} )
oXbp:bufferLength := 15
oXbp:tabStop := .T.
oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( CARS->MAKE ), CARS->MAKE := x ) }
oXbp:create():setData()
oXbp:setName( SLE_MAKE )
AAdd ( aEditControls, oXbp )
oXbp := XbpStatic():new( oXbp1, , {16,16}, {48,24} )
oXbp:caption := "Color:"
oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT
oXbp:create()
oXbp := XbpSLE():new( oXbp1, , {72,16}, {72,24} )
oXbp:bufferLength := 15
oXbp:tabStop := .T.
oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( CARS->COLOR ), CARS->COLOR := x ) }
oXbp:create():setData()
oXbp:setName( SLE_COLOR )
AAdd ( aEditControls, oXbp )
oXbp2 := XbpStatic():new( drawingArea, , {176,40}, {120,136} )
oXbp2:caption := "Sales"
oXbp2:clipSiblings := .T.
oXbp2:type := XBPSTATIC_TYPE_GROUPBOX
oXbp2:create()
oXbp := XbpPushButton():new( oXbp2, , {16,88}, {96,24} )
oXbp:caption := "Run Statistic"
oXbp:clipSiblings := .T.
oXbp:create()
oXbp:setName( PSHBTN_START )
oXbp := XbpCheckbox():new( oXbp2, , {16,48}, {96,24} )
oXbp:caption := "Include MAKE"
oXbp:clipSiblings := .T.
oXbp:create()
oXbp:setName( CHKBOX_MAKE )
oXbp := XbpCheckbox():new( oXbp2, , {16,16}, {96,24} )
oXbp:caption := "Include COLOR"
oXbp:clipSiblings := .T.
oXbp:create()
oXbp:setName( CHKBOX_COLOR )
oXbp := XbpPushButton():new( drawingArea, , {8,8}, {72,24} )
oXbp:caption := "Previous"
oXbp:clipSiblings := .T.
oXbp:create()
oXbp:activate := {|| DoSkip( -1, aEditControls ) }
oXbp:setName( PSHBTN_PREV )
oXbp := XbpPushButton():new( drawingArea, , {96,8}, {72,24} )
oXbp:caption := "Next"
oXbp:clipSiblings := .T.
oXbp:create()
oXbp:activate := {|| DoSkip( 1, aEditControls ) }
oXbp:setName( PSHBTN_NEXT )
oXbp := XbpPushButton():new( drawingArea, , {224,8}, {72,24} )
oXbp:caption := "Ok"
oXbp:clipSiblings := .T.
oXbp:create()
oXbp:activate := {|| DoSkip( 0, aEditControls ), PostAppEvent( xbeP_Close,,, oDlg ) }
oDlg:show()
SetAppWindow( oDlg )
RETURN oDlg
PROCEDURE DoSkip( nSkip, aEditControls )
IF RLock()
AEval( aEditControls, {|o| o:getData() } )
DbSkip( nSkip )
AEval( aEditControls, {|o| o:setData() } )
DbUnlock()
ENDIF
RETURN
FUNCTION CenterPos( aSize, aRefSize )
RETURN { Int( (aRefSize[1] - aSize[1]) / 2 ) ;
, Int( (aRefSize[2] - aSize[2]) / 2 ) }
FUNCTION ResultWindow( cProducer, cMake , cColor, ;
nTotal , nCount, nStdDev )
LOCAL oDlg, oXbp, drawingArea
LOCAL aPos, aSize, aPresParam := { { XBP_PP_FGCLR, GRA_CLR_BLUE } }
aSize := {247,169}
aPos := SetAppWindow():currentPos()
aPos[1] += SetAppWindow():currentSize()[1] + 5
oDlg := XbpDialog():new( AppDesktop(), , aPos, aSize, , .F.)
oDlg:taskList := .F.
oDlg:border := XBPDLG_DLGBORDER
oDlg:title := "Sales Statistic"
oDlg:create()
drawingArea := oDlg:drawingArea
drawingArea:setFontCompoundName( FONT_HELV_SMALL )
oXbp := XbpStatic():new( drawingArea, , {8,8}, {224,128} )
oXbp:clipSiblings := .T.
oXbp:type := XBPSTATIC_TYPE_GROUPBOX
oXbp:caption := cProducer
IF ! Empty( cMake )
oXbp:caption += ", " + cMake
ENDIF
IF ! Empty( cColor )
oXbp:caption += ", " + cColor
ENDIF
oXbp:create()
oXbp := XbpStatic():new( drawingArea, , {40,88}, {80,24} )
oXbp:caption := "# of cars sold:"
oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT
oXbp:create()
oXbp := XbpStatic():new( drawingArea, , {40,64}, {80,24} )
oXbp:caption := "Gross income:"
oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT
oXbp:create()
oXbp := XbpStatic():new( drawingArea, , {40,40}, {80,24} )
oXbp:caption := "Average price:"
oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT
oXbp:create()
oXbp := XbpStatic():new( drawingArea, , {40,16}, {80,24} )
oXbp:caption := "Std. deviation:"
oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT
oXbp:create()
oXbp := XbpStatic():new( drawingArea, , {128,88}, {72,24}, aPresParam )
oXbp:caption := LTrim( Str( nCount, 6, 2 ) )
oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT
oXbp:create()
oXbp := XbpStatic():new( drawingArea, , {128,64}, {72,24}, aPresParam )
oXbp:caption := LTrim( Str( nTotal, 12, 2 ) )
oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT
oXbp:create()
oXbp := XbpStatic():new( drawingArea, , {128,40}, {72,24}, aPresParam )
oXbp:caption := IIf( nCount == 0, "0.00", LTrim( Str( nTotal/nCount, 12, 2 ) ) )
oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT
oXbp:create()
oXbp := XbpStatic():new( drawingArea, , {128,16}, {72,24}, aPresParam )
oXbp:caption := LTrim( Str( nStdDev, 12, 2 ) )
oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT
oXbp:create()
oDlg:show()
RETURN oDlg
FUNCTION DbStdDev( cFieldName, bFor, bAsgn )
LOCAL nPos := Fieldpos( cFieldName )
LOCAL nSqr := 0
LOCAL nSum := 0
LOCAL nCnt := 0
DbEval( {|n| n := FieldGet( nPos ), ;
nSum += n , ;
nSqr += n ^ 2 , ;
nCnt ++ ;
}, bFor )
Eval( bAsgn, nSum, nCnt )
IF nCnt < 2
RETURN 0
ENDIF
RETURN Sqrt( ( (nCnt*nSqr) - (nSum^2) ) / ;
(nCnt * (nCnt-1) ) )
Sample that displays the result window in a new thread:
//////////////////////////////////////////////////////////////////////
//
// Copyright:
// Alaska Software, (c) 2011. All rights reserved.
//
// Contents:
// Example program for calculating a sales statistic and
// displaying the result window in the new thread
//
//////////////////////////////////////////////////////////////////////
#include "Appevent.ch"
#include "Controls.ch"
PROCEDURE AppSys
RETURN
PROCEDURE Main
LOCAL nEvent, mp1, mp2, oXbp
CreateAppWindow()
SetAppFocus( SetAppWindow():childFromName( PSHBTN_NEXT ) )
oXbp := SetAppWindow():childFromName( PSHBTN_START )
oXbp:activate := {|| OneWindowPerThread() }
DO WHILE nEvent <> xbeP_Close
nEvent := AppEvent( @mp1, @mp2, @oXbp )
oXbp:handleEvent( nEvent, mp1, mp2 )
ENDDO
RETURN
PROCEDURE OneWindowPerThread
LOCAL oThread := Thread():new()
oThread:atStart := {|| DbUseArea(,,"Cars" ) }
oThread:atEnd := {|| DbCloseArea() }
oThread:start( "SalesStatistic" )
RETURN
PROCEDURE SalesStatistic
LOCAL nEvent, mp1, mp2, oXbp
LOCAL cBlock, nStdDev, nTotal, nCount, bFor, bAssign
LOCAL oDlg := SetAppWindow()
LOCAL cProducer := oDlg:childFromName( SLE_PRODUCER ):editBuffer()
LOCAL cMake := oDlg:childFromName( SLE_MAKE ):editBuffer()
LOCAL cColor := oDlg:childFromName( SLE_COLOR ):editBuffer()
cProducer := Trim( cProducer )
cBlock := "{|| Upper(FIELD->Producer)='" + Upper(cProducer) + "'"
IF oDlg:childFromName( CHKBOX_MAKE ):getData()
cMake := Trim( cMake )
cBlock += " .AND. Upper(FIELD->MAKE)='" + Upper(cMake) + "'"
ELSE
cMake := ""
ENDIF
IF oDlg:childFromName( CHKBOX_COLOR ):getData()
cColor := Trim( cColor )
cBlock += " .AND. Upper(FIELD->COLOR)='" + Upper(cColor) + "'"
ELSE
cColor := ""
ENDIF
bFor := &( cBlock + "}" )
bAssign := {|n1,n2| nTotal:=n1, nCount:=n2 }
nStdDev := DbStdDev( "SELLPRICE", bFor, bAssign )
oDlg := ResultWindow( cProducer, cMake , cColor, ;
nTotal , nCount, nStdDev )
DO WHILE nEvent <> xbeP_Close
nEvent := AppEvent( @mp1, @mp2, @oXbp )
oXbp:handleEvent( nEvent, mp1, mp2 )
ENDDO
oDlg:destroy()
RETURN
Sample that displays the result in the main thread:
//////////////////////////////////////////////////////////////////////
//
// Copyright:
// Alaska Software, (c) 2011. All rights reserved.
//
// Contents:
// Example program for calculating a sales statistic and
// displaying multiple result windows in the main thread.
//
//////////////////////////////////////////////////////////////////////
#include "Appevent.ch"
#include "Controls.ch"
#define xbeUser_Eval xbeP_User + 1
PROCEDURE AppSys
RETURN
PROCEDURE Main
LOCAL nEvent, mp1, mp2, oXbp
oXbp := CreateAppWindow()
oXbp:close := {|| AppQuit() }
SetAppFocus( oXbp:childFromName( PSHBTN_NEXT ) )
oXbp := oXbp:childFromName( PSHBTN_START )
oXbp:activate := {|| MultipleWindowsPerThread() }
DO WHILE .T.
nEvent := AppEvent( @mp1, @mp2, @oXbp )
IF nEvent == xbeUser_Eval
Eval( mp1 )
ELSE
oXbp:handleEvent( nEvent, mp1, mp2 )
ENDIF
ENDDO
RETURN
PROCEDURE AppQuit
CLOSE ALL
QUIT
RETURN
PROCEDURE MultipleWindowsPerThread
LOCAL cBlock, nTotal, nCount, bFor, bAssign, lExit, bUser
LOCAL oThread := Thread():new()
LOCAL oDlg := SetAppWindow()
LOCAL cProducer := oDlg:childFromName( SLE_PRODUCER ):editBuffer()
LOCAL cMake := oDlg:childFromName( SLE_MAKE ):editBuffer()
LOCAL cColor := oDlg:childFromName( SLE_COLOR ):editBuffer()
cProducer := Trim( cProducer )
cBlock := "{|| Upper(FIELD->Producer)='" + Upper(cProducer) + "'"
IF oDlg:childFromName( CHKBOX_MAKE ):getData()
cMake := Trim( cMake )
cBlock += " .AND. Upper(FIELD->MAKE)='" + Upper(cMake) + "'"
ELSE
cMake := ""
ENDIF
IF oDlg:childFromName( CHKBOX_COLOR ):getData()
cColor := Trim( cColor )
cBlock += " .AND. Upper(FIELD->COLOR)='" + Upper(cColor) + "'"
ELSE
cColor := ""
ENDIF
bFor := &( cBlock + "}" )
bAssign := {|n1,n2| nTotal:=n1, nCount:=n2 }
bUser := {|| SalesStatistic( cProducer, cMake , cColor, ;
nTotal , nCount, oThread:result ) }
oThread:atStart := {|| DbUseArea(,,"Cars" ) }
oThread:atEnd := {|| DbCloseArea(), ;
PostAppEvent( xbeUser_Eval, bUser,, SetAppWindow() ) }
oThread:start( "DbStdDev", "SELLPRICE", bFor, bAssign )
RETURN
PROCEDURE SalesStatistic( cProducer, cMake , cColor, ;
nTotal , nCount, nStdDev )
oDlg := ResultWindow( cProducer, cMake , cColor, ;
nTotal , nCount, nStdDev )
oDlg:close := {|mp1,mp2,obj| obj:destroy() }
RETURN
Incremental search in browses
The programming technique of using two event loops in two threads allows for an easy implementation of a generic incremental search routine for a browser. All we need to do is to combine the various features of Xbase++ and "play the multi-threading piano" using a database, an XbpBrowse object and an XbpSLE object as the key components. The database is opened in two threads, the XbpBrowse displays the records in thread A, and the XbpSLE receives user input that is searched for in the database in thread B. To be independent of an index, we use the DbLocate() and DbContiue() functions for searching. If a value is found in thread B, an event is posted to thread A in order to reposition the record pointer and refresh the browser. That's about all we have to implement and the following diagram illustrates the tasks of the two threads:
The whole secret of the incremental search routine lies in the fact that two record pointers exist for the same database file. One record pointer is moved by the browser in thread A for displaying the records, and the other is moved in thread B when input data is searched for. The latter takes place each time a letter is typed into the XbpSLE's edit buffer. When a matching record is found, the record pointer in thread A is synchronized with the record pointer in thread B and the browse display is refreshed. Now, let us look at the relevant lines of code:
01: #define xbeUser_Eval xbeP_User + 1
02:
03: PROCEDURE Main
04: LOCAL nEvent, mp1, mp2, oXbp, oThread
05: LOCAL oDlg, drawingArea, oFrame1, oFrame2, oBrowse
06:
07: USE Cars
08:
09: oDlg := XbpDialog():new( AppDesktop()):create()
10: drawingArea := oDlg:drawingArea
11: oFrame1 := XbpStatic():new( drawingArea ):create()
12: oFrame2 := XbpStatic():new( drawingArea ):create()
13:
14: oBrowse := CreateBrowser( oFrame1 )
15:
16: oThread := Thread():new()
17: oThread:start( ;
18: {|| XbpSLE():new( oFrame2, , {100,4}, {128,24} ) } )
19: oThread:synchronize(0)
10:
21: oXbp := oThread:result
22: oXbp:keyboard := ;
23: {|nKey,mp2,obj| IncrementalSearch( nKey, obj, oBrowse ) }
24: oXbp:create()
25:
26: oThread:start( "RunEventLoop", DbInfo( DBO_FILENAME ) )
27:
28: oDlg:show()
29: oBrowse:show()
30: SetAppFocus( oXbp )
31:
32: nEvent := xbe_None
33: DO WHILE nEvent <> xbeP_Close
34: nEvent := AppEvent( @mp1, @mp2, @oXbp )
35:
36: IF nEvent == xbeUser_Eval
37: Eval( mp1, oXbp )
38: ELSE
39: oXbp:handleEvent( nEvent, mp1, mp2 )
40: ENDIF
41: ENDDO
42: RETURN
Procedure Main begins with the creation of an XbpDialog window that contains the XbpSLE and the browser (line #9-14). However, the code above is abbreviated -the configuration variables are omitted- so that we can concentrate on the important parts for the program logic. These are line #1 with the user-defined event constant, line #23 defining the code block for keyboard events addressed to the XbpSLE, and the lines #16-26 which create the second thread and start it. Note that the thread is started twice: in line #17, a code block is passed to the :start() method and executed in the thread. This way, the XbpSLE object is instantiated in the thread and that is how we effectively make sure that the SLE receives events in the second thread. The additional event loop is then started in line #26 after calling the :synchronize() method. This assures that the thread has ended and is ready to run the second event loop programmed in procedure RunEventLoop():
43: PROCEDURE RunEventLoop( cDbfFile )
44: LOCAL nEvent, mp1, mp2, oXbp
45:
46: USE (cDbfFile)
47:
48: nEvent := xbe_None
49: DO WHILE nEvent <> xbeP_Close
50: nEvent := AppEvent( @mp1, @mp2, @oXbp )
51: oXbp:handleEvent( nEvent, mp1, mp2 )
52: ENDDO
53:
54: USE
55: RETURN
This procedure basically runs an event loop so that the XbpSLE receives events in the second thread. The database to search values in is opened before the loop starts and closed when it is exited. Note that a workarea is not selected! This means that the USE commands in procedure Main (line #7) and in line #46 both open the database in workarea #1. However, since USE is executed in two different threads, the database is opened in two different work spaces and is open two times when both event loops start in line #33 and #49.
The program is then controlled by the user, and the routine that effectively performs the incremental search is called via the :keyBoard code block defined in line #23. Each time a key is pressed, the current value of the XbpSLE's edit buffer is searched. For simplicity, only field variables of the Character data type are accepted in the search routine:
56: PROCEDURE IncrementalSearch( nKey, oSle, oBrowse )
57: LOCAL cValue := Upper( AllTrim( oSle:editBuffer() ) )
58: LOCAL oColumn := oBrowse:getColumn( oBrowse:colPos )
59: LOCAL cField := oColumn:cargo[1]
60: LOCAL cType := oColumn:cargo[2]
61: LOCAL cSearch := '{|| Upper( Left(%1,%2) )=="%3" }'
62: LOCAL nRecno, bGoto
63:
64: IF cType <> "C" .OR. Empty( cValue )
65: PostAppEvent( xbeP_Keyboard, nKey, NIL, oBrowse )
66: RETURN
67: ENDIF
68:
69: IF nKey == xbeK_RETURN
70: DbContinue()
71: ELSE
72: cSearch := StrTran( cSearch, "%1", cField )
73: cSearch := StrTran( cSearch, "%2", LTrim(Str(Len(cValue))))
74: cSearch := StrTran( cSearch, "%3", cValue )
75: DbLocate( &(cSearch) )
76: ENDIF
77:
78: IF Found()
79: nRecno := Recno()
80: bGoto := {|o| DbGoto(nRecno), o:refreshAll() }
81: PostAppEvent( xbeUser_Eval, bGoto, NIL, oBrowse )
82: ELSE
83: Tone(1000)
84: ENDIF
85: RETURN
Information about the database field to be used in the search is stored in the :cargo slot of the column objects displayed by the browser. This information is obtained via the XbpBrowse object (line #58) that is passed as a parameter toIncrementelSearch() by the :keyboardcode block defined in line #23. If the current column does not display a character field or if the edit buffer of the SLE is empty, the keystroke received by the SLE in the second thread is posted to the XbpBrowse object (#line 65) so that keys, like Page Up/Down, for example, are processed by the browser in the main thread. This way, database navigation occurs in the browser while the SLE has input focus.
The search expression is initially defined as a character string (line #61) that is compiled to a code block (line #75) after the placeholders for values in the expression are replaced with the StrTran() function. The first search is then initiated by the DbLocate() function, while subsequent lookups of the same value are performed when the user presses the Return key (#line 70).
If the value from the SLE's edit buffer is found, the record pointer of the database in the main thread is synchronized with the database in the second thread. This is accomplished by the code in the lines #79-81 which form the key logic of the incremental search. The code block in line #80 calls the DbGoto() function and refreshes the browse display. It is posted to the browser (line #81) along with the user-defined event constant. Since the browse object is created in the main thread, the code block is retrieved from the event loop of this thread (AppEvent() in line #34) and exeuted in line #37. This, again, causes the DbGoto() function to be executed in the work space of the main thread. As a result, the record pointer in thread #1 is positioned to the record found in thread #2. Note that the variable nRecnopassed to the DbGoto() function is embedded in the code block. The code block can be viewed as a vessel for transporting a LOCAL variable declared in the second thread to the main thread. That way, the record pointers in both threads are finally synchronized.
The following sample aggregates the different pieces of code discussed in this chapter:
//////////////////////////////////////////////////////////////////////
//
// Example program for a multi-threaded incremental search
// in a browser.
//
//////////////////////////////////////////////////////////////////////
#pragma Library( "XppUI2.lib" )
#include "Appevent.ch"
#include "Gra.ch"
#include "Font.ch"
#include "Dmlb.ch"
#include "Xbp.ch"
#define xbeUser_Eval xbeP_User + 1
PROCEDURE AppSys
RETURN
PROCEDURE Main
LOCAL nEvent, mp1, mp2, oXbp, oThread
LOCAL oDlg, drawingArea, oFrame1, oFrame2, oBrowse
SET DEFAULT TO ..\..\source\samples\data\misc
USE Cars
oDlg := XbpDialog():new( AppDesktop(), , {50,100}, ;
{465,352}, , .F.)
oDlg:taskList := .T.
oDlg:maxButton := .F.
oDlg:border := XBPDLG_DLGBORDER
oDlg:title := "Incremental Search Example"
oDlg:create()
SetAppWindow( oDlg )
drawingArea := oDlg:drawingArea
drawingArea:setFontCompoundName( FONT_HELV_SMALL )
oFrame1 := XbpStatic():new( drawingArea, ,{0,0},{456,292})
oFrame1:type := XBPSTATIC_TYPE_RAISEDRECT
oFrame1:create()
oFrame2 := XbpStatic():new( drawingArea, ,{0,292},{456,32})
oFrame2:type := XBPSTATIC_TYPE_RAISEDBOX
oFrame2:create()
oBrowse := CreateBrowser( oFrame1 )
oXbp := XbpStatic():new( oFrame2, , {4,4}, {80,24} )
oXbp:caption := "Search String:"
oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT
oXbp:create()
oThread := Thread():new()
oThread:start( {|| XbpSLE():new( oFrame2, , {100,4}, {128,24} ) } )
oThread:synchronize(0)
oXbp := oThread:result
oXbp:keyboard := {|nKey,mp2,obj| IncrementalSearch( nKey, obj, ;
oBrowse ) }
oXbp:create()
oThread:start( "RunEventLoop", DbInfo( DBO_FILENAME ) )
oDlg:show()
oBrowse:show()
SetAppFocus( oXbp )
nEvent := xbe_None
DO WHILE nEvent <> xbeP_Close
nEvent := AppEvent( @mp1, @mp2, @oXbp )
IF nEvent == xbeUser_Eval
Eval( mp1, oXbp )
ELSE
oXbp:handleEvent( nEvent, mp1, mp2 )
ENDIF
ENDDO
RETURN
FUNCTION CreateBrowser( oParent )
LOCAL oBrowse, oColumn, i, imax, aStruct, bFieldBlock
LOCAL aPos := {1,1}
LOCAL aSize := oParent:currentSize()
aSize[1] -=2
aSize[2] -=2
oBrowse := XbpBrowse():new( oParent,, aPos, aSize )
oBrowse:create()
oBrowse:skipBlock := {|n| DbSkipper(n) }
oBrowse:goTopBlock := {| | DbGoTop() }
oBrowse:goBottomBlock := {| | DbGoBottom() }
oBrowse:phyPosBlock := {| | Recno() }
oBrowse:posBlock := {| | OrdKeyNo() }
oBrowse:lastPosBlock := {| | LastRec() }
oBrowse:firstPosBlock := {| | 1 }
imax := FCount()
aStruct := DbStruct()
FOR i:=1 TO imax
IF .NOT. aStruct[i,2] $ "BMOVTXY"
bFieldBlock := FieldBlock(aStruct[i,1])
oColumn := oBrowse:addColumn( bFieldBlock, , aStruct[i,1] )
oColumn:cargo := aStruct[i]
ENDIF
NEXT
RETURN oBrowse
/*
* The following routines run in the second thread
*/
PROCEDURE RunEventLoop( cDbfFile )
LOCAL nEvent, mp1, mp2, oXbp
USE (cDbfFile)
nEvent := xbe_None
DO WHILE nEvent <> xbeP_Close
nEvent := AppEvent( @mp1, @mp2, @oXbp )
oXbp:handleEvent( nEvent, mp1, mp2 )
ENDDO
USE
RETURN
PROCEDURE IncrementalSearch( nKey, oSle, oBrowse )
LOCAL cValue := Upper( AllTrim( oSle:editBuffer() ) )
LOCAL oColumn := oBrowse:getColumn( oBrowse:colPos )
LOCAL cField := oColumn:cargo[1]
LOCAL cType := oColumn:cargo[2]
LOCAL cSearch := '{||Upper(Left(%1,%2))=="%3"}'
LOCAL nRecno, bGoto
IF cType <> "C" .OR. Empty( cValue )
PostAppEvent( xbeP_Keyboard, nKey, NIL, oBrowse )
RETURN
ENDIF
IF nKey == xbeK_RETURN
DbContinue()
ELSE
cSearch := StrTran( cSearch, "%1", cField )
cSearch := StrTran( cSearch, "%2", LTrim( Str(Len(cValue)) ) )
cSearch := StrTran( cSearch, "%3", cValue )
DbLocate( &(cSearch) )
ENDIF
IF Found()
nRecno := Recno()
bGoto := {|o| DbGoto(nRecno), o:refreshAll() }
PostAppEvent( xbeUser_Eval, bGoto, NIL, oBrowse )
ELSE
Tone(1000)
ENDIF
RETURN
A database watchdog
There is an intrinsic problem in multi-user database programming arising from the fact that two users may run the same program on two computers at the same time. Each instance of the program may use the same database file and both users may edit data of the same record simultaneously. The user who saves changed data first will loose edited data since it will be overwritten when the second user stores changed data to the same record. This is commonly termed as "lost update situation" (data updated by the first user is lost) and there are a variety of strategies to deal with this problem.
The Xbase++ DBFDBE, for example, can be configured via DbeInfo(DBFDBE_LOCKMODE) to raise a runtime error before data is written to a record when a lost update occurs. This is a legitimate way of handling lost updates. However, we will look at another solution and use a thread that warns a user about a lost update while data is edited. Literally spoken, a thread is used as a kind of "watchdog" that "barks" when something is changed in the current record by another program running somewhere else in a network.
Since data can exist not only in a database file but also in the memory of multiple computers, the task of the "watchdog" thread is to monitor data stored in a database file and compare it with data loaded into the memory of the computer which runs the program:
This diagram visualizes the programming problem to be solved: Thread A uses a database and allows for editing, saving and navigating records, while thread B compares data in memory with file data and displays a message if there is a mismatch. A mismatch can occur when data is saved to the file by another program while a record is edited and data is held in memory.
We are going to solve this problem using the same approach as in the "incremental search" example discussed in the previous section. By opening the same database file in two threads and synchronizing both record pointers, we take advantage of the Xbase++ work spaces. However, since all Xbase Parts for editing field values are displayed in thread A we cannot run an event loop in thread B and intercept events. Instead, we use a feature of the Xbase++ DatabaseEngine: notifications. When a database is open, objects can be registered in the corresponding work area which are notified when the record pointer changes. All we need to make sure of is that the object has a method named :notify() because this method is called by a DatabaseEngine for registered objects. This means that we have to build a user-defined thread class and implement the record pointer synchronization using notifications instead of events.
Before we look at the DbWatchDog class implementation let us first see a usage example of that class:
042: PROCEDURE Main
043: LOCAL nEvent, mp1, mp2, oXbp, oDlg, nHSem, lSemOwner
044:
045: nHSem := FCreate( "SampleSemaphore.sem" )
046: lSemOwner := .NOT. (nHSem==F_ERROR)
047:
048: SET DEFAULT TO ..\..\source\samples\data\misc
049: USE Customer
050:
051: oDlg := FrontEnd( lSemOwner )
052: oDlg:show()
053: SetAppWindow( oDlg )
054:
055: mp1 := mp2 := oXbp := NIL
056: nEvent := xbe_None
057: DO WHILE nEvent <> xbeP_Close
058:
059: nEvent := AppEvent( @mp1, @mp2, @oXbp )
060:
061: IF nEvent==WD_RECORD_UPDATED
062: MsgBox( "The current record was changed by" +Chr(13)+ ;
063: "another process or client station!", ;
064: SetAppWindow():Title )
065: ELSE
066: oXbp:handleEvent( nEvent, mp1, mp2 )
067: ENDIF
068:
069: ENDDO
070:
071: CLOSE
072:
073: oDlg:destroy()
074:
075: FClose( nHSem )
076: RETURN
After startup the example program is creating a simple filesemaphore with the function FCreate() (line #45). The local variable lSemOwner is used as flag whether the file could be created and then passed to the function FrontEnd(). Depending on whether the first instance of the process is running or not the user interface is adapted regarding its title and position.
Beginning from line #57 the program implements an event loop that is continiously fetching the next event in the event queue (line #59) and forwards that event to the corresponding Xbase Part (line #66). As we will see lateron a seperate thread is continiously comparing a record of the database Customer with the field values stored in memory. When this thread is detecting a mismatch (the record was modified from another thread or process on the same computer or any other computer in the network) a user defined event is posted to the application window. In line #57 and line #59 those events are handled and a message box is displayed.
As the additional thread is continiously comparing the database record with the values available in memory, it is important that when fetching the field values no data is read from the database engines internal cache. This is accomplished in the procedure DbeSys() by setting the lifetime of the data component to zero in line #38. Any read operation is enforced to fetch the field values from drive:
030: PROCEDURE DbeSys()
031: IF ! DbeLoad( "DBFDBE" )
032: MsgBox( "DBFDBE not loaded. Will exit now" )
033: QUIT
034: ENDIF
035: DbeSetDefault( "DBFDBE" )
036: // Any change in the workarea will be visible to different
037: // thread immediatly
038: DbeInfo( COMPONENT_DATA, DBFDBE_LIFETIME, 0 )
039: RETURN
079: FUNCTION FrontEnd( lFirstInstance )
080: LOCAL oDlg, oXbp, drawingArea, aEditControls, oXbp1, aPos, cTitle
081: LOCAL oWatchDog, nArea
082:
083: aEditControls := {}
084:
085: nArea := Select()
086:
087: oWatchDog := DbWatchDog():new()
088: oWatchDog:start()
089:
090: IF lFirstInstance
091: aPos := {104, 150}
092: cTitle := "First instance"
093: ELSE
094: aPos := {350, 150}
095: cTitle := "Second instance"
096: ENDIF
097:
098: oDlg := XbpDialog():new( AppDesktop(), , aPos,{230,160},, .F.)
099: oDlg:taskList := .T.
100: oDlg:title := cTitle
101: oDlg:create()
102:
103: drawingArea := oDlg:drawingArea
104: drawingArea:setFontCompoundName( FONT_HELV_SMALL )
105:
106: oXbp1 := XbpStatic():new( drawingArea, , {12,44}, {200,60} )
107: oXbp1:caption := "Attributes"
108: oXbp1:clipSiblings := .T.
109: oXbp1:type := XBPSTATIC_TYPE_GROUPBOX
110: oXbp1:create()
111:
112: oXbp := XbpStatic():new( oXbp1, , {16,4}, {60,20} )
113: oXbp:caption := "Firstname:"
114: oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT
115: oXbp:create()
116:
117: oXbp := XbpStatic():new( oXbp1, , {16,24}, {60,20} )
118: oXbp:caption := "Lastname:"
119: oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT
120: oXbp:create()
121:
122: oXbp := XbpSle():new( oXbp1, , {78, 4}, {116,20} )
123: oXbp:tabStop := .T.
124: oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( (nArea)->FIRSTNAME ),;
125: (nArea)->FIRSTNAME := x ) }
126: oXbp:create()
177: AAdd ( aEditControls, oXbp )
128:
129: oXbp := XbpSle():new( oXbp1, , {78,24}, {116,20} )
130: oXbp:tabStop := .T.
131: oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( (nArea)->LASTNAME ),;
132: (nArea)->LASTNAME := x ) }
133: oXbp:create()
134: AAdd ( aEditControls, oXbp )
135:
136:
137: oXbp := XbpPushButton():new( drawingArea, , {12,8}, {24,24} )
138: oXbp:caption := "<"
139: oXbp:clipSiblings := .T.
140: oXbp:create()
141: oXbp:activate := {|| (nArea)->( DoSkip( aEditControls, -1 ) ) }
142:
143: oXbp := XbpPushButton():new( drawingArea, , {36,8}, {24,24} )
144: oXbp:caption := ">"
145: oXbp:clipSiblings := .T.
146: oXbp:create()
147: oXbp:activate := {|| (nArea)->( DoSkip( aEditControls, 1 ) ) }
148:
149: oXbp := XbpPushButton():new( drawingArea, , {100,8}, {48,24} )
150: oXbp:caption := "Commit"
151: oXbp:clipSiblings := .T.
152: oXbp:create()
153: oXbp:activate := {|| (nArea)->( Write( aEditControls, oWatchDog ) ) }
154:
155: // Set Initial values for the controls
156: AEval( aEditControls, {|o| o:setData() } )
157:
158: RETURN oDlg
159:
160:
161: STATIC PROCEDURE DoSkip( aEditControls, nSkip )
162: DbSkip( nSkip )
163: AEval( aEditControls, {|o| o:setData() } )
164: RETURN
In the function FrontEnd() the user interface is created with an XbpDialog object (line #98) whereby the position of the dialog on the desktop and the dialog's title differ depending on whether the application is the first instance of the process or not (line #90). Among other Xbase Parts used to display statics and single line entry fields (from line #106 to #134) two XbpPushButton in line #137 and line #134 navigate the record pointer (line #162) and updating the user interface (line #163). A third XbpPushButton (line #149) invokes the procedure Write() that performs an an update of the database:
167: STATIC PROCEDURE Write( aEditControls, oWatchDog )
168:
169: IF RLock()
170:
171: IF .NOT. oWatchDog:beginUpdate()
172: UNLOCK
173: RETURN
174: ENDIF
175:
176: AEval( aEditControls, {|o| o:getData()} )
177:
178: // Unlocking the record also commits
179: UNLOCK
180:
181: oWatchDog:endUpdate()
182:
183: ELSE
184: MsgBox( "Record is locked" )
185: ENDIF
186:
187: RETURN
The function RLock() (line #169) guaranties that no other process is able to modify the record. At this place the DbWatchDog object, which is created in line #87, is informed about the update being in progress by calling the method :beginUpdate. In case the method returns .F. (false) a lost update situation was detected and a corresponding event is about to be processed by the message queue, thus the function returns without updating the record. When the record is written to the drive (line #179) or after the record pointer is moved (line #162) the oWatchDog object's method :notify() is called that loads the field values of the new record. Details about the method :notify() is discussed later. The DbWatchDog's object :endUpdate() then is called to indicate that the update has been accomplished.
According to the discussion in the chapter The two sides of a Thread objectwe can distinguish a client-side work area from a server-side work area. The database in the client-side work area is opened in line #49 and used by the XbpDialog, while the Customer database is opened a second time in the server-side work area when the thread starts (its method :atStartis executing). This two-sided view of the DbWatchDog class helps for understanding its implementation:
195: CLASS DbWatchDog FROM Thread
196: PROTECTED:
197: VAR aData, nRecno, cFileName, lIsInUpdate
198:
199: // server-side methods
200: METHOD atStart, execute, atEnd, readRecord
201:
202: EXPORTED:
203:
204: VAR lMsgPending
205:
206: METHOD init
207:
208: // client-side methods
209: METHOD register, notify, beginUpdate, endUpdate, stop
210:
211: // client-side and server-side
212: METHOD verifyUpToDate
213: ENDCLASS
235: METHOD DbWatchDog:init()
236: SUPER:init()
237: ::register()
238: ::setPriority( PRIORITY_IDLE )
239: ::lIsInUpdate := .F.
240: ::lMsgPending := .F.
241: RETURN self
242:
243: //
244: // client-side methods
245: //
246:
247:
248: METHOD DbWatchDog:register
249: ::aData := Array( FCount() )
250: ::cFileName := DbInfo( DBO_FILENAME )
251:
252: DbRegisterClient( self )
253: DbSkip( 0 )
254: RETURN self
When the DbWatchDog object is instantiated the method :init() is called (line #236) from the superclass to create the operating system's thread that then is standing by for executing code. Then the :register() method is called in line #237 which provides the key logic of the DbWatchDog class by registering the object in the current work area (line #252). Note that this work area is the client-side work area used by the XbpDialog in the example program. This means that the object receives notifications from this work area and that the server-side work area is not used until now, because the thread is not started yet. Only the name of the database file open in the client-side work area is obtained with the DbInfo() function. The first notification is sent to the object due to the DbSkip(0) call (line #253) and this causes the :notify() method to be invokded. The priority of the thread then is set to lowest (line #238) so that the thread runs only if no other thread of the process executes code. Finally the flag ::lIsInUpdate is initialize as indication whether to allocate and deallocate resources in the event that the thread is shutting down (:atEnd()) or starting up (:atStart()).
The DbWatchDog provides the methods :beginUpdate() and :endUpdate()to prepare for a record modification from the client side and for recovering from such an update situation. From the DbWatchDog's perspective a client-side update of the record means to stop the monitoring thread while the update is in progress:
273: METHOD DbWatchDog:beginUpdate()
274: LOCAL lUpdatePossible := .T.
275:
276: ::lIsInUpdate := .T.
277:
278: ::setInterval( NIL )
279: ::synchronize( 0 )
280:
281: DbSuspendNotifications()
282: IF ::lMsgPending .OR. (.NOT. ::verifyUpToDate())
283: lUpdatePossible := .F.
284: ENDIF
285: DbResumeNotifications()
286:
287: IF .NOT. lUpdatePossible
288: ::start()
289: ENDIF
290:
291: RETURN lUpdatePossible
292:
293:
294: METHOD DbWatchDog:endUpdate()
295: ::start()
296: RETURN self
Prior the thread is halted (line #278 and #279) the flag :lIsInUpdate is set to .T. (true). This is an indication for the methods :atEnd() and :atStart()not to free and allocate resources as they are reused after the thread is again started in line #288 or line #295. The method :beginUpdate() is returning .T. (true) only if no lost update situation is pending. Note that after returning from the method :synchronize() two conditions are met: The record that is monitored by the watchdog thread is locked (line #169) and the watchdog thread does not execute code. In case a lost update situation was already detected by the watchdog thread the IVAR :lMsgPending evaluates to .T.. In the other case the method ::verifyUpToDate() is called to compare the record of the database with the field values stored in hold in memory. As the method :beginUpdate() is called from client-side and a DbSkip() is performed in :verifyUpToDate() the notifications must be suspended (line #281). In case a lost-update situation is pending the monitoring thread is again started in line #288. After the new values are written to the database and committed (line #176 and 179) the DbWatchDog's method :endUpdate()is called in line #181 and thus the monitoring thread is restarted in line #295.
The method :notify() stores the current position of the record pointer and transfers the field values of the record to the :aData instance variable (line #265):
257: METHOD DbWatchDog:notify( nEvent, mp1 )
258: IF nEvent <> xbeDBO_Notify
259: RETURN self
260: ENDIF
261:
262: DO CASE
263: CASE mp1 == DBO_TABLE_UPDATE .OR. mp1 == DBO_MOVE_DONE
264: ::nRecno := Recno()
265: ::readRecord()
266:
267: CASE mp1 == DBO_CLOSE_REQUEST
268: ::stop()
269:
270: ENDCASE
271: RETURN self
Whenever a field of the current record is changed, or when the record pointer is moved, a DbWatchDog object is notified and reads the current record and field values so that it always has the same data buffered as the XbpDialog in the example program. When the database is closed, the object is notified accordingly and calls its :stop() method (line #268), where it removes itself from the notification list with DbDeRegisterClient() (line #300) and voids the time interval of the thread so that it is not re-started.
299: METHOD DbWatchDog:stop()
300: DbDeRegisterClient( self )
301: ::setInterval( NIL )
302: ::synchronize( 0 )
303: RETURN self
When the :start() method is called this invokes :atStart() at the beginning of the thread:
310: METHOD DbWatchDog:atStart()
311: IF .NOT. ::lIsInUpdate
312: USE (::cFileName)
313: ENDIF
314: ::lIsInUpdate := .F.
315: ::setInterval( 0 )
316: RETURN self
Since the thread is active in :atStart(), the client-side work area is not visible and the database is opened a second time if permitted by the flag ::lIsInUpdate. In any case the flag :lIsInUpdate is set to it's default value (line #311) so that the method :atEnd() will release resources in case the thread is shutting down. From line #312 on, the server-side work area is used and memory data held in the :aData array can be compared with field data. This is done in the :execute() method which is called continiously as the interval is set to zero (line #315):
319: METHOD DbWatchDog:execute()
320: ::lMsgPending := .F.
321: IF .NOT. ::verifyUpToDate()
322: ::lMsgPending := .T.
323: PostAppEvent( WD_RECORD_UPDATED, , , SetAppWindow() )
324: ::readRecord()
325: ENDIF
326: RETURN self
When comparison of data fails in line #321 an event is sent to the application window's message queue. The memory holding the record values then is updated in line #324 to be ready for the next iteration of method :execute(). It is important to understand that in case the thread is halted in the method :beginUpdate() (line #278 and #279) and a message was just posted to the window's message queue (line #323) then the IVAR ::lMsgPending evaluates to true (line #322). This is an indication in :beginUpdate() that a lost update situation is pending allthough :verifyUpToDate() evaluates to .T. (true) as the field values holded in memory have been updated in line #324.
221: METHOD DbWatchDog:verifyUpToDate()
222: LOCAL i, iMax
223:
224: iMax := FCount()
225: DbGoTo( ::nRecno )
226:
277: FOR i:=1 TO imax
228: IF .NOT. (::aData[i] == Fieldget(i))
229: RETURN .F.
230: ENDIF
231: NEXT
232: RETURN .T.
When the data comparison fails in line #377, the FOR..NEXT loop does not run to completion which indicates that a field value has changed. The key for the comparison, however, is :nRecno. It holds the record pointer of the client-side work area which is assigned in the :notify() method (line #264). This means that the DbGoto() function (line #225) positions the record pointer of the server-side work area to the same record. Although both work areas have the same database file open, a notification does not occur when DbGoto() is executed since the object is not registered in the server-side work area.
The thread is terminated from the client in the methods :beginUpdate()and :stop(). The method :beginUpdate is called prior the record is updated, the method :stop() is called in line #268 within :notify()when the client-side workarea is closed. Depending on the flag :lIsInUpdate the server-side work area is closed, just before the thread finnally ends executing code (line #336):
329: METHOD DbWatchDog:atEnd()
330: IF .NOT. ::lIsInUpdate
331: DbCloseAll()
332: ::aData := NIL
333: ::cFileName := ""
334: ::nRecno := 0
335: ENDIF
336: RETURN self
Although the DbWatchDog class is limited in this discussion to the comparison of the current record in one database and a simple message box displayed in a lost update situation, it demonstrates a pretty advanced programming technique. The combination of notifications, threads and work spaces allows for extending the functionality of almost any database application without big changes in the original code. The only thing required is to register a user-defined thread object in the used work areas so that it can react to notifications. For example, it is very easy to extend the DbWatchDog class and detect lost updates for all records that have been edited on one computer during the last two hours. This can even include a higher granularity on a single field basis instead of an entire record. Also, monitoring the number of records in a database and displaying new records automatically in a fixed time interval is easily programmed using this technique.
The following sample aggregates the different pieces of code discussed in this chapter:
//////////////////////////////////////////////////////////////////////
//
// DBWATCH.PRG
//
// Copyright:
// Alaska Software, (c) 2011. All rights reserved.
//
// Contents:
// Test for the database watch dog example.
//
// Run this program a second time on the same or another
// computer that has access to the ..\data\misc directory, and edit
// a field while both programs display the same record.
//
//////////////////////////////////////////////////////////////////////
#include "fileio.ch"
#include "thread.ch"
#include "dbfdbe.ch"
#include "appevent.ch"
#include "xbp.ch"
#include "font.ch"
#define WD_RECORD_UPDATED xbeP_User + 1
PROCEDURE AppSys
RETURN
PROCEDURE DbeSys()
IF ! DbeLoad( "DBFDBE" )
MsgBox( "DBFDBE not loaded. Will exit now" )
QUIT
ENDIF
DbeSetDefault( "DBFDBE" )
// Any change in the workarea will be visible to different
// thread immediatly
DbeInfo( COMPONENT_DATA, DBFDBE_LIFETIME, 0 )
RETURN
PROCEDURE Main
LOCAL nEvent, mp1, mp2, oXbp, oDlg, nHSem, lSemOwner
nHSem := FCreate( "SampleSemaphore.sem" )
lSemOwner := .NOT. (nHSem==F_ERROR)
SET DEFAULT TO ..\..\source\samples\data\misc
USE Customer
oDlg := FrontEnd( lSemOwner )
oDlg:show()
SetAppWindow( oDlg )
mp1 := mp2 := oXbp := NIL
nEvent := xbe_None
DO WHILE nEvent <> xbeP_Close
nEvent := AppEvent( @mp1, @mp2, @oXbp )
IF nEvent==WD_RECORD_UPDATED
MsgBox( "The current record was changed by" +Chr(13)+ ;
"another process or client station!", ;
SetAppWindow():Title )
ELSE
oXbp:handleEvent( nEvent, mp1, mp2 )
ENDIF
ENDDO
CLOSE
oDlg:destroy()
FClose( nHSem )
RETURN
FUNCTION FrontEnd( lFirstInstance )
LOCAL oDlg, oXbp, drawingArea, aEditControls, oXbp1, aPos, cTitle
LOCAL oWatchDog, nArea
aEditControls := {}
nArea := Select()
oWatchDog := DbWatchDog():new()
oWatchDog:start()
IF lFirstInstance
aPos := {104, 150}
cTitle := "First instance"
ELSE
aPos := {350, 150}
cTitle := "Second instance"
ENDIF
oDlg := XbpDialog():new( AppDesktop(), , aPos,{230,160},, .F.)
oDlg:taskList := .T.
oDlg:title := cTitle
oDlg:create()
drawingArea := oDlg:drawingArea
drawingArea:setFontCompoundName( FONT_HELV_SMALL )
oXbp1 := XbpStatic():new( drawingArea, , {12,44}, {200,60} )
oXbp1:caption := "Attributes"
oXbp1:clipSiblings := .T.
oXbp1:type := XBPSTATIC_TYPE_GROUPBOX
oXbp1:create()
oXbp := XbpStatic():new( oXbp1, , {16,4}, {60,20} )
oXbp:caption := "Firstname:"
oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT
oXbp:create()
oXbp := XbpStatic():new( oXbp1, , {16,24}, {60,20} )
oXbp:caption := "Lastname:"
oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT
oXbp:create()
oXbp := XbpSle():new( oXbp1, , {78, 4}, {116,20} )
oXbp:tabStop := .T.
oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( (nArea)->FIRSTNAME ),;
(nArea)->FIRSTNAME := x ) }
oXbp:create()
AAdd ( aEditControls, oXbp )
oXbp := XbpSle():new( oXbp1, , {78,24}, {116,20} )
oXbp:tabStop := .T.
oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( (nArea)->LASTNAME ),;
(nArea)->LASTNAME := x ) }
oXbp:create()
AAdd ( aEditControls, oXbp )
oXbp := XbpPushButton():new( drawingArea, , {12,8}, {24,24} )
oXbp:caption := "<"
oXbp:clipSiblings := .T.
oXbp:create()
oXbp:activate := {|| (nArea)->( DoSkip( aEditControls, -1 ) ) }
oXbp := XbpPushButton():new( drawingArea, , {36,8}, {24,24} )
oXbp:caption := ">"
oXbp:clipSiblings := .T.
oXbp:create()
oXbp:activate := {|| (nArea)->( DoSkip( aEditControls, 1 ) ) }
oXbp := XbpPushButton():new( drawingArea, , {100,8}, {48,24} )
oXbp:caption := "Commit"
oXbp:clipSiblings := .T.
oXbp:create()
oXbp:activate := {|| (nArea)->( Write( aEditControls, oWatchDog ) ) }
// Set Initial values for the controls
AEval( aEditControls, {|o| o:setData() } )
RETURN oDlg
STATIC PROCEDURE DoSkip( aEditControls, nSkip )
DbSkip( nSkip )
AEval( aEditControls, {|o| o:setData() } )
RETURN
STATIC PROCEDURE Write( aEditControls, oWatchDog )
IF RLock()
IF .NOT. oWatchDog:beginUpdate()
UNLOCK
RETURN
ENDIF
AEval( aEditControls, {|o| o:getData()} )
// Unlocking the record also commits
UNLOCK
oWatchDog:endUpdate()
ELSE
MsgBox( "Record is locked" )
ENDIF
RETURN
//////////////////////////////////////////////////////////////////////
//
// The watchdog class
//
//////////////////////////////////////////////////////////////////////
CLASS DbWatchDog FROM Thread
PROTECTED:
VAR aData, nRecno, cFileName, lIsInUpdate
// server-side methods
METHOD atStart, execute, atEnd, readRecord
EXPORTED:
VAR lMsgPending
METHOD init
// client-side methods
METHOD register, notify, beginUpdate, endUpdate, stop
// client-side and server-side
METHOD verifyUpToDate
ENDCLASS
METHOD DbWatchDog:readRecord()
AEval( ::aData, {|x,i| x := FieldGet(i) } ,,, .T. )
RETURN self
METHOD DbWatchDog:verifyUpToDate()
LOCAL i, iMax
iMax := FCount()
DbGoTo( ::nRecno )
FOR i:=1 TO imax
IF .NOT. (::aData[i] == Fieldget(i))
RETURN .F.
ENDIF
NEXT
RETURN .T.
METHOD DbWatchDog:init()
SUPER:init()
::register()
::setPriority( PRIORITY_IDLE )
::lIsInUpdate := .F.
::lMsgPending := .F.
RETURN self
//
// client-side methods
//
METHOD DbWatchDog:register
::aData := Array( FCount() )
::cFileName := DbInfo( DBO_FILENAME )
DbRegisterClient( self )
DbSkip( 0 )
RETURN self
METHOD DbWatchDog:notify( nEvent, mp1 )
IF nEvent <> xbeDBO_Notify
RETURN self
ENDIF
DO CASE
CASE mp1 == DBO_TABLE_UPDATE .OR. mp1 == DBO_MOVE_DONE
::nRecno := Recno()
::readRecord()
CASE mp1 == DBO_CLOSE_REQUEST
::stop()
ENDCASE
RETURN self
METHOD DbWatchDog:beginUpdate()
LOCAL lUpdatePossible := .T.
::lIsInUpdate := .T.
::setInterval( NIL )
::synchronize( 0 )
DbSuspendNotifications()
IF ::lMsgPending .OR. (.NOT. ::verifyUpToDate())
lUpdatePossible := .F.
ENDIF
DbResumeNotifications()
IF .NOT. lUpdatePossible
::start()
ENDIF
RETURN lUpdatePossible
METHOD DbWatchDog:endUpdate()
::start()
RETURN self
METHOD DbWatchDog:stop()
DbDeRegisterClient( self )
::setInterval( NIL )
::synchronize( 0 )
RETURN self
//
// server-side methods
//
METHOD DbWatchDog:atStart()
IF .NOT. ::lIsInUpdate
USE (::cFileName)
ENDIF
::lIsInUpdate := .F.
::setInterval( 0 )
RETURN self
METHOD DbWatchDog:execute()
::lMsgPending := .F.
IF .NOT. ::verifyUpToDate()
::lMsgPending := .T.
PostAppEvent( WD_RECORD_UPDATED, , , SetAppWindow() )
::readRecord()
ENDIF
RETURN self
METHOD DbWatchDog:atEnd()
IF .NOT. ::lIsInUpdate
DbCloseAll()
::aData := NIL
::cFileName := ""
::nRecno := 0
ENDIF
RETURN self
Combo boxes and database fields
Combo boxes offer a convenient possibility to present a limited set of valid values for editing to a user. However, from a programmer's point of view, they are not as easily used as other Xbase Parts because a combo box is a combination of a single line edit field (SLE) and a listbox. Both parts of a combo box can have a :dataLink code block and this is what makes an XbpComboBox object more complex to program with than a simple XbpSLE object, more so when the combo box is used for editing database fields. In this case, the SLE part displays the value of the field of the current record, while the listbox part holds all values valid for that field. The latter adds another level of complexity if the valid values are unknown at programming time, i.e. if they are stored in a database. For example, a combo box for selecting a month's name is easier programmed than one for selecting attributes of parts in a sales database. Names of months represent a fixed set of values (they could be hard coded) while data representing part attributes, such as the color, for example, may change in the life time of an application. This, in turn, makes it necessary to provide for a changing set of valid values presented in a combo box.
This introduction outlines the different problems that may occur in the usage of combo boxes and we are going to discuss the implementation of a DbComboBox() class that makes a programmer's life easier. This class is especially designed for database field editing and includes the following features:
Correct assignment of the :dataLink code block
Automatic collection of the value-set in alphabetic order
"Self learning" capability when a user enters new, or unknown, data
As usual, we start with a usage example and look at the implementation later. The combo box programmed below allows for selecting a color for a car when a purchase order is entered, for example:
01: USE CARS
02:
03: oXbp := DbComboBox():new( oParent, , aPos, aSize )
04: oXbp:tabStop := .T.
05: oXbp:dataLink := ;
06: {|x| IIf( PCOUNT()==0, Trim(CARS->COLOR), CARS->COLOR:=x ) }
07: oXbp:create()
This code is not much different from the creation of a standard XbpSLE control, only another class function is called in line #3. However, oXbpis a combo box and it displays the value of the field COLOR of the current record when :create() is executed. That means, the combo box is programmed as easily as an XbpSLE control. What is not obvious in the code is that the listbox part of the combo box is still empty after :create(), but it is automatically filled with unique values from the COLOR field, and this is accomplished in a second thread. Here is what happens:
The diagram illustrates that thread A is already running the event loop while thread B is still busy with scanning the database and collecting unique field values. However, this does not matter since the listbox part of the combo box is not visible and the SLE part displays the value of the current record in thread A. This way, the dialog window containing the combo box can be displayed without the user having to wait until the value-set for the listbox part is entirely collected in thread B from the same database.
Now we can look at the implementational part of the DbComboBox() class and discuss the interesting lines of code. The class declaration shows the instance variables available in addition to the XbpComboBox() class, and which methods are overloaded:
01: CLASS DbComboBox FROM XbpComboBox
02: EXPORTED:
03: VAR alias, autoFill, dataLink
04:
05: METHOD init, create
06: ACCESS ASSIGN METHOD dataLink
07: METHOD editBuffer , setData , getData
08: METHOD getAllItems, autoFill, _autofill
09: ENDCLASS
10:
11:
12: METHOD DbComboBox:init( <parameter list,...> )
13: ::XbpComboBox:init( <parameter list,...> )
14: ::autoFill := .T.
15: ::alias := Alias()
16: RETURN self
17:
18:
19: METHOD DbComboBox:create( <parameter list,...> )
20: ::XbpComboBox:create( <parameter list,...> )
21: IF ::autoFill
22: ::autoFill()
23: ENDIF
24: RETURN self
The two instance variables :alias and :autoFill serve for configuration purposes and must be set when the :create() method is called. They are initialized with default values in :init(), and it is obvious that objects of the DbComboBox() class require an open database as a prerequisite to work. The alias name is required later for the methods :autoFill(), :setData() and :getData(). It matches with the alias name used in the code block assigned to :dataLink. Access to this instance variable is overloaded in line #6. This way, we make sure that the code block is always assigned to -or retrieved from- the SLE part of the combo box. This is also the case for the methods declared in line #7 which use the SLE part's methods for editing:
25: METHOD DbCombobox:dataLink( bData )
26: IF PCount() == 1
27: ::XbpSLE:datalink := bData
28: ENDIF
29: RETURN ::XbpSLE:datalink
30:
31:
32: METHOD DbCombobox:editBuffer
33: RETURN ::xbpSLE:editBuffer()
34:
35:
36: METHOD DbCombobox:setData( xValue )
37: IF xValue == NIL
38: xValue := ::xbpSLE:setData()
39: ELSE
40: xValue := ::xbpSLE:setData( xValue )
41: ENDIF
42: RETURN xValue
43:
44:
45: METHOD DbCombobox:getData
46: LOCAL cValue := ::xbpSLE:getData()
47: LOCAL aItems := ::getAllItems()
48: LOCAL nPos
49:
50: IF Ascan( aItems, {|c| Upper(c) == Upper(cValue) } ) == 0
51: nPos := AScan( aItems, {|c| Upper(c) > Upper(cValue) } )
52: IF nPos == 0
53: ::addItem( cValue )
54: ELSE
55: ::insItem( nPos, cValue )
56: ENDIF
57: ENDIF
58: RETURN cValue
It might be helpful to recall the :datalink code block for understanding the "self learning" feature of a DbComboBox() object implemented in the lines #47-57:
oXbp:dataLink := ;
{|x| IIf( PCOUNT()==0, Trim(CARS->COLOR), CARS->COLOR:=x ) }
Assume that the combo box is editable and the user has typed a value into the SLE part that does not yet exist in the database, or listbox part, respectively. The :getData() call in line #46 evaluates the code block and passes the contents of the SLE's edit buffer on to it. This value is assigned to the database field within the code block and returned by :getData(). Line #47 obtains all strings existing in the listbox part and the following lines check if cValue exists and find the proper insertion point when it is not found. This way, a user can select new values from the combobox without having to type them again.
The "self learning" feature is very convenient for the user, but now let us look into what makes the DbComboBox() class convenient for the programmer: the :autoFill() method. Remember, this method is called in :create() if the :autoFill instance variable is set to .T. (true), and it fills the listbox part of the combo box with values from the database:
59: METHOD DbCombobox:autoFill
60: LOCAL cFileName := (::alias)->( DbInfo(DBO_FILENAME) )
61: LOCAL oThread := Thread():new()
62:
63: oThread:atStart := {|| DbUseArea(,, cFileName, ::alias ) }
64: oThread:atEnd := {|| DbCloseArea() }
65: oThread:start( {|| ::_autoFill() } )
66: ::setData()
67: RETURN self
As we have discussed in an earlier chapter, the "secret" of the :autoFill()method is a Thread object that opens the same database a second time via the :atStart code block in line #63. The database is then available in the thread's work space when the additional :_autoFill() method is executed (line #65). The key-logic, however, is provided by the fact that the database is opened twice using the same alias name. This way, it becomes possible to evaluate the :dataLink code block simultaneously in two threads, for two different work areas.
The code block is evaluated in line #66 within :setData() (work area for displaying the field value in the SLE part), and in line #77 below (work area for collecting field values in the listbox part). Note that the code block is referenced in a LOCAL variable (line #71) so that the ACCESS method :dataLink() is just called once:
68: METHOD DbCombobox:_autoFill
69: LOCAL nCount := 0
70: LOCAL nMax := 100
71: LOCAL bData := ::dataLink
72: LOCAL aData[ nMax ]
73: LOCAL cValue, nPos
74:
75: DO WHILE ! Eof()
76: cValue := Eval ( bData )
77: nPos := AScan( aData, cValue, 1, nCount+1 )
78: IF nPos == 0
79: nCount ++
80: IF nCount > nMax
81: nMax += 100
82: ASize( aData, nMax )
83: ENDIF
84: aData[ nCount ] := cValue
85: ENDIF
86: SKIP
87: ENDDO
88:
89: ASize( aData, nCount )
90: ASort( aData,,, {|c1,c2| Upper(c1) < Upper(c2) } )
91: FOR nPos := 1 TO nCount
92: ::addItem( aData[nPos] )
93: NEXT
94: RETURN self
The only task of the second thread is to collect those field values (return value of the :dataLink code block) in an array which are not found in the array, and to add each array element in sorted order to the listbox part when the database is entirely scanned (line #92). That means, the thread will end automatically and there is no need to provide for a method that stops the thread.
This discussion points out another interesting area where multiple threads make an application more comfortable to use: data not required for immediate display can be collected in the background while the user decides what to do with a dialog window that is freshly displayed. It may take one, two or more seconds until a user has made up his or her mind, and this is quite a long time for a background thread to collect data.
Here you find the complete source of the sample
#include "Gra.ch"
#include "Xbp.ch"
#include "Appevent.ch"
#include "Font.ch"
#include "Dmlb.ch"
PROCEDURE AppSys
RETURN
PROCEDURE Main
LOCAL nEvent, mp1, mp2, oXbp
oDlg := FrontEnd()
oDlg:show()
nEvent := xbe_None
DO WHILE nEvent <> xbeP_Close
nEvent := AppEvent( @mp1, @mp2, @oXbp )
oXbp:handleEvent( nEvent, mp1, mp2 )
ENDDO
RETURN
FUNCTION FrontEnd
LOCAL oDlg, oXbp, drawingArea, aEditControls := {}, oXbp1
SET DEFAULT TO ..\..\source\samples\data\misc
USE Cars ALIAS CARS
oDlg := XbpDialog():new( AppDesktop(), , {104,150}, {230,185}, , .F.)
oDlg:taskList := .T.
oDlg:title := "DbComboBox Example"
oDlg:create()
drawingArea := oDlg:drawingArea
drawingArea:setFontCompoundName( FONT_HELV_SMALL )
oXbp1 := XbpStatic():new( drawingArea, , {12,44}, {200,100} )
oXbp1:caption := "Attributes"
oXbp1:clipSiblings := .T.
oXbp1:type := XBPSTATIC_TYPE_GROUPBOX
oXbp1:create()
oXbp := XbpStatic():new( oXbp1, , {16,64}, {48,20} )
oXbp:caption := "Producer:"
oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT
oXbp:create()
oXbp := XbpStatic():new( oXbp1, , {16,36}, {48,20} )
oXbp:caption := "Make:"
oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT
oXbp:create()
oXbp := XbpStatic():new( oXbp1, , {16,8}, {48,20} )
oXbp:caption := "Color:"
oXbp:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_RIGHT
oXbp:create()
oXbp := CARS->( DbComboBox():new( oXbp1, , {68, 4}, {116,80} ) )
oXbp:tabStop := .T.
oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( CARS->PRODUCER ), ;
CARS->PRODUCER := x ) }
oXbp:create()
AAdd ( aEditControls, oXbp )
oXbp := CARS->( DbComboBox():new( oXbp1, , {68,-24}, {116,80} ) )
oXbp:tabStop := .T.
oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( CARS->MAKE ), ;
CARS->MAKE := x ) }
oXbp:create()
AAdd ( aEditControls, oXbp )
oXbp := CARS->( DbComboBox():new( oXbp1, , {68,-52}, {116,80} ) )
oXbp:tabStop := .T.
oXbp:dataLink := {|x| IIf( PCOUNT()==0, Trim( CARS->COLOR ), ;
CARS->COLOR := x ) }
oXbp:create()
AAdd ( aEditControls, oXbp )
oXbp := XbpPushButton():new( drawingArea, , {12,8}, {92,24} )
oXbp:caption := "Previous"
oXbp:clipSiblings := .T.
oXbp:create()
oXbp:activate := {|| CARS->( LockSkip( aEditControls, -1 ) ) }
oXbp := XbpPushButton():new( drawingArea, , {120,8}, {92,24} )
oXbp:caption := "Next"
oXbp:clipSiblings := .T.
oXbp:create()
oXbp:activate := {|| CARS->( LockSkip( aEditControls, 1 ) ) }
RETURN oDlg
STATIC PROCEDURE LockSkip( aEditControls, nSkip )
IF RLock()
AEval( aEditControls, {|o| o:getData() } )
DbSkip( nSkip )
AEval( aEditControls, {|o| o:setData() } )
DbUnlock()
ELSE
MsgBox( "Record is locked" )
ENDIF
RETURN
CLASS DbComboBox FROM XbpComboBox
EXPORTED:
VAR alias, autoFill
METHOD init, create
INTRODUCE ACCESS ASSIGN METHOD setDataLink VAR Datalink
METHOD editBuffer, setData, getData, getAllItems
METHOD autoFill , _autofill
ENDCLASS
METHOD DbComboBox:init( oParent, oOwner, aPos, aSize, aPP, lVisible )
SUPER:init( oParent, oOwner, aPos, aSize, aPP, lVisible )
::autoFill := .T.
::alias := Alias()
RETURN self
METHOD DbComboBox:create( oParent, oOwner, aPos, aSize, aPP, lVisible )
SUPER:create( oParent, oOwner, aPos, aSize, aPP, lVisible )
IF ::autoFill
::autoFill()
ENDIF
RETURN self
METHOD DbCombobox:setDataLink( bData )
IF PCount() == 1
::XbpSLE:datalink := bData
ENDIF
RETURN ::XbpSLE:datalink
METHOD DbCombobox:editBuffer()
RETURN ::xbpSLE:editBuffer()
METHOD DbCombobox:setData( xValue )
IF xValue == NIL
xValue := ( ::alias )->( ::xbpSLE:setData() )
ELSE
xValue := ( ::alias )->( ::xbpSLE:setData( xValue ) )
ENDIF
RETURN xValue
METHOD DbCombobox:getData
LOCAL cValue := ( ::alias )->( ::xbpSLE:getData() )
LOCAL aItems := ::getAllItems()
LOCAL nPos
IF Ascan( aItems, {|c| Upper(c) == Upper(cValue) } ) == 0
nPos := AScan( aItems, {|c| Upper(c) > Upper(cValue) } )
IF nPos == 0
::addItem( cValue )
ELSE
::insItem( nPos, cValue )
ENDIF
ENDIF
RETURN cValue
METHOD DbCombobox:getAllItems
RETURN AEval( Array( ::numItems() ), ;
{|x,i| x := ::getItem(i) },,, .T. )
METHOD DbCombobox:autoFill
LOCAL cFileName := (::alias)->( DbInfo(DBO_FILENAME) )
LOCAL oThread := Thread():new()
oThread:atStart := {|| DbUseArea(,, cFileName, ::alias ) }
oThread:atEnd := {|| DbCloseArea() }
oThread:start( {|| ::_autoFill() } )
::setData()
RETURN self
METHOD DbCombobox:_autoFill
LOCAL nCount := 0
LOCAL nMax := 100
LOCAL bData := ::dataLink
LOCAL aData[ nMax ]
LOCAL cValue, nPos
DO WHILE ! Eof()
cValue := Eval( bData )
nPos := AScan( aData, cValue, 1, nCount+1 )
IF nPos == 0
nCount ++
IF nCount > nMax
nMax += 100
ASize( aData, nMax )
ENDIF
aData[ nCount ] := cValue
ENDIF
SKIP
ENDDO
ASize( aData, nCount )
ASort( aData,,, {|c1,c2| Upper(c1) < Upper(c2) } )
FOR nPos := 1 TO nCount
::addItem( aData[nPos] )
NEXT
RETURN self
High-speed browsing of record subsets
The browse display of a subset of records stored in a database is one of the most challenging programming problems in database applications, and there are many approaches to achieve a high performance in creating a subset and accessing it with a browser. Conditional indexes, for example, provide for one of the fastest ways of accessing a subset of records, since a FOR condition is monitored by a Database Engine (DBE), and only those records included in an index file can be accessed in the database file (INDEX ON expression FOR condition TO file). The fastest possibility for data access is to create a temporary database file that holds only those records which fit into the subset (COPY TO file FOR condition), while the easiest way is to use a filter so that only records matching a condition are visible (SET FILTER TO condition). However, each approach has advantages and disadvantages in terms of performance, flexibility and ease of maintenance which must be weighed depending on the size of the database, the amount of data a subset may include, and whether or not it is suitable in a multi-user environment.
Advantages and Disadvantages of creating subsets
| Approach | Pro | Contra |
|---|---|---|
| INDEX ON .. FOR .. | Fast data access | Not flexible |
| Easy to maintain | ||
| COPY TO .. FOR .. | Fastest data access | Slow creation of subset |
| Index not required | Duplication of data leads to high programming overhead in multi-user environments when data is edited | |
| SET FILTER TO .. | Very flexible | Slow access |
| Definition "on the fly" | Unsuitable for large databases |
The table lists only a few pro/con arguments for the standard approaches available to create subsets, but it includes the major points: Speed, Flexibility and Ease of maintenance. For example, SET FILTER is extremely flexible but it is also very slow, especially when a filter is defined for a large database and the resulting subset contains only few records. This scenario leads to a poor performance if the subset is displayed with a browser because database navigation takes place and the DBE evaluates the filter condition for each record until a matching record is found.
Creating a conditional index file leads to high speed on the browser display but limits the flexibility of defining a subset to the index expression. That means: there is no flexibility to change the subset during runtime unless conditional index files are created (and deleted). If a user wants to define the subset during runtime, for example, the conditional index approach becomes unsuitable for large databases since the index file must be created "on the fly" and this implies that the user has to wait until the index file is created.
The COPY TO approach has the advantage of fastest data access in a multi-user environment since data can be copied from a server to a client station. This can be done easily at runtime, but the creation of the temporary database file needs time and data must be copied back to the server when it is edited. This leads to a high programming overhead.
These standard approaches for creating subsets of records can be combined so that data access within a browser is optimized in terms of Speed, Flexibility and Ease of maintenance. The solution is to create an array "on the fly" that holds the record numbers of all records being part of a subset, and to tell a browser to use this array for database navigation. This way, it is possible to achieve the flexibility of a SET FILTER command while keeping the speed of a conditional index.
The programming problem
The major programming problem to solve is not the collection of record numbers in an array for all records being part of a subset, the problem to solve is to do this "behind the scenes". For example, if a user selects a menu option that invokes the browse display of the subset, the user wants to see the browser immediately. That means: there is little or no time to create the subset "on the fly". We must present the subset of records as fast as possible.
Assume a database has 20000 records but the subset to display has only 1000 records. How do we present this subset as fast as possible? The answer is: we use a 2-step approach for collecting the matching record numbers. In the first step, only the number of records are collected in an array as the browser can display. The second step completes the collection while the user can view data already included in the initial subset. For example, if the browser can display 50 records, we prepare the subset to include 50 records, display the browser, and continue with the collection of the remaining 950 record numbers. This way, the user can start with browsing data and the application has time to collect the rest of the subset while the user is reading -not browsing- data.
The programming solution
The 2-step approach becomes possible when we split the programming task into two threads: the first thread displays the browser and the second thread prepares the array holding record numbers of the subset. This leads to a very powerful and flexible solution. However, the implementation is quite complex because the program flow in the first thread depends on an intermediate result of the second thread: the first thread can display the browser only after the second thread has collected a number of records sufficient to fill the browse display. That means: the first thread starts the second one and must wait until a sufficient number of records is collected before the browser can be built. In other words, the second thread must tell the first thread "Ok, I have found enough records to keep the user busy. You can build the browser now!", i.e. the second thread controls the program flow of the first thread.
Controlling the program flow between threads is possible using Signal objects. If two threads use the same Signal object, one thread can wait for a signal until another thread triggers the signal. The waiting thread suspends program execution and resumes when the other thread triggers the signal. This is basically the key-logic of a user-defined DbSubset class which allows for flexible high-speed browsing of record subsets. The subset creation, or collection of record numbers, can be done in two steps so that the user can see an initial part of the subset quickly, and the program can complete the subset while the user is busy with viewing the initial part of the subset.
The diagram illustrates the program flow within the two required threads: Thread A opens a database, starts thread B and suspends program execution. Thread B opens the same database and collects record numbers while thread A is waiting for a signal. The signal is triggered in thread B when enough records are found to fill the browser. Thread A resumes program execution in turn, while thread B is waiting until the browser is displayed. Then, both threads are running parallel. Thread A runs an event loop while thread B scans the remaining records and terminates when the last record of the database is reached.
The DbSubset class
A solution for the programming problem is the user-defined DbSubset class whose usage is quite simple:
USE database
SET INDEX TO file
oSubset := DbSubset():new( {|| FOR condition } )
oSubset:prepare( 50 )
< creation and display of browser >
oSubset:finish()
The DbSubset object receives the knowledge what record numbers to collect on instantiation by passing a FOR condition defined as a code block to the :new() method. The initial subset is created in the :prepare()method, the browser is displayed, and the subset is completed within :finish().
The browser uses methods of the DbSubset object for database navigation which is quite similar to a standard browse solution where a browser displays an entire database. Just compare the navigation code blocks of a browser below:
Standard solution
oBrowse:skipBlock := {|n| DbSkipper(n) }
oBrowse:goTopBlock := {| | DbGoTop() }
oBrowse:goBottomBlock := {| | DbGoBottom() }
Subset solution
oBrowse:skipBlock := {|n| oSubset:skip(n) }
oBrowse:goTopBlock := {| | oSubset:goTop() }
oBrowse:goBottomBlock := {| | oSubset:goBottom() }
It is obvious that the only difference in browsing an entire database vs. browsing a subset lies within the navigation code blocks of the browse object. Instead of calling functions for database navigation directly in the code blocks, there is one level of indirection and the DbSubset object effectively takes care of record pointer movement. Since it knows which records are part of a subset it can limit database navigation to exactly these records.
All that is left to discuss now is "How does the DbSubset object know of the subset?". For this we look into the class implementation (Note: you should be familiar with the terms Client-side and Server-side of a Thread object. Client-side methods are executed in thread A, server-side methods are executed in thread B. Refer to The two sides of a Thread objectif you are not sure. ).
01: CLASS DbSubset FROM Thread
02: PROTECTED:
03: VAR cDbfFile, cIndexFile
04: VAR aRecno , nRecno, nLastRec
05: VAR oSignal , nPrepare
06:
07: METHOD atStart, execute, atEnd // server-side methods
08:
09: EXPORTED:
10: VAR alias, area
11: VAR subsetBlock
12: // client-side methods:
13: METHOD init, prepare, finish, clear // for subset creation
14:
15: METHOD bof , eof , recno, lastRec // for dbf-state and
16: METHOD skip, goto, goTop, goBottom // record navigation
17: ENDCLASS
A DbSubset object knows which database (and index file) to use (line #3), the record numbers of the subset, the current record and the size of the subset (#line 4). There are three groups of methods: the server-side methods collect record numbers in the array :aRecno, which is done in the thread managed by a DbSubset object. On the client-side, the methods declared in line #13 are required for initialization and subset creation, while those in line #15 and #16 provide for database navigation.
The initialization of the object and the preparation of the initial part of the subset is the task of the methods :init() and :prepare(). Both are client-side methods:
18: METHOD DbSubset:init( bSubset )
19: SUPER
20: ::subsetBlock := bSubset
21: ::nRecno := 0
22: ::nLastRec := 0
23: ::oSignal := Signal():new()
24: RETURN self
25:
26:
27: METHOD DbSubset:prepare( nFirstSubset )
28: IF Valtype( nFirstSubset ) <> "N"
29: nFirstSubset := 25
30: ENDIF
31:
32: ::alias := Alias()
33: ::area := Select()
34:
35: ::nPrepare := nFirstSubset
36: ::cDbfFile := DbInfo( DBO_FILENAME )
37: ::cIndexFile := OrdbagName( OrdNumber() )
38: ::aRecno := Array( ::nPrepare )
49:
40: ::start()
41: ::oSignal:wait()
42:
43: ::goTop()
44: RETURN self
The integral logic for a DbSubset object is provided by the code block :subsetBlock, which defines the condition for records to be included in the subset, and the Signal object created in line #23. When the :prepare() method is called (in thread A), a DbSubset object collects alias, work area and file information (lines #32-37) of the current work area and starts its own thread in line #40 (thread B). The method then suspends program execution in line #41 and waits for the signal to be triggered by a server-side method running in the started thread. The methods executed at the start/end of the thread simply open/close the database in a work area of the thread's work space that corresponds to the client-side work area:
45: METHOD DbSubset:atStart
46: DbSelectArea( ::area )
47: USE (::cDbfFile) ALIAS (::alias) SHARED
48: IF .NOT. Empty( ::cIndexFile )
49: SET INDEX TO (::cIndexFile)
50: ENDIF
51: RETURN self
52:
53:
54: METHOD DbSubset:atEnd
55: DbCloseAll()
56: RETURN self
At this point of the program, we have thread A waiting for a signal in line #41 to resume program execution, and thread B running the :execute()method. This method uses DbLocate() / DbContinue() to search for records matching the condition of :subsetBlock:
57: METHOD DbSubset:execute
58: LOCAL nStep := 500
59: LOCAL nMax := Len( ::aRecno )
60: LOCAL nCount
61:
62: DbLocate( ::subsetBlock )
63: ::nLastRec := 0
64: nCount := 0
65:
66: DO WHILE Found()
67: IF ++ nCount > nMax
68: ASize( ::aRecno, nMax += nStep )
69: ENDIF
70: ::aRecno[ nCount ] := Recno()
71:
72: ::nLastRec ++
73: DbContinue()
74:
75: IF ::nLastrec == ::nPrepare
76: ::oSignal:signal()
77: ::oSignal:wait(500)
78: ENDIF
79: ENDDO
80:
81: ASize( ::aRecno, ::nLastRec )
82: ::oSignal:signal()
83: RETURN self
The search is initiated in line #62 and all numbers of records matching the condition are subsequently stored in the array :aRecno within the DO WHILE Found() loop. Note that the array's size is incremented in steps of 500 elements (line #68) when the number of found records exceeds the number of available array elements. This is by far more efficient than using the AAdd() function for each found record. A final adjustment of the:aRecno array is then required in line #81 when the loop has ended.
When the number of found records has reached the number of records required for displaying the initial subset, the signal is triggered in line #76 and:execute() suspends program execution in line #77. This way, the client-side method :prepare() resumes and positions the record pointer in the client-side work area to the first record of the subset by calling :goTop() in line #43. As a result, the record pointer is already positioned correctly when the browser is built in thread A.
The browser is created when :prepare() has finished. This is not part of the DbSubset class but the task of another routine that creates a browser. However, browser creation takes place while thread B waits for the signal in line #77. It could be the following code, for example, that is executed in thread A while thread B is suspended:
// Creating a browser
oBrowse := GuiBrowseDb( oParent,,, oSubSet )
FOR i:=1 TO FCount()
cField := FieldName( i )
oBrowse:addColumn( FieldBlock(cField), , cField )
NEXT
oBrowse:show()
oSubSet:finish()
Once the browser has executed its :show() method, the initial subset is visible and thread B can resume. This is accomplished by calling the :finish() method in thread A:
84: METHOD DbSubset:finish
85: ::oSignal:signal()
86: RETURN self
The only task of this method is to trigger the signal thread B is waiting for in line #77 of the :execute() method. That means, thread B resumes, completes the DO WHILE Found() loop and closes the server-side work area upon thread termination in line #55. From here on, only client-side methods for database navigation are called via navigation code blocks of the browser:
oBrowse:skipBlock := {|n| oSubset:skip(n) }
oBrowse:goTopBlock := {| | oSubset:goTop() }
oBrowse:goBottomBlock := {| | oSubset:goBottom() }
The navigation methods of the DbSubset class include access to internal state variables used to determine the current record of the subset, the entire number of records and whether or not the record pointer is moved in front of the first (bof) or behind the last record (eof).
87: METHOD DbSubset:bof
88: RETURN ::nRecno < 1
89:
90: METHOD DbSubset:eof
91: RETURN ::nRecno > ::nLastRec
92:
93: METHOD DbSubset:recno
94: RETURN ::nRecno
95:
96: METHOD DbSubset:lastRec
97: RETURN ::nLastRec
98:
99: METHOD DbSubset:gotop
100: RETURN ::goto( 1 )
101:
102: METHOD DbSubset:goBottom
103: RETURN ::goto( ::nLastRec )
104:
105: METHOD DbSubset:skip( nSkip )
106: IF Valtype( nSkip ) <> "N"
107: nSkip := 1
108: ENDIF
110:
110: IF ::nRecno < 1
111: ::nRecno := 1
112: ELSEIF ::nRecno > ::nLastRec
113: ::nRecno := ::nLastRec + 1
114: ENDIF
115: RETURN ::goto( ::nRecno + nSkip )
Since the navigation operates on an array of physical record numbers, a DbSubset object maintains a virtual record number in its instance variable :nRecno which points to the array element of :aRecno holding the current physical record number. Therefore, the navigation to the top/bottom of the subset is easily done in line #100 and #103 by passing the values for the virtual record number to the :goto() method. The same approach is implemented in the :skip() method which validates the value for the virtual record number before passing it along with the desired number of records to skip to :goto(). It is this method where physical record pointer movement effectively takes place:
116: METHOD DbSubset:goto( nRecno )
117: LOCAL nOldRec := ::nRecno
118: LOCAL nSkipped
119:
120: ::nRecno := nRecno
121:
122: IF ::bof()
123: nSkipped := 1 - nOldRec
124: ::nRecno := 0
125: IF ::nLastRec > 0
126: DbGoto( ::aRecno[1] )
127: ELSE
128: DbGoto( LastRec()+1 )
129: ENDIF
130:
131: ELSEIF ::eof()
132: nSkipped := ::nLastRec - Min( nOldRec, ::nLastRec )
133: ::nRecno := ::nLastRec + 1
134: DbGoto( LastRec()+1 )
135:
136: ELSE
137: nSkipped := ::nRecno - nOldRec
138: DbGoto( ::aRecno[ ::nRecno ] )
139: ENDIF
140: RETURN nSkipped
The record pointer of the browsed work area on the client-side is moved using the DbGoto() function so that only those records become visible in the browser whose record numbers are stored in the :aRecno array (line #138). If the virtual record pointer is moved outside the subset's boundaries, the physical record pointer is positioned either to the first record of the subset (line #126) or to the ghost record of the work area (line #128 or #134).
The most important part of the :goto() method, however, is its return value. It indicates the number of records that could be skipped. This, again, is required by the browser for correct incremental display. In other words, the browser passes the number of records it wants to skip to its :skipBlock which must return the actual number of records that could be skipped. This is vital when the top/bottom of the browse display is reached during the stabilization cycle of the browser.
This ends the discussion of the DbSubset class and it might be valuable to summarize its powerful features:
The client-side methods of a DbSubset object can be used by a browser for database navigation.
The server-side methods collect record numbers of a subset of records.
A Signal object provides for an automatic "hand shake protocol" between two threads so that database access for browse display and subset collection is optimized.
Subsets can be defined for indexed or non-indexed databases.
The flexibility of subset definition is the same as with SET FILTER.
The speed for browsing a subset is the same as with an entire database, once the record numbers for the subset are collected.
As a conclusion, the DbSubset class is a pretty sophisticated example for applied multi-threading technology. It creates a table of record numbers "on the fly" in an optimized manner. The optimization is achieved by a Signal object so that database access only takes place in either of two threads until a sufficient number of records is collected for initial display. This way, an initial part of data can be presented to the user quickly so that a program can respond fast, no matter how large a database may be. Well, to be precise: the approach is not suitable if the subset would contain one million records. In this case, the array holding record numbers would grow to one million elements. This may exhaust main memory so that the operating system is forced to start swapping.
Another advantage of the DbSubset class is the fact that it does no matter whether a subset is created on an indexed or non-indexed database. A DbSubset object maintains a virtual record pointer for database navigation and it knows the first and last record, plus the number of records in the subset. This makes it easy to navigate the subset with a browser's scroll bar, for example. Also, the DbSubset class can easily be extended with client-side methods that allow for adding/deleting record numbers to/from the internal array. This way, a browser can assume the functionality of a multi-selection listbox by using the navigation methods of a DbSubset object.
The following sample aggregates the different pieces of code discussed in this chapter:
//////////////////////////////////////////////////////////////////////
//
// Test routine for the DbSubset class.
//
//////////////////////////////////////////////////////////////////////
#include "Appevent.ch"
#include "Common.ch"
#pragma Library( "XppUi2.lib" )
PROCEDURE AppSys
RETURN
PROCEDURE Main( cSubset )
LOCAL nEvent, mp1, mp2, oXbp, oBrowse, cField, i, oSubset
LOCAL time1, cDefault, cMsg
cDefault := "..\..\source\samples\data\misc"
SET DEFAULT TO (cDefault)
IF ! File( cDefault + "\Cars.ntx" )
USE Cars EXCLUSIVE
INDEX ON PRODUCER TO (cDefault + "\Cars")
ENDIF
USE Cars SHARED
SET INDEX TO Cars
oSubSet := DbSubSet():new( {|| Left(FIELD->PRODUCER,1) $ "BFMP" } )
oSubSet:prepare( 30 )
// Create a hidden dialog window
oXbp := GuiStdDialog( "Standard GUI Browser for DBF" )
// Create browser in the window
oBrowse := GuiBrowseDb( oXbp:drawingArea,,, oSubSet )
// Add columns for Recno() and all fields of the database
oBrowse:addColumn( {|| PadL( oSubset:physRecno(), 6 ) }, , "Recno")
FOR i:=1 TO FCount()
cField := FieldName( i )
oBrowse:addColumn( FieldBlock(cField), , cField )
NEXT
// The browser always fills the entire window after :resize()
oXbp:drawingArea:resize := ;
{|mp1,mp2,obj| obj:childList()[1]:setSize(mp2) }
oXbp:show()
SetAppWindow( oXbp )
oBrowse:show()
oSubSet:finish()
cMsg := ""
cMsg += "Browser displays a subset of "
cMsg += LTrim(str(LastRec())) +" records" + Chr(13)
cMsg += "of an indexed database"
MsgBox( cMsg )
SetAppFocus( oBrowse )
DO WHILE nEvent <> xbeP_Close
nEvent := AppEvent( @mp1, @mp2, @oXbp )
oXbp:handleEvent( nEvent, mp1, mp2 )
ENDDO
RETURN
******************************************************************
* Create a GUI browser with navigation code blocks for a database
******************************************************************
FUNCTION GuiBrowseDB( oParent, aPos, aSize, oSubSet )
LOCAL oBrowse
oBrowse := XbpBrowse():new( oParent,, aPos, aSize ):create()
// Navigation code blocks for the browser using a DbSubSet object
oBrowse:skipBlock := {|n| oSubSet:Skip(n) }
oBrowse:goTopBlock := {| | oSubSet:GoTop() }
oBrowse:goBottomBlock := {| | oSubSet:GoBottom() }
oBrowse:phyPosBlock := {| | oSubset:Recno() }
// Navigation code blocks for the vertical scroll bar
oBrowse:posBlock := {| | oSubSet:Recno() }
oBrowse:lastPosBlock := {| | oSubSet:LastRec() }
oBrowse:firstPosBlock := {| | 1 }
RETURN oBrowse
******************************************************************
* Create a hidden dialog window
******************************************************************
FUNCTION GuiStdDialog( cTitle )
LOCAL oDlg, oParent
DEFAULT cTitle TO "Standard Dialog Window"
oParent := AppDesktop()
oDlg := XbpDialog():new( oParent,,{10,60},{600,400},, .F.)
oDlg:icon := 1
oDlg:taskList := .T.
oDlg:title := cTitle
oDlg:create()
oDlg:drawingArea:setFontCompoundName( "8.Helv" )
RETURN oDlg
//////////////////////////////////////////////////////////////////////
//
// DBSUBSET.PRG
//
// Copyright:
// Alaska Software GmbH, (c) 1999. All rights reserved.
//
// Contents:
// The DbSubset class.
//
//////////////////////////////////////////////////////////////////////
#include "Dmlb.ch"
CLASS DbSubset FROM Thread
PROTECTED:
VAR cDbfFile, cIndexFile
VAR aRecno , nRecno, nLastRec
VAR oSignal , nPrepare
METHOD atStart, execute, atEnd // server-side methods
EXPORTED:
VAR alias, area
VAR subsetBlock
// client-side methods:
METHOD init, prepare, finish // for subset creation
METHOD recno, lastRec, skip, physRecno // for dbf state and
METHOD goto, goTop, goBottom, goGhost // record navigation
ENDCLASS
/*
* Client-side methods for subset creation
*/
METHOD DbSubset:init( bSubset )
::thread:init()
::subsetBlock := bSubset
::nRecno := 0
::nLastRec := 0
::oSignal := Signal():new()
RETURN self
METHOD DbSubset:prepare( nFirstSubset )
IF Valtype( nFirstSubset ) <> "N"
nFirstSubset := 25
ENDIF
::alias := Alias()
::area := Select()
::nPrepare := nFirstSubset
::cDbfFile := DbInfo( DBO_FILENAME )
::cIndexFile := OrdbagName( OrdNumber() )
::aRecno := Array( ::nPrepare )
::start()
::oSignal:wait()
::goTop()
RETURN self
METHOD DbSubset:finish()
::oSignal:signal()
RETURN self
/*
* Methods for server-side work area
*/
METHOD DbSubset:atStart()
DbSelectArea( ::area )
USE (::cDbfFile) ALIAS (::alias) SHARED
IF .NOT. Empty( ::cIndexFile )
SET INDEX TO (::cIndexFile)
ENDIF
RETURN self
METHOD DbSubset:atEnd()
DbCloseAll()
RETURN self
METHOD DbSubset:execute()
LOCAL nStep := 500
LOCAL nMax := Len( ::aRecno )
LOCAL nCount
DbLocate( ::subsetBlock )
::nLastRec := 0
nCount := 0
DO WHILE Found()
IF ++ nCount > nMax
ASize( ::aRecno, nMax += nStep )
ENDIF
::aRecno[ nCount ] := Recno()
// This may only be incremented after the Recno() assignment.
// Otherwise, the class is not thread safe due to
// DbGoto( ::aRecno[ ::nRecno ] ) in the :goto() method
::nLastRec ++
DbContinue()
IF ::nLastrec == ::nPrepare
::oSignal:signal()
::oSignal:wait()
ENDIF
ENDDO
ASize( ::aRecno, ::nLastRec )
::oSignal:signal()
RETURN self
/*
* State and navigation methods for client-side work area
*/
METHOD DbSubset:recno()
RETURN ::nRecno
METHOD DbSubset:physRecno()
RETURN ::aRecno[ ::nRecno ]
METHOD DbSubset:lastRec()
RETURN ::nLastRec
METHOD DbSubset:gotop()
RETURN ::nRecno := 1
METHOD DbSubset:goBottom()
RETURN ::nRecno := ::nLastRec
METHOD DbSubset:skip( nSkip )
IF Valtype( nSkip ) <> "N"
nSkip := 1
ENDIF
RETURN ::goto( ::nRecno + nSkip )
METHOD DbSubset:goto( nRecno )
LOCAL nSkipped
IF nRecno < 1
nSkipped := 1 - ::nRecno
IF ::nLastRec > 0
DbGoto( ::aRecno[1] )
ELSE
::goGhost()
ENDIF
::nRecno := 1
ELSEIF nRecno > ::nLastRec
nSkipped := ::nLastRec - Min( ::nRecno, ::nLastRec )
::goGhost()
::nRecno := ::nLastRec
ELSE
nSkipped := nRecno - ::nRecno
DbGoto( ::aRecno[ nRecno ] )
::nRecno := nRecno
ENDIF
RETURN nSkipped
METHOD DbSubset:goGhost()
DO WHILE .NOT. Eof()
DbGoto( LastRec()+1 )
ENDDO
RETURN self
A personal reminder
We are going to discuss in this section a new area of problems that have little or nothing to do with database programming but can easily be solved with a user-defined thread class. We will talk about time-controlled execution of code and persistency of Thread objects. Assume the following scenario: shortly after you have entered your office in the morning, your boss pops in and announces a general meeting at 4:00pm in the conference room. Bad luck for you, because your time table is full with programming tasks to meet a dead-line for a next software release. You are going to work on the computer the whole day and -we all know it- there is a good chance to forget the time while hunting down the last bugs in your source code. You could set up an alarm clock in order not to forget the time, but there is a better way: have your computer remind you just-in-time before the meeting. For example, it could pop up a message box at 3:55pm that tells you about the meeting.
This scenario describes a situation where program code is to be executed at a particular point in time. The Xbase++ Thread class allows for defining the exact time when a Thread object is to start its thread. This can be defined in the unit "seconds passed since midnight" using the :setStartTime() method. Assume this code:
nHour := 15 // = 3pm
nMinute := 55
oThread := Thread():new()
oThread:setStartTime( nHour * 3600 + nMinute * 60 )
oThread:start( "MsgBox", "You have a meeting at 4pm" )
What happens here? The Thread object has executed its :start() method, but no code is executed in the thread until 3:55pm. Instead, a timer is set by the Thread object so that the thread is active but does not use any CPU resources until the specified time is reached. The MsgBox() function is executed at 3:55pm and the message is displayed just-in-time.
This is the basic functionality we are going to take advantage of in a user-defined Reminder class. A Reminder object is to display a message box at a particular point in time. However, we make the class a little bit more useful and allow for storing and retrieving Reminder objects to/from a file (persistent Thread objects). This way, a program can define multiple reminders for one day, it can be terminated and restarted so that reminders become active again which have not yet displayed their message text. This gives us also the opportunity to learn about a powerful mechanism of Xbase++ in conjunction with object persistency: the :notifyLoaded() method.
But first things first! What we start with is a class designed around the :setStartTime() method. Each instance of the class knows a message text and the point in time when to display the message. A basic usage scenario of that class can be defined as follows:
01: PROCEDURE RemindMe( cText, nHour, nMinute )
02: LOCAL oThread
03:
04: oThread := Reminder():new( cText, nHour, nMinute )
05: oThread:start()
06: RETURN
07:
08:
09: EXIT PROCEDURE SaveReminders
10: Reminder():save( "Remind.me" )
11: RETURN
12:
13:
14: INIT PROCEDURE RestoreReminders
15: IF File( "Remind.me" )
16: Reminder():restore( "Remind.me" )
17: FErase( "Remind.me" )
18: ENDIF
19: RETURN
All that is missing in this code is the user-interface so that a user can enter the start time (hour and minute) and a text for the reminder. Procedure RemindMe() would be called from the user-interface code, and it simply creates a Reminder object which starts its thread (lines #4 and #5). Pending reminders are automatically saved in the file REMIND.ME when the program terminates (line #10; Note: It is an EXIT PROCEDURE) and automatically loaded from this file when the program is started again (line #16; Note: This is an INIT PROCEDURE). This is a simple and straightforward code and there is nothing more to care about when using Reminder objects. Now, let's go into class details:
It is possible that the RemindMe() procedure above is called multiple times so that multiple Reminder objects exist for displaying messages at different points in time. Therefore, it is necessary to keep track of them until they have displayed their message. For this, we are using an array, or stack, to collect them in, and remove each Reminder object from the stack when it has displayed its message.
The best place for keeping track of instances of a class is a member variable of the class object since this exists only once for all instances of a class. Using an array assigned to a class variable is sufficient, and here we go with the class declaration:
01: CLASS Reminder FROM Thread
02: PROTECTED:
03: CLASS VAR aThreads
04:
05: CLASS METHOD push
06: SYNC CLASS METHOD pop
07:
08: METHOD execute, atEnd
09:
10: EXPORTED:
11: CLASS METHOD initClass, save, restore
12:
13: VAR nHour, nMinute, cText
14: METHOD init , start , notifyLoaded
15: ENDCLASS
16:
17:
18: CLASS METHOD Reminder:initClass
19: ::aThreads := {}
20: RETURN self
The class variable :aThreads is used as stack for collecting Reminder objects and initialized with an empty array within :initClass()(line #19). The class methods :push() and :pop() collect the instances in this array or remove them from the stack:
21: CLASS METHOD Reminder:push( oReminder )
22: AAdd( ::aThreads, oReminder )
23: RETURN self
24:
25:
26: CLASS METHOD Reminder:pop( oReminder )
27: LOCAL nPos := AScan( ::aThreads, oReminder )
28: ARemove( ::aThreads, nPos )
29: RETURN self
Note that the :pop() method is declared with the SYNC attribute (line #6). This is required because the method performs two operations on the array: it queries the position of the element in the array (line #27) and removes the element (line #28). Both operations must be guaranteed to run to completion in a multi-threading scenario. For example, if two Reminder objects remove themselves from the stack at the same time, they may do so only one after the other. If the :pop() method is called from two threads, or Reminder objects, simultaneously, the two method calls are automatically serialized due to the SYNC attribute.
These two class methods are sufficient to keep track of all instances of the Reminder class. Now we can look into what happens when a Reminder object is created at runtime:
30: METHOD Reminder:init( cText, nHour, nMinute )
31: ::cText := cText
32: ::nHour := nHour
33: ::nMinute := nMinute
34: SUPER
35: RETURN self
36:
37:
38: METHOD Reminder:start
39: ::push( self )
40: ::setStartTime( 3600 * ::nHour + 60 * ::nMinute )
41: ::thread:start()
42: RETURN self
43:
44:
45: METHOD Reminder:execute
46: MsgBox( ::cText )
47: RETURN self
48:
49:
50: METHOD Reminder:atEnd
51: ::pop( self )
52: RETURN self
A Reminder object stores data for the time and message text in the corresponding instance variables and initializes its super class. When the :start() method is called, it pushes itself onto the stack (line #39), sets the start-timer and starts its thread (line #41). Note that an instance object can call a class method because the instance "knows" its class object (the expression in line #39 is equivalent to Reminder():push(self)).
When the :start() method returns, nothing happens until either the specified time is reached or the program is terminated. In the former case, the thread effectively executes the code programmed in :execute() and :atEnd(). That is: it displays a message box. The thread ends when the user clicks the Ok button in the box, and the Reminder object removes itself from the stack (line #51).
Let us assume now that the stack is not empty when the program terminates (remember, there must be an EXIT PROCEDURE that calls the :save() method), and the program is re-started at a later point in time. These situations are covered by the follwing code:
53: CLASS METHOD Reminder:save( cFileName )
54: IF .NOT. Empty( ::aThreads )
55: WriteStream( cFileName, Var2Bin( ::aThreads ) )
56: ENDIF
57: RETURN
58:
59:
60: CLASS METHOD Reminder:restore( cFileName )
61: LOCAL cStream
62: IF ReadStream( cFileName, @cStream )
63: Bin2Var( cStream )
64: ENDIF
65: RETURN
66:
67:
68: METHOD Reminder:notifyLoaded
69: SUPER
70: ::start()
71: RETURN self
The :save() method accepts as parameter a file name where to store the pending Reminder objects (those which have not yet displayed their message box). Instead of traversing the array :aThreads and storing each Reminder object individually, the entire stack is converted with Var2Bin() to a binary stream of data (string) that is written to a file (line #55). When this is done, we know the objects are in a safe place and the program can terminate.
When the program is started again, the :restore() method is called via an INIT PROCEDURE executed automatically at program start:
Reminder():restore( "Remind.me" )
This line of code is worth a careful look. What happens? The call to the class function Reminder() initializes the class object via :initClass()so that an empty array is assigned to :aThreads and the stack is ready to collect Reminder objects (line #19). The class object is returned from Reminder() and executes its :restore() method. The stream of binary data is read from the file (line #62) and all that is required for restoring the previous state is line #63 where binary data (string) is converted back to its original data type. The Bin2Var() function creates an array holding binary data of Reminder objects and implicitly iterates the array to restore the objects. When an object is converted to its original data type, the method :notifyLoaded() is called implicitly, if it exists. This is the case for the Reminder class. In turn, the super class is initialized (line #69) so that volatile system resources for managing a thread become available again ("volatile" means: data that cannot be stored because it can exist only during runtime). Line #70 simply calls the :start()method. That means, the object pushes itself to the stack, sets the start-timer, starts its thread, and we end up with having the same state as we had when the program was terminated.
The Reminder class is quite simple since it knows only the time and doesn't know the date. This could be a good extension useful in a generic calendar class for monitoring a time table. However, it demonstrates two important programming techniques that open up a new field of easy solutions to non-trivial programming problems. Optimizing the work load in a computer network between day and night, for example, can be done using the :setStartTime() method. By making thread objects persistent, they can be sent across a network so that a user-defined Thread object is created in one computer and "wakes up" in another computer (Warning: be extremely careful in doing so! You might open Pandora's box).
The Bin2Var() function is extremely helpful in conjunction with :notifyLoaded()since the implicit method call allows for automatic allocation of system resources that cannot be made persistent.
The following sample aggregates the different pieces of code discussed in this chapter:
//////////////////////////////////////////////////////////////////////
//
// Test routine for the Reminder class.
//
//////////////////////////////////////////////////////////////////////
#include "Gra.ch"
#include "Xbp.ch"
#include "Appevent.ch"
#include "Font.ch"
#include "FileIO.ch"
PROCEDURE Main
LOCAL nEvent, mp1, mp2, oXbp
SetAppWindow():useShortCuts := .T.
?
? "Enter a reminder and wait until the reminder pops up."
oXbp := XbpPushButton():new(,, {10,10}, {96,24} )
oXbp:caption := "Remind Me"
oXbp:activate := {|mp1,mp2,obj| RemindMe( obj ) }
oXbp:create()
DO WHILE nEvent <> xbeP_Close
nEvent := AppEvent( @mp1, @mp2, @oXbp )
oXbp:handleEvent( nEvent, mp1, mp2 )
ENDDO
RETURN
PROCEDURE RemindMe( oPushBtn )
LOCAL oThread := Thread():new()
IF oPushBtn <> NIL
oThread:atStart := {|| oPushBtn:disable() }
oThread:atEnd := {|| oPushBtn:enable() }
ENDIF
oThread:start( {|| _RemindMe() } )
RETURN
//////////////////////////////////////////////////////////////////////
//
// FrontEnd for the Personal Reminder
//
//////////////////////////////////////////////////////////////////////
#define ID_HOUR 1
#define ID_MINUTE 2
#define ID_TEXT 3
STATIC PROCEDURE _RemindMe
LOCAL nEvent, mp1, mp2, oXbp
LOCAL oDlg, drawingArea, oXbp1, aPos, aSize
LOCAL oHrs, oMin, oMLE
aSize := {332,253}
aPos := AppDesktop():currentSize()
aPos := { (aPos[1]-aSize[1])/2, (aPos[2]-aSize[2])/2 }
oDlg := XbpDialog():new( AppDesktop(), , aPos, aSize, , .F.)
oDlg:taskList := .F.
oDlg:maxButton := .F.
oDlg:border := XBPDLG_DLGBORDER
oDlg:title := "Your Personal Reminder"
oDlg:create()
drawingArea := oDlg:drawingArea
drawingArea:setFontCompoundName( FONT_HELV_SMALL )
oXbp1 := XbpStatic():new( drawingArea, , {4,184}, {316,40} )
oXbp1:caption := "Set time for reminder (Hour / Minute)"
oXbp1:clipSiblings := .T.
oXbp1:type := XBPSTATIC_TYPE_GROUPBOX
oXbp1:create()
oHrs := XbpSpinbutton():new( oXbp1, , {92,4}, {48,20} )
oHrs:setNumLimits( 0, 23 )
oHrs:tabStop := .T.
oHrs:clipSiblings := .T.
oHrs:create()
oHrs:setName( ID_HOUR )
oHrs:setData( Val( SubStr( Time(), 1, 2 ) ) )
oMin := XbpSpinbutton():new( oXbp1, , {148,4}, {48,20} )
oMin:setNumLimits( 0, 59 )
oMin:tabStop := .T.
oMin:clipSiblings := .T.
oMin:create()
oMin:setName( ID_MINUTE )
oMin:setData( Val( SubStr( Time(), 4, 2 ) ) + 1 )
oMle := XbpMle():new( drawingArea, , {4,36}, {316,144} )
oMle:clipSiblings := .T.
oMle:ignoreTab := .T.
oMle:tabStop := .T.
oMle:create()
oMle:setName( ID_TEXT )
oXbp := XbpPushButton():new( drawingArea, , {4,4}, {72,24} )
oXbp:caption := "Save"
oXbp:clipSiblings := .T.
oXbp:tabStop := .T.
oXbp:activate := {|| StartThread( oDlg ), ;
PostAppEvent( xbeP_Close,,, oDlg ) }
oXbp:create()
oXbp := XbpPushButton():new( drawingArea, , {248,4}, {72,24} )
oXbp:caption := "Close"
oXbp:clipSiblings := .T.
oXbp:tabStop := .T.
oXbp:activate := {|| PostAppEvent( xbeP_Close,,, oDlg ) }
oXbp:create()
oDlg:show()
SetAppFocus( oDlg )
DO WHILE nEvent <> xbeP_Close
nEvent := AppEvent( @mp1, @mp2, @oXbp )
oXbp:handleEvent( nEvent, mp1, mp2 )
ENDDO
oDlg:destroy()
RETURN
/*
* create a Reminder thread
*/
STATIC PROCEDURE StartThread( oDlg )
LOCAL oThread, cText, nHour, nMinute
cText := oDlg:childFromName( ID_TEXT ):getData()
nHour := oDlg:childFromName( ID_HOUR ):getData()
nMinute := oDlg:childFromName( ID_MINUTE ):getData()
oThread := Reminder():new( cText, nHour, nMinute )
oThread:start()
RETURN
/*
* Save pending reminders
*/
EXIT PROCEDURE SaveReminders
Reminder():save( "Remind.me" )
RETURN
/*
* Load saved reminders
*/
INIT PROCEDURE RestoreReminders
IF File( "Remind.me" )
Reminder():restore( "Remind.me" )
FErase( "Remind.me" )
ENDIF
RETURN
//////////////////////////////////////////////////////////////////////
//
// The Reminder class displays a message at a given point
// in time on the screen.
//
//////////////////////////////////////////////////////////////////////
CLASS Reminder FROM Thread
PROTECTED:
CLASS VAR aThreads
CLASS METHOD push
SYNC CLASS METHOD pop
METHOD execute, atEnd
EXPORTED:
CLASS METHOD initClass, save, restore
VAR nHour, nMinute, cText
METHOD init , start , notifyLoaded
ENDCLASS
CLASS METHOD Reminder:initClass
::aThreads := {}
RETURN self
CLASS METHOD Reminder:push( oReminder )
AAdd( ::aThreads, oReminder )
RETURN self
CLASS METHOD Reminder:pop( oReminder )
LOCAL nPos := AScan( ::aThreads, oReminder )
ARemove( ::aThreads, nPos )
RETURN self
CLASS METHOD Reminder:save( cFileName )
IF .NOT. Empty( ::aThreads )
WriteStream( cFileName, Var2Bin( ::aThreads ) )
ENDIF
RETURN self
CLASS METHOD Reminder:restore( cFileName )
LOCAL cStream
IF ReadStream( cFileName, @cStream )
Bin2Var( cStream )
ENDIF
RETURN self
METHOD Reminder:init( cText, nHour, nMinute )
::cText := cText
::nHour := nHour
::nMinute := nMinute
::thread:init()
RETURN self
METHOD Reminder:start
::push( self )
::setStartTime( 3600 * ::nHour + 60 * ::nMinute )
::thread:start()
RETURN self
METHOD Reminder:execute
MsgBox( ::cText )
RETURN self
METHOD Reminder:atEnd
::pop( self )
RETURN self
METHOD Reminder:notifyLoaded
::thread:init()
::start()
RETURN self
**********************************************************************
* Read/write streams of data from/to file
*
* NOTE: cStream must be passed by reference
**********************************************************************
STATIC FUNCTION ReadStream( cFile, cStream )
LOCAL nHandle := FOpen( cFile )
LOCAL nFSize
IF FError() <> 0
RETURN .F.
ENDIF
nFSize := FSeek( nHandle, 0, FS_END )
cStream := Space( nFSize )
FSeek( nHandle, 0, FS_SET )
FRead( nHandle, @cStream, nFSize )
FClose( nHandle )
RETURN ( FError() == 0 .AND. .NOT. Empty( cStream ) )
STATIC FUNCTION WriteStream( cFile, cStream )
LOCAL nHandle := FCreate( cFile )
IF FError() <> 0
RETURN .F.
ENDIF
FWrite( nHandle, cStream, Len(cStream) )
FClose( nHandle )
RETURN ( FError() == 0 )
Feedback
If you see anything in the documentation that is not correct, does not match your experience with the particular feature or requires further clarification, please use this form to report a documentation issue.