home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
C!T ROM 2
/
ctrom_ii_b.zip
/
ctrom_ii_b
/
PROGRAM
/
CLIPPER
/
PDRD1
/
READ.DOC
< prev
next >
Wrap
Text File
|
1992-12-01
|
39KB
|
1,128 lines
The FRANKIE ADread() Function Version 1.1
COPYRIGHT Angelito Dizon, 1992. All Rights Reserved
To compile and link the examples below, cut and paste them to
appropriate .PRG files then run either of these batch files:
CB <PrgFile> if you use BLINKER
CR <PrgFile> if you use RTLINK
Make sure that CLIPPER.EXE, BLINKER.EXE and RTLINK.EXE are
in your DOS path; READ.LIB and the Clipper libraries
are in your LIB path; and READ.CH and INKEY.CH are in
your INCLUDE path.
IT IS SUGGESTED THAT YOU RUN THE EXAMPLES _BEFORE_ READING THE
REST OF THE DOCUMENTATION.
DESCRIPTION
===========
ADread() is a mouseable and configurable replacement of the
READ command or READMODAL() function. See READ.KEY for a list
of active keys and mouse spots.
Here are some features of ADread():
1. Click any GET to jump to it.
2. Expand into memoedit() a memo GET, or any character GET
that is @S-PICTUREd, or that extends beyond the screen
boundaries.
3. Define additional hot keys and/or additional hot spots.
SYNTAX
======
ADread( <getlist>, [aConfig] ) --> <aRetval>
--------------------------------------------
<getlist> is an array of GET objects to be activated.
[aConfig] is an array of configuration attributes. If this
array is passed, the behaviour of ADread() is reconfigured
accordingly. See the CONFIGURING ADread() and THE ADread()
CONFIGURATION ATTRIBUTES sections below for a detailed
discussion of how to use [aConfig].
<aRetval> is the return value. It is an array of two elements:
1 - an array of the update status of the GETs. The number
of elements in this array is equal to the number of GETs. The
nth element is set to TRUE if the nth GET was updated,
otherwise it is FALSE.
2 - the ADread() exitcode. The exitcode is the inkey code
of the exit key, or if ADread() was exited other than via an
exit key, any of the following values which are DEFINEd in
READ.CH:
#define RX_NOCONFIRM -101
#define RX_SAVE -102
#define RX_ABORT -103
RX_NOCONFIRM is set if ADread() exited because the last GET
was completely filled, and SET CONFIRM was OFF.
RX_ABORT is set if the Read was programmatically aborted, or
when the right mouse button was clicked. See ADr_abort().
RX_SAVE is set if the Read was programmatically saved. See
ADr_save().
AUXILLIARY FUNCTIONS
====================
ADr_defaults() --> <aConfig>
----------------------------
Returns an array of default configuration attributes. This
function is typically used to reconfigure ADread(). See the
CONFIGURING ADread() and THE ADread() CONFIGURATION ATTRIBUTES
sections below.
ADr_varid() --> <cGetVarName>
-----------------------------
Returns the name of the current variable name. If it is an
array name, it returns it in array notation.
ADr_varget( [nthGet] ) --> <xGetValue>
--------------------------------------
Returns the current value of any GET in the currently active
getlist. If [nthGet] is not passed, it defaults to the current
GET.
ADr_varput( <xNewValue>, [nthGet] ) --> nil
-------------------------------------------
Updates the value of any GET in the currently active getlist.
If [nthGet] is not passed, it defaults to the current GET.
When the GET is updated this way, the display is
correspondingly updated also. Note that the type of
<xNewValue> must be in agreement with the type of the Get
variable being updated, otherwise a RUN error occurs.
ADr_mousify( <getlist> ) --> nil
--------------------------------
This is the function that mousifies the GETS. It must be
called after every @ .. GET statement. Alternately, you may
use @ ..ADGET, instead. This command is #COMMANDed in READ.CH.
If you use it, you must not call ADr_mousify() anymore.
ADr_expget( <getlist>, [aCoords], [aColor], [lLimitLength] )
--> nil
------------------------------------------------------------
This function reconfigures the memoedit() attributes of an
expanded GET. It is called after the corresponding @..ADGET of
the expandable GET. See also the EXPANDABLE GET NOTES section
below.
<getlist> is the array of GET objects
[aCoords] is an optional array of memoedit() box coordinates.
If it is not passed, it defaults to {10,10,20,69}.
[aColor] is an optional color specification string for use by
memoedit(). If it is not passed, it defaults to "GR+/W" and
"I", respectively for color and BW monitors.
[lLimitLength] is a logical value. If it is TRUE, ADread()
will limit the length of the return value of memoedit() to the
original length of the GET variable. Defaults to TRUE.
Typically, you will want to set this to FALSE for memo fields.
NOTE that ADr_expget() is called only if there is a desire to
change the default values. ADread() always expands expandable
GETS, whether or not ADr_expget() is used or not.
ADr_save() --> <lExitRead>
--------------------------
Attempts to save and exit ADread(). If there is no VALID
clause, <lExitRead> is TRUE. If there is a VALID clause,
<lExitRead> is TRUE if the entered value is valid. Otherwise,
it is FALSE. ADread() exits if <lExitRead> is TRUE.
ADr_abort() --> <TRUE>
----------------------
This function aborts ADread() and always returns a TRUE.
EXPANDABLE GET NOTES
====================
1. Not all GETs are memoedit expandable. Only those that are
@S-PICTUREd, or that extend beyond the screen may be expanded.
2. The default configuration of ADread() calls for the
pressing of [TAB] to expand the current GET. If a mouse is
active, clicking the focused GET also causes it to expand. This default
setting may be reconfigured such that the the GET automatically
expands when it is focused.
3. There is also a default location, size and color of the
memoedit box. This may also be reconfigured, either globally
for the whole ADread() by passing [aConfig], or locally for
each GET by using ADr_expget().
4. When in expanded mode, ADread() does not monitor the length
of the text being MEMOEDITed. If it exceeds the original
length of the GET, it will be truncated when it is saved,
unless you specify not to do so in ADr_expget().
5. Note that when a .DBT is APPENDed BLANK, the memo field is
initially "". Thus, if you GET it right after APPENDing BLANK,
ADread() will not treat it as an expandable GET since it is an
empty string. Update the value of the memo field first.
CONFIGURING ADread()
====================
The default behaviour of ADread() may be reconfigured via
the optional [aConfig] parameter. [aConfig] is an array of a
number of attributes that you can redefine in three easy steps:
1. Get the default configuration using ADr_defaults().
This auxilliary function returns an array whose structure
is #DEFINEd in READ.CH. Such #DEFINition is discussed
in greater detail in THE ADread() ATTRIBUTES CONFIGURATION
section below.
2. Assign new values to the elements of the default array
that correspond to the attributes you want to reconfigure.
3. Pass the array to ADread().
See also ADr_expget() for locally reconfiguring the memoedit
box location and color of a specific expandable GET.
THE ADread() CONFIGURABLE ATTRIBUTES
====================================
#define R_CARGO 1
-----------------------
This is a user-defined attribute variable that can be used for
any purpose. It can be assigned a value of any type.
#define R_INITBLOCK 2
-----------------------
This is a code block that ADread() EVALuates just before
setting the focus on the first GET. It is automatically
passed 3 parameters:
e - a numeric that identifies the ADread engine. (See THE
ADread() ENGINE section)
c - a reference to the array of configuration attributes
p - a reference to the array of peekable attributes
(See THE ADread() PEEKABLE ATTRIBUTES section)
The default code block is a null code block.
#define R_MOVEBLOCK 3
-----------------------
This is a code block that ADread() EVALuates when it changes
focus to another GET. It is automatically passed 3 parameters:
e - a numeric that identifies the ADread engine. (See THE
ADread() ENGINE section)
c - a reference to the array of configuration attributes
p - a reference to the array of peekable attributes
(See THE ADread() PEEKABLE ATTRIBUTES section)
The default code block is a null code block.
#define R_EXITBLOCK 4
-----------------------
This is a code block that ADread() EVALuates when it receives a
request to exit (either to save or abort). It is automatically
passed 3 parameters:
e - a numeric that identifies the ADread engine. (See THE
ADread() ENGINE section)
c - a reference to the array of configuration attributes
p - a reference to the array of peekable attributes
(See THE ADread() PEEKABLE ATTRIBUTES section)
It EVALuates to a logical value. If it returns a TRUE,
ADread() proceeds to exit. The default code block is a TRUE
code block.
#define R_KEYS 5
-----------------------
This is an array of the inkey codes of user-defined hot keys.
Defaults to an empty array.
#define R_KHANDLER 6
-----------------------
This is a code block that ADread() EVALuates when one of the
user-defined keys is pressed. it is automatically passed 5
parameters:
e - a numeric that identifies the ADread engine. (See THE
ADread() ENGINE section)
c - a reference to the array of configuration attributes
p - a reference to the array of peekable attributes
(See THE ADread() PEEKABLE ATTRIBUTES section)
nth - the index position of the hot key withing the array
of hot keys
nkey - the inkey code of the hot key
The default code block must return a logical value. If it
returns a TRUE, ADread() exits.
#define R_LBUTTONS 7
-----------------------
This is an array of user-defined mouse left button hot spots.
A hot spot is an array of 4 numeric values in the format {nTop,
nLeft, nBottom, nRight}. Defaults to an empty array.
#define R_LBHANDLER 8
-----------------------
This is a code block that ADread() EVALuates when one of the
user-defined left button hot spots is clicked. it is automatically
passed 6 parameters:
e - a numeric that identifies the ADread engine. (See THE
ADread() ENGINE section)
c - a reference to the array of configuration attributes
p - a reference to the array of peekable attributes
(See THE ADread() PEEKABLE ATTRIBUTES section)
nth - the index position of the hot key withing the array
of hot keys
mrow - the row position of the mouse cursor
mcol - the column position of the mouse cursor
The default code block must return a logical value. If it
returns a TRUE, ADread() exits.
#define R_RBUTTONS 9
-----------------------
This is an array of user-defined mouse right button hot spots.
A hot spot is an array of 4 numeric values in the format {nTop,
nLeft, nBottom, nRight}. Defaults to an empty array.
#define R_RBHANDLER 10
-----------------------
This is a code block that ADread() EVALuates when one of the
user-defined right button hot spots is clicked. it is automatically
passed 6 parameters:
e - a numeric that identifies the ADread engine. (See THE
ADread() ENGINE section)
c - a reference to the array of configuration attributes
p - a reference to the array of peekable attributes
(See THE ADread() PEEKABLE ATTRIBUTES section)
nth - the index position of the hot key withing the array
of hot keys
mrow - the row position of the mouse cursor
mcol - the column position of the mouse cursor
The default code block must return a logical value. If it
returns a TRUE, ADread() exits.
#define R_EXPCOORDS 11
-----------------------
This is an array of box coordinates that define the memoedit
box. Defaults to {10,10,20,69}. You can also use ADr_expget() to
specify the box coordinates and color of the memoedit box.
#define R_EXPCOLOR 12
-----------------------
This is a color specifier for use by memoedit. It defaults to
"GR+/W" and "I", respectively for color and BW monitors.
#define R_AUTOEXPAND 13
-----------------------
This is a logical value. If it is TRUE, an expandable GET
automatically expands to a memoedit when focus is set to it.
If it is FALSE, the [TAB] key has to be pressed, or the left
button clicked on it when it is in focus. Defaults to FALSE.
#define R_KEYVALIDBLOCK 14
--------------------------
This points to a code block that ADread() EVALuates before
inserting every key stroke to the Get edit buffer. The code
block must return a logical value. If it EVALuates to TRUE,
then the key is inserted, otherwise it is disregarded. It
is functionally similar to the PICTURE clause, but in a more
refined manner. It is automatically passed 4 parameters:
cKey - the character that was last pressed
nPos - the current position of the editing cursor, relative
to the starting position of the Get screen
nthGet - the index position, within GetList, of the current
Get
cEditBuffer - the current value of the Get edit buffer.
THE ADread() PEEKABLE ATTRIBUTES
================================
Aside from the configurable attributes, ADread() maintains
another group of attributes, the so-called peekable (I cannot
think of a better term). These are attributes that ADread()
constantly updates. They are made available to you via the
configurable code blocks: R_INITBLOCK, R_MOVEBLOCK,
R_EXITBLOCK, R_KHANDLER, R_LBHNADLER, and R_RBHANDLER, in case
you need them. If you are one who always look for ways of
extending the power of Clipper, I am sure you will find a use
for these values. This ADread() feature is in line with
Clipper's open-architecture design. CAUTION: These values are
intended to be "peeked" only, and not "poked". If you change
their values, the result is unpredictable.
The peekable attributes are #DEFINEd in READ.CH. as follows:
#define PKREAD_NTHGET 1
----------------------------
The index position of the current GET. (numeric)
#define PKREAD_EXITCODE 2
----------------------------
The exit code of the last attempt to exit ADread(). (numeric)
#define PKREAD_NGETS 3
----------------------------
The number of GETS in getlist. (numeric)
#define PKREAD_INSERT 4
----------------------------
The current _SET_INSERT_ setting within the context of
ADread(). This may not coincide with the actual Clipper
setting. (logical)
#define PKREAD_UPDATED 5
----------------------------
An array of logical values. The size of the array is the
number of GETS. If a GET has been updated, the corresponding
element in this array is set to FALSE.
THE ADread() ENGINE
===================
ADread() is built around an engine. You may think of an engine
as a pseudo-object, or as a handle. Every ADread() call
creates an ADread() engine which is used internally. You may
however gain access to it via the configurable code blocks:
R_INITBLOCK, R_MOVEBLOCK, R_EXITBLOCK, R_KHANDLER, R_LBHNADLER,
and R_RBHANDLER. In this version of ADread(), however, there
is nothing that you can do with it. In future versions, there
will be plenty that you can do with it. You will be able to
"send messages" to it and cause it to do something. The "open
architecture" of Clipper will be extensively exploited!
Example 1
---------
#include "read.ch"
#include "inkey.ch"
//---------
func main()
field dbfname, shared, rlocked, date, comments
local xdbfname, xshared, xrlocked, xdate, xcomments
local aScn, nT := 17, nL := 10, nB := 23, nR := 69, getlist[0], aReadRetval
local cColor := setcolor( if( iscolor(), "W+/BG, GR+/R,,, B/BG", ) )
use demo
cls
Xinstructions()
xdbfname = dbfname
xshared = shared
xrlocked = rlocked
xdate = date
xcomments = comments
aScn = ADbox( nT, nL, nB, nR )
// Note in this Get series, 'adget' is used instead of simply 'get'
@nT+1, nL+2 say "Database name " adget xdbfname picture "@!"
@nT+2, nL+2 say "Opened in shared mode?" adget xshared
@nT+3, nL+2 say "Locked record number " adget xrlocked
@nT+4, nL+2 say "Date locked " adget xdate
@nT+5, nL+2 say "Comments " adget xcomments picture "@S33"
aReadRetval = ADread( getlist )
// aReadRetval is a two-element array. Element #2 is the exit
// code of ADread(). Element #1 is an array of the update
// status of each Get
if aReadRetval[2] != K_ESC .and. aReadRetval[2] != RX_ABORT; // IF ADread() was not aborted
.and. ascan( aReadRetval[1], .T. ) > 0 // .AND. at least one of the Gets was updated
dbfname = xdbfname // THEN update the database
shared = xshared
rlocked = xrlocked
date = xdate
comments = xcomments
endif
? ""
? "Exit Code: ", aReadRetval[2]
? " ┌─────── Updated?"
? " │ ┌─ Updated Values"
? " "
? aReadRetval[1][1], dbfname
? aReadRetval[1][2], shared
? aReadRetval[1][3], rlocked
? aReadRetval[1][4], date
? aReadRetval[1][5], comments
setcolor( cColor )
return nil
//------------------
func Xinstructions()
ADbox( 0,0,16,79,,,.F. )
@0,28 say " ADread() Demonstration #1 "
@1,1 say "Check this out:"
@2,1 say " √ Left-click at any Get. That Get will immediately get focused."
@3,1 say " √ Set the focus on the 'Comments' Get, then left-click it. It will expand"
@4,1 say " to a mouseable memoedit."
@5,1 say " √ While you are in expanded mode, enter any thing. Then left-click [-]."
@6,1 say " This will save the memoedit and return to the Get. If you click the"
@7,1 say " right button, instead, the memoedit will abort. The [?] spot is reserved"
@8,1 say " for 'Help'. Note that there's cursor synchronization, as well as insert/"
@9,1 say " overwrite modes, between the Get and and the memoedit. The [TAB] key saves"
@10,1 say " the memoedit, while the [ESC] aborts it."
@11,1 say " √ You can also expand 'Comments' by pressing the [TAB] key."
@12,1 say " √ Clicking the right button will abort ADread(). It is the same as pressing"
@13,1 say " the [ESC] key."
@14,1 say " √ Move the cursor to the last position of the first Get. Press [RIGHT]; the"
@15,1 say " focus moves to the next Get. Press [LEFT]; the focus moves back."
return nil
Example 2
---------
#include "read.ch"
#include "inkey.ch"
//---------
func main()
field dbfname, shared, rlocked, date, comments
local xdbfname, xshared, xrlocked, xdate, xcomments
local aScn, nT := 17, nL := 10, nB := 23, nR := 69, getlist[0], aReadRetval
// Get a reference to the array of default configurable
// attributes, so they can be changed.
local aReadConfig := ADr_defaults()
local cColor := setcolor( if( iscolor(), "W+/BG, GR+/R,,, B/BG", ) )
use demo
cls
Xinstructions()
xdbfname = dbfname
xshared = shared
xrlocked = rlocked
xdate = date
xcomments = comments
aScn = ADbox( nT, nL, nB, nR )
@nT+1, nL+2 say "Database name " adget xdbfname picture "@!"
@nT+2, nL+2 say "Opened in shared mode?" adget xshared
@nT+3, nL+2 say "Locked record number " adget xrlocked
@nT+4, nL+2 say "Date locked " adget xdate
@nT+5, nL+2 say "Comments " adget xcomments picture "@S33"
ADr_expget( getlist, {0,0,4,50 }, "W+/B", .T. )
// causes a memoeditable Get to automatically expand to a memoedit as soon
// as it is focused.
aReadConfig[R_AUTOEXPAND] = .t.
// causes ADread() to validate every key press before inserting it to the
// Get buffer. The user-defined function, Xkeyvalid() controls what type
// of validation to do.
aReadConfig[R_KEYVALIDBLOCK] = {|cKey,nPos,nthGet,cBuffer| Xkeyvalid(cKey,nPos,nthGet,cBuffer)}
aReadRetval = ADread( getlist, aReadConfig )
if aReadRetval[2] != K_ESC .and. aReadRetval[2] != RX_ABORT; // IF ADread() was not aborted
.and. ascan( aReadRetval[1], .T. ) > 0 // .AND. at least one of the Gets was updated
dbfname = xdbfname // THEN update the database
shared = xshared
rlocked = xrlocked
date = xdate
comments = xcomments
endif
? ""
? "Exit Code: ", aReadRetval[2]
? " ┌─────── Updated?"
? " │ ┌─ Updated Values"
? " "
? aReadRetval[1][1], dbfname
? aReadRetval[1][2], shared
? aReadRetval[1][3], rlocked
? aReadRetval[1][4], date
? aReadRetval[1][5], comments
setcolor( cColor )
return nil
//----------------------------------------------
func Xkeyvalid( cKey, nPos, nthGet, cGetBuffer )
// This function will accept only October, November and December in Get #4.
// cKey is the key stroke to be validated
// nPos is the current position of the editing cursor
// nthGet is the index position of the current Get object
// cGetBuffer is the current value of the Get editing buffer
local lValid := .t.
if nthGet = 4 // this function is applicable only to Get #4
if nPos = 1
if cKey != "1" // accespts only "1" in position #1
lValid = .f.
endif
elseif nPos = 2
if !cKey $ "012" // accepts only "0", "1" or "2" in position #2
lValid = .f.
endif
endif
endif
return lValid
//------------------
func Xinstructions()
ADbox( 0,0,10,79,,,.F. )
@0,28 say " ADread() Demonstration #2 "
@1,2 say "This is the same as Demo #1, except that the location, size and color"
@2,2 say "of the expanded memoedit box is changed. Also, the expansion is automatic."
@3,2 say "You do not have to press the [TAB] key. Check these out:"
@4,2 say " √ Move the focus to 'Comments'. It will automatically expand."
@5,2 say " √ When you exit the expanded mode, you can re-expand the Get by pressing"
@6,2 say " the [TAB] key or by moving the focus away from 'Comments' and back."
@7,2 say " √ Go to 'Date locked'. You can only enter a '1' in position #1, and only"
@8,2 say " '0', '1' or '2' in position #2. This is an enhnacement of the PICTURE"
@9,2 say " extension of Get."
return nil
Example 3
---------
This example demonstrates to define hot keys and hot spots to
the ADread().
#include "read.ch"
#include "inkey.ch"
//---------
func main()
field dbfname, shared, rlocked, date, comments
local xdbfname, xshared, xrlocked, xdate, xcomments
local aScn, nT := 17, nL := 10, nB := 23, nR := 69, getlist[0], aReadRetval
local aReadConfig := ADr_defaults()
local cColor := setcolor( if( iscolor(), "W+/BG, GR+/R,,, B/BG", ) )
use demo
cls
Xinstructions()
xdbfname = dbfname
xshared = shared
xrlocked = rlocked
xdate = date
xcomments = comments
aScn = ADbox( nT, nL, nB, nR )
@nT+0, nL+2 say "[-][?]";
color if( iscolor(), "R/BG", "W+/N" )
@nT+1, nL+2 say "Database name " adget xdbfname picture "@!"
@nT+2, nL+2 say "Opened in shared mode?" adget xshared
@nT+3, nL+2 say "Locked record number " adget xrlocked
@nT+4, nL+2 say "Date locked " adget xdate
@nT+5, nL+2 say "Comments " adget xcomments picture "@S33"
// defines K_F2 as a hot key
aReadConfig[R_KEYS] = { K_F2 }
// defines a hot key handler routine
aReadConfig[R_KHANDLER] = {|e,c,p,nth,nk| Xmessage(), .F.}
// defines two left button hot spots
aReadConfig[R_LBUTTONS] = {;
{nT, nL+2, nT, nL+4 },;
{nT, nL+5, nT, nL+7 };
}
// defines a hot spot handler routine
aReadConfig[R_LBHANDLER] = {|e,c,p,nth,mr,mc| Xlbhandler(e,c,p,nth,mr,mc)}
aReadRetval = ADread( getlist, aReadConfig )
if aReadRetval[2] != K_ESC .and. aReadRetval[2] != RX_ABORT; // IF ADread() was not aborted
.and. ascan( aReadRetval[1], .T. ) > 0 // .AND. at least one of the Gets was updated
dbfname = xdbfname // THEN update the database
shared = xshared
rlocked = xrlocked
date = xdate
comments = xcomments
endif
? ""
? "Exit Code: ", aReadRetval[2]
? " ┌─────── Updated?"
? " │ ┌─ Updated Values"
? " "
? aReadRetval[1][1], dbfname
? aReadRetval[1][2], shared
? aReadRetval[1][3], rlocked
? aReadRetval[1][4], date
? aReadRetval[1][5], comments
setcolor( cColor )
return nil
//------------------------------
func Xlbhandler(e,c,p,nth,mr,mc)
local lRetval
ADm_rwait()
if nth = 1 // clicked [-]
lRetval = ADr_save()
elseif nth = 2 // clicked [?]
Xmessage()
lRetval = .F.
endif
return lRetval
//-------------
func Xmessage()
local cColor := if( iscolor(), "B/W", "W+/N" )
local nCursor := setcursor(0), nRow := row(), nCol := col()
local aScn := ADbox( 10, 9, 12, 70, cColor )
if ADr_varid() == "XDBFNAME"
@11,11 say "Enter the name of a database, without the .DBF extension" color cColor
elseif ADr_varid() == "XSHARED"
@11,11 say "Enter a TRUE if it is opened in shared mode, else a FALSE" color cColor
elseif ADr_varid() == "XRLOCKED"
@11,11 say "Enter the record number of the record to lock or check" color cColor
elseif ADr_varid() == "XDATE"
@11,11 say "Enter the date you think the record may have been locked" color cColor
elseif ADr_varid() == "XCOMMENTS"
@11,11 say "Enter anything you want. Press [TAB] to expand to memoedit" color cColor
endif
ADwait()
ADm_rwait()
ADrestscn( aScn )
setpos( nRow, nCol )
setcursor( nCursor )
return nil
//------------------
func Xinstructions()
ADbox( 0,0,5,79,,,.F. )
@0,28 say " ADread() Demonstration #3 "
@1,2 say "This is the same as Demo #1, except that two hot spots and one hot key are"
@2,2 say "defined here. Check these out:"
@3,2 say " √ Click [-]; ADread() will save and exit."
@4,2 say " √ Click [?] or press [F2]; a Get-sensitive message is displayed."
return nil
Example 4
---------
This example illustrates how to display GET-sensitive messages.
#include "read.ch"
#include "inkey.ch"
//---------
func main()
field dbfname, shared, rlocked, date, comments
local xdbfname, xshared, xrlocked, xdate, xcomments
local aScn, aScn2, nT := 14, nL := 10, nB := 20, nR := 69, getlist[0], aReadRetval
local aReadConfig := ADr_defaults()
local cColor := setcolor( if( iscolor(), "W+/BG, GR+/R,,, B/BG", ) )
use demo
cls
Xinstructions()
xdbfname = dbfname
xshared = shared
xrlocked = rlocked
xdate = date
xcomments = comments
aScn = ADbox( nT, nL, nB, nR )
@nT+1, nL+2 say "Database name " adget xdbfname picture "@!"
@nT+2, nL+2 say "Opened in shared mode?" adget xshared
@nT+3, nL+2 say "Locked record number " adget xrlocked
@nT+4, nL+2 say "Date locked " adget xdate
@nT+5, nL+2 say "Comments " adget xcomments picture "@S33"
// Instruct ADread() to draw a line at he bottom of the screen, and display
// an initial message, before setting focus on the first Get
aReadConfig[R_INITBLOCK] = {|e,c,p| aScn2 := ADsavescn( 23,0,24,79),; // saves the bottom part of the screen
scroll( 23,0,24,79,0 ),; // clears the bottom part of the screen
setpos( 23,0 ),;
dispout( repl( "─", 80 ) ),; // draws a horizontal line
Xmessage(); // displays a message
}
// Instruct ADread() to display a Get-sensitive message whenever the focus
// changes.
aReadConfig[R_MOVEBLOCK] = {|e,c,p| Xmessage()}
// Instruct ADread() to restore the bottom part of the screen at exit.
aReadConfig[R_EXITBLOCK] = {|e,c,p| ADrestscn( aScn2 ), .T.}
aReadRetval = ADread( getlist, aReadConfig )
if aReadRetval[2] != K_ESC .and. aReadRetval[2] != RX_ABORT; // IF ADread() was not aborted
.and. ascan( aReadRetval[1], .T. ) > 0 // .AND. at least one of the Gets was updated
dbfname = xdbfname // THEN update the database
shared = xshared
rlocked = xrlocked
date = xdate
comments = xcomments
endif
? ""
? "Exit Code: ", aReadRetval[2]
? " ┌─────── Updated?"
? " │ ┌─ Updated Values"
? " "
? aReadRetval[1][1], dbfname
? aReadRetval[1][2], shared
? aReadRetval[1][3], rlocked
? aReadRetval[1][4], date
? aReadRetval[1][5], comments
setcolor( cColor )
return nil
//-------------
func Xmessage()
local nRow := row(), nCol := col(), cMsg
if ADr_varid() == "XDBFNAME"
cMsg = "Enter the name of a database, without the .DBF extension"
elseif ADr_varid() == "XSHARED"
cMsg = "Enter a TRUE if it is opened in shared mode, else a FALSE"
elseif ADr_varid() == "XRLOCKED"
cMsg = "Enter the record number of the record to lock or check"
elseif ADr_varid() == "XDATE"
cMsg = "Enter the date you think the record may have been locked"
elseif ADr_varid() == "XCOMMENTS"
cMsg = "Enter anything you want. Press [TAB] to expand to memoedit"
endif
@24,1 say padr( cMsg, 78 )
setpos( nRow, nCol )
return nil
//------------------
func Xinstructions()
ADbox( 0,0,5,79,,,.F. )
@0,28 say " ADread() Demonstration #4 "
@1,2 say "This is the same as Demo #1, except ADread() is configured to display GET-"
@2,2 say "sensitive messages at the bottom of the screen. Move the cursor from GET"
@3,2 say "to GET and see the message change. The location as well as the 'looks' of"
@4,2 say "the messages are fully configurable."
return nil
Example 5
---------
This example illustrates the use of the auxilliary functions:
ADr_save(), ADr_abort(), ADr_varid(), ADr_varget(), and
ADr_varput(). Cut and paste this example to EXAMPLE.PRG.
#include "read.ch"
#include "inkey.ch"
//---------
func main()
field dbfname, shared, rlocked, date, comments
local xdbfname, xshared, xrlocked, xdate, xcomments
local aScn, aScn2, nT := 14, nL := 10, nB := 20, nR := 69, getlist[0]
local aReadConfig := ADr_defaults(), aReadRetval
local cColor := setcolor( if( iscolor(), "W+/BG, GR+/R,,, B/BG", ) )
use demo
cls
Xinstructions()
xdbfname = dbfname
xshared = shared
xrlocked = rlocked
xdate = date
xcomments = comments
aScn = ADbox( nT, nL, nB, nR )
@nT+0, nL+2 say "[Save][Abort][Forward][Backward]";
color if( iscolor(), "R/BG", "W+/N" )
@nT+1, nL+2 say "Database name " adget xdbfname picture "@!"
@nT+2, nL+2 say "Opened in shared mode?" adget xshared
@nT+3, nL+2 say "Locked record number " adget xrlocked
@nT+4, nL+2 say "Date locked " adget xdate
@nT+5, nL+2 say "Comments " adget xcomments picture "@S33"
aReadConfig[R_KEYS] = { K_ALT_S, K_ALT_A, K_ALT_F, K_ALT_B, K_F10 }
aReadConfig[R_KHANDLER] = {|e,c,p,nth,nk| Xkhandler(nk)}
aReadConfig[R_LBUTTONS] = {;
{ nT, nL+2, nT, nL+7 },; // [Save]
{ nT, nL+8, nT, nL+14 },; // [Abort]
{ nT, nL+15, nT, nL+23 },; // [Forward]
{ nT, nL+24, nT, nL+33 }; // [Backward]
}
aReadConfig[R_LBHANDLER] = {|e,c,p,nth,mr,mc| Xlbhandler(nth)}
aReadRetval = ADread( getlist, aReadConfig )
if aReadRetval[2] != K_ESC .and. aReadRetval[2] != RX_ABORT; // IF ADread() was not aborted
.and. ascan( aReadRetval[1], .T. ) > 0 // .AND. at least one of the Gets was updated
dbfname = xdbfname // THEN update the database
shared = xshared
rlocked = xrlocked
date = xdate
comments = xcomments
endif
? ""
? "Exit Code: ", aReadRetval[2]
? " ┌─────── Updated?"
? " │ ┌─ Updated Values"
? " "
? aReadRetval[1][1], dbfname
? aReadRetval[1][2], shared
? aReadRetval[1][3], rlocked
? aReadRetval[1][4], date
? aReadRetval[1][5], comments
setcolor( cColor )
return nil
//--------------------
func Xkhandler( nKey )
local lRetval := .F.
if nKey = K_ALT_F
Xforward()
elseif nKey = K_ALT_B
Xbackward()
elseif nKey = K_ALT_A
lRetval = ADr_abort()
elseif nKey = K_ALT_S
lRetval = ADr_save()
elseif nKey = K_F10 .and. file( "example.prg" )
save screen
memoedit( memoread( "example.prg" ), 0,0,24,79, .F. )
restore screen
endif
return lRetval
//------------------------
func Xlbhandler( nthSpot )
local lRetval := .F.
if nthSpot = 1
lRetval = ADr_save()
elseif nthSpot = 2
lRetval = ADr_abort()
elseif nthSpot = 3
Xforward()
inkey(.2)
elseif nthSpot = 4
Xbackward()
inkey(.2)
endif
return lRetval
//-------------
func Xforward()
local cVarid := ADr_varid()
local xCurrentValue := ADr_varget()
local xNewValue, nSpacePosition, nLen
if cVarid == "XDBFNAME"
xNewValue = substr( xCurrentValue, 2 ) + left( xCurrentValue, 1 )
elseif cVarid == "XSHARED"
xNewValue = if( xCurrentValue == "T", .F., .T. )
elseif cVarid == "XRLOCKED"
xNewValue = val( xCurrentValue ) + 1
elseif cVarid == "XDATE"
xNewValue = ctod( xCurrentValue ) + 1
elseif cVarid == "XCOMMENTS"
nLen = len( xCurrentValue )
xCurrentValue = trim( xCurrentValue )
nSpacePosition = at( " ", xCurrentValue )
xNewValue = substr( xCurrentValue, nSpacePosition + 1 ) + " " + left( xCurrentValue, nSpacePosition - 1 )
xNewValue = padr( xNewValue, nLen )
endif
ADr_varput( xNewValue )
return nil
//-------------
func Xbackward()
local cVarid := ADr_varid()
local xCurrentValue := ADr_varget()
local xNewValue, nSpacePosition, nLen
if cVarid == "XDBFNAME"
nLen = len( xCurrentValue )
xNewValue = substr( xCurrentValue, nLen ) + left( xCurrentValue, nLen - 1 )
elseif cVarid == "XSHARED"
xNewValue = if( xCurrentValue == "T", .F., .T. )
elseif cVarid == "XRLOCKED"
xNewValue = val( xCurrentValue ) - 1
elseif cVarid == "XDATE"
xNewValue = ctod( xCurrentValue ) - 1
elseif cVarid == "XCOMMENTS"
nLen = len( xCurrentValue )
xCurrentValue = trim( xCurrentValue )
nSpacePosition = rat( " ", xCurrentValue )
xNewValue = substr( xCurrentValue, nSpacePosition + 1 ) + " " + left( xCurrentValue, nSpacePosition - 1 )
xNewValue = padr( xNewValue, nLen )
endif
ADr_varput( xNewValue )
return nil
//------------------
func Xinstructions()
ADbox( 0,0,10,79,,, .F. )
@0,28 say " ADread() Demonstration #5 "
@1,2 say "This example demonstrates the auxilliary functions: ADr_varid(),"
@2,2 say "ADr_varget(), ADr_varput(), ADr_save(), and ADr_abort(). Check these out:"
@3,2 say " √ Press the [F10] key to display the source code (assuming that you named"
@4,2 say " the program as EXAMPLE.PRG.) You will find ADr_save() and ADr_abort()"
@5,2 say " called in Xkhandler() and Xlbhandler(); ADr_varid(), ADr_varget() and"
@6,2 say " ADr_varput() called in Xforward() and Xbackward()."
@7,2 say " √ Click [Forward] or [Backward] to change the value of the current GET."
@8,2 say " You may also press the [ALT_F] or [ALT_B] to achieve the same."
@9,2 say " √ Click [SAVE] or [ABORT], or press [ALT_S] or [ALT_A] to save or abort."
return nil
Example 6
---------
This example demonstrates how the [R_EXITBLOCK] attribute may
be used to validate the READ as a whole.
#include "read.ch"
#include "inkey.ch"
//---------
func main()
field dbfname, shared, rlocked, date, comments
local xdbfname, xshared, xrlocked, xdate, xcomments
local aScn, nT := 17, nL := 10, nB := 23, nR := 69, getlist[0], aReadRetval
local aReadConfig := ADr_defaults()
local cColor := setcolor( if( iscolor(), "W+/BG, GR+/R,,, B/BG", ) )
use demo
cls
Xinstructions()
xdbfname = dbfname
xshared = shared
xrlocked = rlocked
xdate = date
xcomments = comments
aScn = ADbox( nT, nL, nB, nR )
@nT+1, nL+2 say "Database name " adget xdbfname picture "@!"
@nT+2, nL+2 say "Opened in shared mode?" adget xshared
@nT+3, nL+2 say "Locked record number " adget xrlocked
@nT+4, nL+2 say "Date locked " adget xdate
@nT+5, nL+2 say "Comments " adget xcomments picture "@S33"
ADr_expget( getlist, {0,0,4,50 }, "W+/B", .T. )
// Instructs ADread() to call Xexit() before exiting. In this example,
// Xexit checks if the fields are properly filled. For instance, if
// 'Locked record number' is filled, then 'Date locked' must also be
// filled.
aReadConfig[R_EXITBLOCK] = {|e,c,p| Xexit(e,c,p)}
aReadRetval = ADread( getlist, aReadConfig )
if aReadRetval[2] != K_ESC .and. aReadRetval[2] != RX_ABORT; // IF ADread() was not aborted
.and. ascan( aReadRetval[1], .T. ) > 0 // .AND. at least one of the Gets was updated
dbfname = xdbfname // THEN update the database
shared = xshared
rlocked = xrlocked
date = xdate
comments = xcomments
endif
? ""
? "Exit Code: ", aReadRetval[2]
? " ┌─────── Updated?"
? " │ ┌─ Updated Values"
? " "
? aReadRetval[1][1], dbfname
? aReadRetval[1][2], shared
? aReadRetval[1][3], rlocked
? aReadRetval[1][4], date
? aReadRetval[1][5], comments
setcolor( cColor )
return nil
//-------------------
func Xexit( e, c, p )
local lValid := EXIT_READ
#define SHARED ADr_varget(2)
#define RECORD ADr_varget(3)
#define DATE ADr_varget(4)
if p[PKREAD_EXITCODE] != K_ESC .and. p[PKREAD_EXITCODE] != RX_ABORT // not aborted
if !SHARED
if RECORD > 0 .or. !empty( DATE )
Xmessage(1)
lValid = !EXIT_READ
endif
else
if RECORD = 0 .or. empty( DATE )
Xmessage(2)
lValid = !EXIT_READ
elseif RECORD < 0
Xmessage(3)
lValid = !EXIT_READ
endif
endif
endif
return lValid
//-------------------
func Xmessage( nMsg )
local cColor := if( iscolor(), "B/W", "W+/N" )
local nCursor := setcursor(0), nRow := row(), nCol := col()
local aScn := ADbox( 10, 9, 12, 70, cColor )
if nMsg = 1
@11,11 say "Both 'Record number' and 'Date locked' must be empty" color cColor
elseif nMsg = 2
@11,11 say "Both 'Record number' and 'Date locked' must be filled" color cColor
elseif nMsg = 3
@11,11 say "'Record number' may not be less than 0" color cColor
endif
ADywait()
ADm_rwait()
ADrestscn( aScn )
setpos( nRow, nCol )
setcursor( nCursor )
return nil
//------------------
func Xinstructions()
ADbox( 0,0,5,79,,,.F. )
@0,28 say " ADread() Demonstration #6 "
@1,2 say "This example demonstrates how to validate the READ as a whole. Oftentime,"
@2,2 say "you need to do this when the Gets are logically related. In this example,"
@3,2 say "for instance, if 'Shared' is TRUE, then if either 'Record' or 'Date' is"
@4,2 say "filled, then the other must likewise be filled."
return nil