Dec 082017
 
Aston Tate dBase IV Tech Notes for Jan 90. Useful information.
File TN9001.ZIP from The Programmer’s Corner in
Category Dbase Source Code
Aston Tate dBase IV Tech Notes for Jan 90. Useful information.
File Name File Size Zip Size Zip Type
3_D_ARRA.TXT 42201 9814 deflated
A-T_OFFE.TXT 2611 1276 deflated
ARRY3&.TXT 30611 5859 deflated
ASSIST.TXT 3579 1212 deflated
DBASIC_F.TXT 11978 3481 deflated
PUTTING_.TXT 5638 2409 deflated

Download File TN9001.ZIP Here

Contents of the 3_D_ARRA.TXT file


Arrays in 3-D, The Sequel
A Three-Dimensional Spreadsheet for Data Management

Rick Biegel

In the last issue of TechNotes/dBASE IV, a technique for simulating
three-dimensional arrays was introduced (see "Arrays in 3-D", December
'89). This technique gives the programmer the ability to expand a
two-dimensional array into another dimension by inserting a special
string of characters called a template string into each of the array's
elements. A pseudo-dimension is derived by storing and referencing
data in subsections of these template strings. This is made possible
by special markers arranged on the template strings that denote an
indexed position for each data pseudo-element.

In this article we will present a sample application that utilizes
this concept. This application allows the user to add, delete,
examine and edit records in a Student Record database. The user can
have any five (or fewer) student records on the screen simultaneously,
each in its own two-dimensional 8 x 6 grid in which data fields are
arranged as "cells". In this way, each of the five grids serves as a
spreadsheet that can be traversed and edited in the same manner as any
normal spreadsheet. The user can not only navigate from cell to cell
within a grid, but from grid to grid as well, allowing independent
editing of more than one record at a time. And the grids are arranged
on the screen such that the user sees them as residing on different
"levels", making the 3-D arrangement of data clear and obvious.

Of course, the application included in this article does not come
close to demonstrating all of the uses of a three-dimensional array.
But it does hint at some of the possiblities of this remarkable data
structure.

How It Works

Let's take a look at how a typical screen might look while using this
application.

Suppose the user has accessed the record of a student named William
Andrews, student ID number 73543. William's record is being edited on
grid-level three. The partially-obscured grid just behind it is on
grid-level two; the next one behind it is on grid-level one.

The program that produces this 3-dimensional spreadsheet is named
"Arry3.PRG". The "three-dimensional" array it uses is derived from a
two-dimensional array named Sample. Sample has a true dimension of 8
x 6, denoting eight rows and six columns, and is declared in the
program as SAMPLE[8, 6].

Each of the grids presented uses these two dimensions. The column
dimension represents classes, such as History, Trigonometry and
English. The row dimension represents individual grades within these
classes.

The third dimension represents grid levels. In order to explain how
this is done, it might be useful to review a concept that was
introduced in last month's article: the template string.

Each of the data elements in the two-dimensional array Sample is
filled with a copy of this template string:

%1--------%2 --------%3 --------%4 --------%5 --------%6

An element of data that is entered into a spreadsheet grid is placed
inside this template string next to the number that corresponds to the
level of the grid. For instance, William's grid is on level three;
therefore, any test score entered into any cell of his spreadsheet
grid will be placed in the template string right after the "%3 "
substring. Suppose that William's score on his third History exam was
89.07, with a grade of B+. The student whose grid is on level one got
a grade that begins with "68' (let's suppose it is 68.50, and yielded
a C-). The grid on level two is blank, and let us also assume that
the grids on levels four and fivenot visible right noware blank as
well. Under these circumstances, the template string at Sample[3, 1]
should look like this:

%168.50 C-%2 --------%3 89.07 B+%4 --------%5 --------%6

Another way of looking at this is by considering what happens when a
particular grid is presented on the screen. If the grid on level one
is presented, the template string sections shown on the screen will be
the ones between the index markers "%1 " and "%2 ". In William's
grid, on level three, only those sections between "%3 " and "%4 " are
shown.

Database File Structure

