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 class where 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 functional form of a command is easily obtained by compiling a PRG file using the /p switch and copy/paste the result from the PPO file into the PRG file.

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.

DbEval() is faster than a DO WHILE .NOT. Eof() loop.

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.

The standard deviation indicates how much single values deviate from the average of all values. A detailed description of the standard deviation goes beyond the scope of this discussion. It can be found in any good statistics book.

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 B stands for any number of threads that can be started from Thread A.

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 mp1 of 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 to IncrementelSearch() by the :keyboard code 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 nRecno passed 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 object we 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 :atStart is 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, oXbp is 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 object if 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.