In order to accommodate the kind of data manipulation done in this
program, a special kind of database file structure was employed.
Since data is entered and massaged in a row x column x grid-level
format, it was deemed simplest to create a database with a separate
field to accommodate each individual cell in a spreadsheet grid. Each
grid has six classes (column dimension) and eight test grades per
class (row dimension); therefore, there are six types of class fields,
and eight fields in the database for each class type, making 6 x 8 =
48 fields in all for recording grades. In addition, there are FName,
LNname and Student_ID fields for student identification. There is
also a logical field called XOpen to indicate whether the record is
currently in use.

The name of the database file is Students.DBF. Here is a partial
representation of the structure:

Field Field Name Type Width Dec Index

1 FNAME Character 15 N
2 LNAME Character 20 N
3 STUDENT_ID Character 5 N
4 XOPEN Logical 1 N
5 HIST1 Character 8 N
6 HIST2 Character 8 N
7 HIST3 Character 8 N
8 HIST4 Character 8 N
9 HIST5 Character 8 N
10 HIST6 Character 8 N
11 HIST7 Character 8 N
12 HIST8 Character 8 N
13 TRIG1 Character 8 N
14 TRIG2 Character 8 N
... .
50 SPAN6 Character 8 N
51 SPAN7 Character 8 N
52 SPAN8 Character 8 N
** Total ** 426

For an example of how these fields work in conjunction with the 3-D
array, let's examine the "TRIG" fields. As with the "HIST" fields,
there are eight in all, each with a different integer character (1
through 8) attached to the end of its name. This is so that an index
in the program can be used to access the database fields in a manner
similar to the way array elements are accessed.

Suppose that an integer index variable named XRow was used to indicate
which row position we were on in a grid at a given moment. The
following code would be used to construct the name of the
corresponding TRIG field in which that grade entry was stored:

Stem = "TRIG"+LTRIM(STR(Xrow))

For example, if the value of xRow happens to be 4, then the
constructed name of the relevant field would be the character string
"TRIG4", which is now contained in the variable Stem. To reference
the TRIG4 field, the macro substitution technique can be used:

mHold = &Stem

The variable mHold should now contain the contents of Trig4. This
variable can now be inserted into the 3-D array using xRow as a
referencing index number, ensuring that it will be put into the proper
corresponding row position. (See PROCEDURE GetRec in Arry3.PRG.)

How to Use the Program

To run the program, simply put the program file Arry3.PRG and the
database file Students.DBF into your default directory and enter "DO
ARRY3" at the dot prompt. After compiling, the first grid will be
presented, along with the Main Instruction List at the bottom of the
screen.

The grid shown here is on level one. To exercise the "Next" option,
press the Down-Arrow key; this will cause the grid on level two to be
displayed over the level one grid. To move on to the grids on levels
three, four and five, keep pressing the Down-Arrow key. To move back
in the opposite direction, press the Up-Arrow key (the "Previous"
option).

Pressing the F2 Key (the "Load Rec" option) will present two input
windows to allow the entry of a student's last name and/or the student
number. If either or both of these are entered, there will be a
search of the database for a corresponding record. If the record is
found, it will be loaded into the grid, and that record's XOpen field
will be set at TRUE (meaning the record is now in ACTIVE status).

Pressing the F3 key (the "Put Away" option) will present options to
"Save, Continue", "Save, Clear Grid", "Abandon Grid" and "Delete
Record".

The "Save, Continue" option will do one of two things. If the grid
is empty, it will prompt the entry of the First Name, Last Name and
Student Number of a new student and create a new student record. If
the grid is already occupied with a record, the program will write the
grid's current contents to that record. In either case, the grid will
not be cleared out or reset to empty.

The "Save, Clear Grid" option will do exactly the same thing as the
"Save, Continue" option, but will cause the grid to be cleared out and
reset to empty afterwards. If a record was active in the grid, that
record will be closed by setting the XOpen field to FALSE, meaning
INACTIVE.

The "Abandon Grid" option will cause the grid to be cleared, and will
not save the current contents of the grid.

The "Delete Record" option will tag the record on the grid as deleted,
then clear the grid.

Now let's return to the Main Instruction List. If the Esc key is
pressed (the "Edit" option) the program switches into a different
mode. Until now we have been operating the program in the Grid
Navigation mode; in this mode, we were able to go from grid to grid,
loading records into them, saving records from them, and so on. Upon
pressing the Esc key, we enter the Grid Editing mode.

In the Grid Editing mode, whatever grid we are on is treated literally
as a small spreadsheet. The cells in this spreadsheet can be
traversed in any direction using the arrow and tab keys. The user is
free to input anything into any cell, provided that the entry does not
exceed the cell's capacityeight standard keyboard characters, such as
alphanumerics or punctuation marks.

To exit from the Grid Editing mode, the user has only to press the Esc
key again; this will return the program to the Grid Navigation mode.
The changes just made can then be written to the database file with
the F3 ("Put Away") option.

Conclusion

The main purpose of the program featured in this article is to
demonstrate an application for the three-dimensional array data
structure, and to present this structure in a visually pleasing way.

In our example, the 3-D array was used for appending and massaging the
data in a .DBF file interactively.

Of course, this is by no means the only way in which a 3-D array can
be utilized. Any program that manipulates data variables along three
different index-like parameters is a likely candidate; and this may
not necessarily be interactive, or even visible to the user. Some
examples might be programs that manipulate data pertaining to
3-dimensional structures like geological contour maps or multi-level
inventory shelving systems.

Whatever the use a programmer may have for arrays, he or she should be
aware that with a little extra programming, dBASE IV has the
flexibility to expand the capabilities of its array structures in
highly useful ways.

* Program ...: Arry3.PRG
* Author ....: Richard Biegel
* Date ......: October 2, 1989
* Versions ..: dBASE IV 1.0 and 1.1
* Note(s) ...: This program is a demonstration of two dimensional arrays
* that have been "expanded" into an extra pseudo-dimension.
* These arrays behave as if they are three-dimensional and can
* be used as such. In this application, the array is used as
* a device for creating, deleting or editing five or fewer
* records simultaneously.

SET BELL OFF
SET BORDER TO DOUBLE
SET DELETED ON
SET ESCAPE OFF
SET FUNCTION F2 TO " "
SET FUNCTION F3 TO " "
SET SCOREBOARD OFF
SET STATUS OFF
SET TALK OFF

DEFINE MENU FSaver && Menu for deciding what to do with the
&& current grid.

DEFINE PAD SaveKeep OF FSaver PROMPT "Save, Continue" AT 23, 3;
MESSAGE "Save the record on this grid and CONTINUE editing."
DEFINE PAD SaveRid OF FSaver PROMPT "Save, Clear Grid" AT 23,22;
MESSAGE "Save the record on this grid and ABANDON editing."
DEFINE PAD Riddance OF FSaver PROMPT "Abandon Grid" AT 23,43;
MESSAGE "Abandon the data on this grid without saving."
DEFINE PAD DeletIt OF FSaver PROMPT "Delete record" AT 23,61;
MESSAGE "Delete this record from the disk permanently."

ON SELECTION PAD SaveKeep OF FSaver DO ExitTrap WITH "SAVE" && Save and cont.
ON SELECTION PAD SaveRid OF FSaver DO ExitTrap WITH "SRID" && Save and clear.
ON SELECTION PAD Riddance OF FSaver DO ExitTrap WITH "GONE" && Clear, no save.
ON SELECTION PAD DeletIt OF FSaver DO ExitTrap WITH "BLOT" && Delete record.

mDecide = SPACE(3) && Variable that is trapped by PROCEDURE
&& ExitTrap for menu FSaver.
SELECT 1
USE STUDENTS EXCLUSIVE && Database with student information.
REPLACE ALL XOPEN WITH .F. && Start with no records "active".
GO TOP

* --- This is the "Template String" for simulating the "Third Dimension".
TmpStrng = "%1_--------%2_--------%3_--------%4_--------%5_--------%6"

DECLARE SAMPLE[8, 6] && Create array for containing Template
&& String.
DO ArryFill && Fill array with copies of Template String.
DO ArryList && Main procedure in program.


********************
* PROCEDURES *
********************

PROCEDURE ExitTrap
*--- Traps responses in execution of the menu FSaver.
PARAMETER pDecide
mDecide = pDecide
DEACTIVATE MENU
RETURN


PROCEDURE ArryFill
*--- Fills the 2-D array with copies of the Template String TmpStrng.
RowIndex = 1
ColIndex = 1
DO WHILE (RowIndex <= 8)
DO WHILE (ColIndex <= 6)
SAMPLE[RowIndex, ColIndex] = TmpStrng
ColIndex = ColIndex + 1
ENDDO
ColIndex = 1
RowIndex = RowIndex + 1
ENDDO
RETURN


PROCEDURE ArryList
CLEAR

OffX = 3 && Offset variables used in calculations
OffY = 2 && for screen placement variables.

XCoord = OffX && Actual screen coordinates for data
YCoord = OffY && placement.

XEdit = OffX && Screen placement variables for editing
YEdit = OffY && on various grid levels.

XIndex = 1 && Array Index variables for accessing the
YIndex = 1 && 2-D array of Template Strings.

xEnd = OffX + 59 && Box coordinates for framing the various
yEnd = OffY + 15 && grids as they are presented on the screen.

*--- Initialize variables to hold record numbers.
STORE 0 TO RecFind1, RecFind2, RecFind3, RecFind4, RecFind5
*--- Initialize variables to hold labels for grid boxes.
STORE "$*$" TO mIdent1, mIdent2, mIdent3, mIdent4, mIdent5

mDisplay = 1 && Set first Grid Level to 1.

DO WHILE (mDisplay <= 5) && BEGIN Grid Level control loop.
LChange = .F. && Change level of grid?
cIndex = "%"+LTRIM(STR(mDisplay))+"_" && Pseudo-element marker.
Offset = LEN(cIndex) && Length of marker.
RowIndex = 1 && Set row coordinate to 1.
ColIndex = 1 && Set column coordinate to 1.
xStart = XCoord - 2 && Calculate box Row coord.
yStart = YCoord - 1 && Calculate box Col coord.
@ yStart, xStart TO yEnd, xEnd DOUBLE && Draw Grid Box for clarity.

*--- Put course labels above each grid.
@ yStart, (xStart + 2) SAY CHR(185) + " Hist " + CHR(204)
@ yStart, (xStart + 12) SAY CHR(185) + " Trig " + CHR(204)
@ yStart, (xStart + 22) SAY CHR(185) + " Engl " + CHR(204)
@ yStart, (xStart + 32) SAY CHR(185) + " Phys " + CHR(204)
@ yStart, (xStart + 42) SAY CHR(185) + " SocS " + CHR(204)
@ yStart, (xStart + 52) SAY CHR(185) + " Span " + CHR(204)

*--- Make a string to invoke the proper variable.
PersonId = "mIdent" + LTRIM(STR(mDisplay))
IF (&PersonId <> "$*$") && Show Name and Id Number.
@ yEnd, (xEnd - (60 + LEN(&PersonId))/2) SAY &PersonId
ENDIF

* --- BEGIN--List out a single layer.
DO WHILE (RowIndex <= 8)
DO WHILE (ColIndex <= 6)
Holder = SAMPLE[RowIndex, ColIndex]
@ YCoord, XCoord SAY SUBSTR(Holder, AT(cIndex, Holder) + Offset, 8)
XCoord = XCoord + 10
ColIndex = ColIndex + 1
ENDDO
XCoord = OffX
YCoord = YCoord + 2
ColIndex = 1
RowIndex = RowIndex + 1
ENDDO
* --- END--List out a single layer.

Ans = "X"
SET CONFIRM OFF
@ 22, 0 clear to 24,79

*--- BEGIN--Input of Level Decision variable.
DO WHILE .NOT. (Ans $ " NnQqPp")
Ans = " "
@ 23, 2 SAY "Next: "+CHR(25)+SPACE(2);
+ "Previous: "+CHR(24)+SPACE(2);
+ "Load Rec: F2 Put Away: F3" + SPACE(2);
+ "Edit: " + SPACE(2);
+ "Quit: 'Q'" GET Ans
@ 24, 2 SAY "------- ----------- ------------ ------------ ";
+ "----------- ---------"
READ
ENDDO
SET CONFIRM ON
*--- END--Input of Level Decision variable.

DO CASE
CASE (READKEY() = 12) && key was pressed; edit grid.
DO EditGrid WITH YEdit, XEdit, YIndex, XIndex, mDisplay

CASE (LASTKEY() = -1) && key was pressed; load a record.
NumRec = "RecFind"+LTRIM(STR(mDisplay))
NameRec = "mIdent"+LTRIM(STR(mDisplay))
DO GetRec WITH mDisplay, &NumRec, &NameRec

CASE (LASTKEY() = -2) && key was pressed; dispose of a grid.
@ 22, 0 CLEAR TO 24,79
ACTIVATE MENU FSaver
NumRec = "RecFind"+LTRIM(STR(mDisplay))
PersonId = "mIdent"+LTRIM(STR(mDisplay))
DO CASE
CASE mDecide = "SAVE" && "Save, Continue".
IF (&NumRec > 0) && Grid is occupied with a record.
DO RecSave WITH &NumRec, mDisplay
&NumRec = RECNO()
ELSE && Grid is not currently occupied.
mSwitch = .T. && Change record number?
DO NewRecrd WITH &NumRec, mDisplay, &PersonId, mSwitch
IF mSwitch
&NumRec = RECNO()
ENDIF
ENDIF

CASE mDecide = "SRID" && "Save, Clear Grid".
IF (&NumRec > 0) && Grid is occupied with a record.
DO RecSave WITH &NumRec, mDisplay
&NumRec = RECNO()
ELSE && Grid is not currently occupied.
mSwitch = .T. && Change record number?
DO NewRecrd WITH &NumRec, mDisplay, &PersonId, mSwitch
IF mSwitch
&NumRec = RECNO()
ENDIF
ENDIF
REPLACE XOPEN WITH .F. && Tag record as not being used.
DO ClearAll WITH mDisplay && Clear out the current grid.
&NumRec = 0 && Zero denotes an empty grid.
&PersonId = "$*$" && "$*$" denotes a null Identity String.

CASE mDecide = "GONE" && "Abandon Grid".
DO ClearAll WITH mDisplay && Clear out current grid.
IF (&NumRec > 0) .AND. (&NumRec <= RECCOUNT())
GO &NumRec
ENDIF
REPLACE XOPEN WITH .F.
&NumRec = 0 && Zero denotes an empty grid.
&PersonId = "$*$" && "$*$" denotes a null Identity String.

CASE mDecide = "BLOT" .AND. &NumRec > 0 && "Delete Record".
GO &NumRec
REPLACE XOPEN WITH .F.
DELETE
DO ClearAll WITH mDisplay && Clear out current grid.
&NumRec = 0 && Zero denotes an empty grid.
&PersonId = "$*$" && "$*$" denotes a null Identity String.
ENDCASE

OTHERWISE
LChange = .T. && OK to change a level.
ENDCASE

Ans = UPPER(Ans)
DO CASE
CASE (READKEY() = 5) .OR. (Ans = "N") .OR. (((Ans = " ") ;
.AND. (READKEY() <> 4)) .AND. (READKEY() <> 6)) && "Up" a Level.
IF (mDisplay < 5) .AND. LChange
@ yStart, xStart TO yEnd, xEnd DOUBLE
mDisplay = mDisplay + 1 && Travel "up" a level
OffX = OffX + 4 && on the template.
OffY = OffY + 1
XCoord = OffX && Screen coordinates for
YCoord = OffY && data cells in grids.
XEdit = XEdit + 4 && Screen coordinates for
YEdit = YEdit + 1 && editing cells in grids.
xEnd = xEnd + 4 && Box coordinates for
yEnd = yEnd + 1 && grid clarity.
@ YCoord, (XCoord - 1);
CLEAR TO yEnd, xEnd && Draw box around grid.
ELSE && Remain the same.
XCoord = OffX
YCoord = OffY
ENDIF

CASE (Ans = "P") .OR. (READKEY() = 4) .OR. (READKEY() = 6) && "Down" a Level.
IF (mDisplay > 1) .AND. LChange
mDisplay = mDisplay - 1 && Travel "down" a level
OffX = OffX - 4 && on the template.
OffY = OffY - 1
XCoord = OffX && Screen coordinates for
YCoord = OffY && data cells in grids.
XEdit = XEdit - 4 && Screen coordinates for
YEdit = YEdit - 1 && editing cells in grids.
xEnd = xEnd - 4 && Box coordinates for
yEnd = yEnd - 1 && grid clarity.
*--- Draw box around grid.
@ YCoord, XCoord CLEAR TO (yEnd + 1), (xEnd + 4)
ELSE && Remain the same.
XCoord = OffX
YCoord = OffY
ENDIF

OTHERWISE && Exit from program.
CLEAR
bAns = " "
SET CONFIRM OFF

DO WHILE .NOT. (bAns $ "YyNn")
@ 9, 25 SAY "Get rid of deleted records?" GET bAns
READ
ENDDO

IF (UPPER(bAns) = "Y")
PACK
ENDIF
SET STATUS ON
CLEAR ALL
CLEAR
EXIT
ENDCASE
ENDDO && END Grid Level Control loop.
RETURN


PROCEDURE EditGrid
*--- Allows entering or changing data in cells.
PARAMETERS pYEdit, pXEdit, pYIndex, pXIndex, pZIndex

@ 22, 0 CLEAR TO 24,79
*--- Prompt for cell editing.
@ 23, 6 SAY "Up: " + CHR(24) + SPACE(7) + "Down: " + CHR(25) + SPACE(7);
+ "Left: " + CHR(27) + " or Shift-Tab" + SPACE(7);
+ "Right: " + CHR(26) + " or Tab"

SET BORDER TO SINGLE
@ 22, 4 TO 24,12
@ 22,16 TO 24,26
@ 22,30 TO 24,53
@ 22,57 TO 24,75
SET BORDER TO DOUBLE

SET CONFIRM ON

*---BEGIN--Grid editing loop.
DO WHILE .T.
Holder = SAMPLE[pYIndex, pXIndex] && Get Template String.
cIndex = "%"+LTRIM(STR(pZIndex))+"_" && Create two grid level
cIndex2 = "%"+LTRIM(STR(pZIndex + 1))+"_" && reference strings.
xCursor = SUBSTR(Holder, AT(cIndex, Holder) + 3, 8) && Individual cell.

IF (xCursor = "--------") && If unoccupied, put in blank.
xCursor = SPACE(8)
ENDIF
@ pYEdit, pXEdit GET xCursor && Read current cell.
READ
IF (xCursor = SPACE(8)) && Provide dash filler if blank.
xCursor = "--------"
ENDIF

* --- Replace 3-D array pseudo-element with new entry.
Holder = SUBSTR(Holder, 1, AT(cIndex, Holder) + 2) + xCursor ;
+ SUBSTR(Holder, AT(cIndex2, Holder), LEN(Holder))
SAMPLE[pYIndex, pXIndex] = Holder

* --- BEGIN--Decide which direction to send the cursor.
DO CASE
CASE (LASTKEY() = 24) .AND. (pYIndex < 8) && Down-arrow key.
@ pYEdit, pXEdit SAY xCursor
pYIndex = pYIndex + 1
pYEdit = pYEdit + 2

CASE (LASTKEY() = 5) .AND. (pYIndex > 1) && Up-arrow key.
@ pYEdit, pXEdit SAY xCursor
pYIndex = pYIndex - 1
pYEdit = pYEdit - 2

CASE ((LASTKEY() = 4) .OR. (LASTKEY() = 6) .OR.;
(LASTKEY() = 9)) .AND. (pXIndex < 6) && Tab, Right-arrow
@ pYEdit, pXEdit SAY xCursor && or Shift-Right.
pXIndex = pXIndex + 1
pXEdit = pXEdit + 10

CASE ((LASTKEY() = 19) .OR. (LASTKEY() = -400));
.AND. (pXIndex > 1) && Shift-Tab or
@ pYEdit, pXEdit SAY xCursor && Left-arrow.
pXIndex = pXIndex - 1
pXEdit = pXEdit - 10

OTHERWISE
IF READKEY() = 12 && key.
EXIT
ENDIF
ENDCASE
*--- END--Decide which direction to send the cursor.

ENDDO
*---END--Grid Editing Loop
RETURN


PROCEDURE GetRec
*--- Calls up a record from database.
PARAMETERS pLevel, pRecNum, pName

IF (pRecNum > 0) && Is this Grid occupied with a record?
XAns = " "
@ 22, 0 CLEAR TO 24,79
SET BORDER TO SINGLE
@ 22,13 TO 24,66
SET BORDER TO DOUBLE
SET CONFIRM OFF
DO WHILE .NOT. (XAns $ "SsAaCc")
@ 23,15 SAY "(S)ave or (A)bandon current record, or (C)ancel?" GET XAns
READ
ENDDO
SET CONFIRM ON
DO CASE
CASE (UPPER(XAns) = "S")
DO RecSave WITH pRecNum, pLevel
CASE (UPPER(XAns) = "C")
RETURN
ENDCASE
ENDIF

mOffX = 3 + ((pLevel - 1) * 4) && Calculate offset positions.
mOffY = 1 + pLevel

mIndex1 = "%"+LTRIM(STR(pLevel))+"_" && Create Template String index
mIndex2 = "%"+LTRIM(STR(pLevel + 1))+"_" && references for pseudo-element
&& location.
mLName = SPACE(20)
mStudent = SPACE(5)

@ 22, 0 CLEAR TO 24,79
SET BORDER TO SINGLE
@ 22, 8 TO 24,70
SET BORDER TO DOUBLE
@ 23,10 SAY "Last Name" GET mLName
@ 23,43 SAY "Student Number" GET mStudent
READ

mLName = UPPER(mLName)
mStudent = UPPER(mStudent)
mNameLen = LEN(TRIM(mLName))
mStudLen = LEN(TRIM(mStudent))

DO CASE
CASE (mNameLen = 0) .AND. (mStudLen = 0) && No Name, no Number.
RETURN
CASE (mNameLen > 0) .AND. (mStudLen = 0) && Name but no Number.
LOCATE FOR UPPER(LName) = mLName
CASE (mNameLen = 0) .AND. (mStudLen > 0) && Number, but no Name.
LOCATE FOR UPPER(Student_Id) = mStudent
CASE (mNameLen > 0) .AND. (mStudLen > 0) && Name AND Number.
LOCATE FOR UPPER(Student_Id) = mStudent .AND.;
UPPER(LName) = mLName
ENDCASE

*--- BEGIN--Load Grid with fields from current record.
IF (FOUND() .AND. .NOT. XOPEN) && Record exists and is not in use.
REPLACE XOPEN WITH .T. && Record status is now "open".
pRecNum = RECNO()
pName = CHR(185) + " " + TRIM(LNAME) + ", " + TRIM(FNAME) ;
+ " ID# " + TRIM(STUDENT_ID) + " " + CHR(204)
STORE 1 TO XROW, XCOL

*--- BEGIN--Field reading loop.
DO WHILE (XCOL <= 6)
DO CASE
CASE XCOL = 1
Stem = "HIST"
CASE XCOL = 2
Stem = "TRIG"
CASE XCOL = 3
Stem = "ENGL"
CASE XCOL = 4
Stem = "PHYS"
CASE XCOL = 5
Stem = "SOCS"
CASE XCOL = 6
Stem = "SPAN"
ENDCASE
SaveStem = Stem

DO WHILE (XROW <= 8)
*--- Concatenate the Row # to the Stem, making a field name.
Stem = Stem + LTRIM(STR(XROW))
mHold = &Stem && Macro substitution to invoke it.
mHolder2 = SAMPLE[XROW, XCOL] && Pull out template string.

*--- BEGIN--Insert field value into the pseudo-element.
IF (LEN(TRIM(mHold)) > 0)
mHolder2 = SUBSTR(mHolder2, 1, AT(mIndex1, mHolder2) + 2) + mHold;
+ SUBSTR(mHolder2, AT(mIndex2, mHolder2), LEN(mHolder2))
ELSE
mHolder2 = SUBSTR(mHolder2, 1, AT(mIndex1, mHolder2) + 2) + "--------";
+ SUBSTR(mHolder2, AT(mIndex2, mHolder2), LEN(mHolder2))
ENDIF
SAMPLE[XROW, XCOL] = mHolder2
*--- END--Insert field value into the pseudo-element.

Stem = SaveStem
XROW = XROW + 1
ENDDO
XROW = 1
XCOL = XCOL + 1
ENDDO
*--- END--Field reading loop.

ELSE
XAns = " "
IF (FOUND() .AND. XOPEN) && Record exists and is in use.
@ 22, 0 CLEAR TO 24,79
SET BORDER TO SINGLE
@ 22,21 TO 24,60
SET BORDER TO DOUBLE
@ 23,23 SAY "Wait! This record already active." GET XAns
ELSE && Record does not exist at all.
@ 22, 0 CLEAR TO 24,79
SET BORDER TO SINGLE
@ 22, 21 TO 24,57
SET BORDER TO DOUBLE
@ 23,23 SAY "Sorry! No such student record." GET XAns
ENDIF
READ
ENDIF
*--- END--Load Grid with fields from current record.

RETURN


PROCEDURE RecSave
*--- Copies values from array to database.
PARAMETER pRecNum, pLevel

GO pRecNum
mIndex1 = "%"+LTRIM(STR(pLevel))+"_" && Template String index reference.

STORE 1 TO XROW, XCOL

*--- BEGIN--Field replacement loop.
DO WHILE (XCOL <= 6)
DO CASE
CASE XCOL = 1
Stem = "HIST"
CASE XCOL = 2
Stem = "TRIG"
CASE XCOL = 3
Stem = "ENGL"
CASE XCOL = 4
Stem = "PHYS"
CASE XCOL = 5
Stem = "SOCS"
CASE XCOL = 6
Stem = "SPAN"
ENDCASE
SaveStem = Stem

*--- BEGIN--Replace fields in current column with pseudo-element.
DO WHILE (XROW <= 8)
Stem = Stem+LTRIM(STR(XROW))
mHolder2 = SAMPLE[XROW, XCOL] && Pull out Template String.
mHold = SUBSTR(mHolder2, AT(mIndex1, mHolder2) + 3, 8)
IF (LEN(TRIM(mHold)) > 0) .AND. (mHold <> "--------")
REPLACE &Stem WITH mHold
ENDIF
SAMPLE[XROW, XCOL] = mHolder2
Stem = SaveStem
XROW = XROW + 1
ENDDO
*--- END--Replace fields in current column with pseudo-element.

XROW = 1
XCOL = XCOL + 1
ENDDO
*--- END--Field replacement loop.

RETURN


PROCEDURE ClearAll
*--- Clears out the current Grid.
PARAMETER pLevel

mIndex1 = "%"+LTRIM(STR(pLevel))+"_" && Creates Template String index
mIndex2 = "%"+LTRIM(STR(pLevel + 1))+"_" && references for pseudo-element
&& location.

*--- BEGIN--Blank out the Grid Level.
STORE 1 TO XROW, XCOL
DO WHILE (XROW <= 8)
DO WHILE (XCOL <= 6)
mHolder2 = SAMPLE[XROW, XCOL]
mHolder2 = SUBSTR(mHolder2, 1, AT(mIndex1, mHolder2) + 2);
+ "--------";
+ SUBSTR(mHolder2, AT(mIndex2, mHolder2), LEN(mHolder2))
SAMPLE[XROW, XCOL] = mHolder2
XCOL = XCOL + 1
ENDDO
XCOL = 1
XROW = XROW + 1
ENDDO
*--- END--Blank out the Grid Level.

RETURN


PROCEDURE NewRecrd
*--- Creates a brand new record.
PARAMETER pNumRec, pDisplay, pLabel, pSwitch

xFName = SPACE(15)
xLName = SPACE(20)
xStudent_ID = SPACE(5)
@ 22, 0 CLEAR TO 24,79
@ 23, 1 SAY "First Name" GET xFName
@ 23,30 SAY "Last Name" GET xLName
@ 23,63 SAY "Student Id" GET xStudent_Id
@ 24,15 SAY "Enter First Name, Last Name ";
+ "and Student Id Number."
READ
IF (READKEY() = 12) && If user pressed , forget it and
pSwitch = .F. && return without changes.
RETURN
ENDIF

@ 24, 0 CLEAR TO 24,79
zAns = " "
SET CONFIRM OFF
DO WHILE .NOT. (zAns $ "CcAa")
@ 24,24 SAY "(C)reate new record, (A)bandon" GET zAns
READ
ENDDO
SET CONFIRM ON

*--- BEGIN--Create new record.
IF (UPPER(zAns) = "C")
APPEND BLANK
REPLACE XOPEN WITH .T. && The new record is currently open.
REPLACE FName WITH xFName
REPLACE LName WITH xLName
REPLACE Student_Id WITH xStudent_Id
xId = "pNumRec"+LTRIM(STR(pDisplay))
*--- Create ID label for grid bottom.
pLabel = CHR(185) + " " + TRIM(LNAME) + ", " + TRIM(FNAME);
+ " ID# " + TRIM(STUDENT_ID) + " "+CHR(204)
&xId = RECNO()
DO RecSave WITH &xId, pDisplay
ELSE
pSwitch = .F.
ENDIF
*--- END--Create new record.

RETURN

* EoF: Arry3.PRG




 December 8, 2017  Add comments

Leave a Reply