1 Dialog Boxes and Buttons by Larry Quaglia

Dialogue Boxes and Buttons by Larry Quaglia

How to provide a standard set of dialogue boxes and buttons for all of your
applications.

One of the primary reasons for the popularity of Microsoft's Windows product
is the standard user interface it provides for applications. In this respect,
Windows expands on many of the concepts that were popularized on the Macintosh
computer. In either of these environments, one application looks like another
in regards to its user interface.

In Windows, a tug on the FILE menu will almost always give you OPEN, SAVE,
SAVE AS, and EXIT options. One dialog box looks like another. Nearly every
application uses the standard Windows File Selector Box. The benefit of this
standard interface is that once a person learns the ins and outs of one
application, the learning curve for each successive application is less
steep. The user can then concentrate on the important parts of utilizing a
particular program and forget about learning every little idiosyncrasy of the
interface.

dBASE IV has already gone a long way toward providing many of these common
interface guidelines to the developer. One can choose to hard code dBASE III
PLUS style menus if one chooses, but more often than not, the dBASE IV
programmer is going to make use of the bar menus and pop-up menus that are
made available through the dBASE command language. For those items which
dBASE IV does not have a direct command, we can often create something very
similar using a specialized procedure or User-Defined Function (UDF). In this
article, I have outlined a UDF that activates a Windows-style dialog box. For
those who aren't familiar with that term, a dialog box is a pop-up box that
displays some message and provides the user with options for responding. In
Windows, the user responds by selecting a push-button with the mouse or
keyboard.

This UDF provides for the same functionality within dBASE IV. Using dBASE IV
windows and bar menus along with some simple shadowing routines, it proves
quite easy to simulate the Windows dialog box.

To provide true flexibility, you will be required to pass this function,
called DIALOG(), some parameters. The syntax for calling the UDF is as
follows:

memvar = DIALOG(msg, but_type, bor_sty, def_but, shad, f_col, b_col)

wherein the names stand for the following:

msg A character string or memory variable that represents the text you
want displayed in the dialog box.
but_type A numeric expression that indicates which of the predefined button
styles and text you wish to use.
bor_sty A character string. There are only three acceptable values:
"" (the null string) single line border
"double" double line border
"panel" thick border
def_but A numeric expression that defines the default response button in the
dialog box (such as the number 2 would make the second button the
default response). The default response can be selected by just
hitting the ENTER key when the dialog box is displayed.
shad Logical expression (.T. or .F.) that designates whether you want the
dialog box and its push buttons to display shadows for a "3-D" look.
f_col A character expression representing the foreground color. Must be a
valid dBASE color code.
b_col A character expression representing the background color. Must be a
valid dBASE color code.

Most of these parameters are self-explanatory. For the "button type"
parameter, you can pass any value between 0 and 5, thus giving you 6 different
button styles. You could add more if you so desire, but these six are the
most common.

This function will return the text of the button selected or the word "ERROR"
if you passed an illegal value. In addition, the function will sense the
current video mode and always center the dialog box on the screen. You can
use the Tab key to move from button to button. In addition, pressing the Alt
key simultaneously with the first letter of any button will select that
button. You choose a button by pressing the Enter key. The only real
limitation of this UDF is that the message that is passed to the dialog box
can be no longer than 78 characters. The reason for that is obvious (the
maximum screen width is 80). If you're feeling adventurous, the Dialog()
function could be modified to accept longer messages, breaking them down and
putting them on multiple lines.

You will find that Dialog() will be useful in your own programs in addition to
calling it from screen forms using the ACCEPT VALUE WHEN option of the screen
form generator.Note

Because of anomaly in dBASE IV, you cannot call the DIALOG() function using
the PERMIT EDIT IF option in a screen form or the WHEN clause of an @.SAY
command.

FUNCTION Dialog
PARAMETERS msg, but_type, border, but_def, shad_box, f_col, b_col
********************************************************************
* msg = Message that displays within the dialog Box (char)
* but_type = Expression that controls the buttons displayed in the box (num)
* border = Border style (char)
* but_def = Defines the default button when the box is displayed (num)
* shad_box = .T. - Use Shadow Boxes .F. - Don't Use Shadows (logical)
* f_col = Foreground color. Must be one of the valid color codes
* (W,N,R,G,B,RG,RB,GB, and all the high intensity (+) versions
* of these colors. (char)
* b_col = Background color must be one of the valid color codes
* (W,N,R,G,B,RG,RB,GB) (char)
********************************************************************

* NOTE:
* You should have a error trapping routine in your main calling program that traps the ERROR()
* function for error 94: WRONG NUMBER OF PARAMETERS.

SAVE SCREEN TO Backscreen && Save bacground screen for later restore

* Determine length of message passed in order to create a large enough box
msg_len = LEN(TRIM(LTRIM(msg))) +1
* Check for too many or incorrect parameters.

DO CASE
CASE msg_len > 78
RETURN "ERROR"

CASE .NOT. (border = "DOUBLE" .OR. border = "PANEL" .OR. "" = border)
RETURN "ERROR"

CASE .NOT. UPPER(f_col) $ "WNRGBRBW+N+R+G+B+RG+RB+GB+"
RETURN "ERROR"

CASE .NOT. UPPER(b_col) $ "WNRGBRB"
RETURN "ERROR"

ENDCASE

* Save current color information and set color to user-defined.
new color = TRIM(UPPER(f_col)) + "/" + TRIM(UPPER(b_col))


* To use the Tab key to move from button to button.
ON KEY LABEL Tab KEYBOARD CHR(4)

* Establish three as the maximum number of buttons on a dialog box.
DECLARE button[3]
button[1] = ""
button[2] = ""
button[3] = ""

* Establish screen height to properly center dialog box
num line = IIF(RIGHT(SET("DISP"), 2) = "43", 43, 24)

* Determine the length of passed "message" parameter. If it is long enough,
* make the dialog box just a little bigger. If it is very short, make the
* dialog box big enough to accommodate three buttons.

y = IIF(INT(msg_len) > 30, INT(msg_len / 2) + 2, 24)
box len = 2 * y

* Set up window for dialog box and determine if shadow parameter
* is set. If it is set, call shadowing routine.

DEFINE WINDOW Dial_box FROM INT(num line / 2) - 5, 40 - Y TO ;
INT(num line / 2) + 4, 40 + Y &border
IF shad_box
DO Shadow WITH INT(num line / 2) - 5, 40 - Y, INT(num_line / 2) + 4, 40 + Y, .T.
ENDIF
ACTIVATE WINDOW Dial_box
SET COLOR OF NORMAL TO &new_color
SET COLOR OF MESSAGES TO &new_color
CLEAR

* Determine the type of buttons requested and set appropriate parameters.
* These are representative of some of the ones commonly used in Windows
* applications. They could easily be modified to suit your own needs.

DO CASE
CASE but_type = 0
num_but = 1
button[1] = " OK "

CASE but_type = 1
num_but = 2
button[1] =" OK "
button[2]= " CANCEL "

CASE but type = 2
num_but = 3
button[1] = " ABORT "
button[2] = " RETRY "
button[3] = " IGNORE "

CASE but_type = 3
num_but = 3
button[1] = " YES "
button[2] = " NO "
button[3] = " CANCEL "

CASE but_type = 4
num_but = 2
button[1] = " YES "
button[2] = " NO "

CASE but_type = 5
num_but = 2
button[1] = " RETRY "
button[2] = " CANCEL "

ENDCASE

* Get dialog box length to create a bar menu of appropriate size.
* Define the bar menu in a do loop. Deactivate the menu upon selection of
* one of the buttons.

cnt = 1
basex = box_len/(num_but + 1)
DEFINE MENU dial_sel
DO WHILE cnt <= num_but
style = "DOUBLE"
pad_name = "PAD " + STR(cnt, 1)
y_col = (cnt * basex) - (INT(LEN(button[cnt]) / 2))
DEFINE PAD &pad_name OF dial_sel PROMPT button[cnt] AT 4, y_col

* If shadow boxes are set, make sure the buttons appear with shadows as well.
IF shad_box
DO SHADOW WITH 3, y_col - 2, 5, y_col + (LEN(button[cnt])) - 1, .T.
ENDIF
@ 3, y_col - 1 TO 5, y_col + (LEN(button[cnt]))
ON SELECTION PAD &pad_name OF dial_sel DEACTIVATE MENU
cnt = cnt +1
ENDDO

* Determine correct location to place the message (i.e., centered in the box).
msg_loc = INT(box_len / 2) - INT(msg_len / 2)
@ 1, msg_loc SAY msg
cnt = 1

* Move the cursor to the default button as passed by the user.
DO WHILE cnt < but_def
KEYBOARD CHR(4)
cnt = cnt +1
ENDDO

* Activate the dialog box and return the button name
ACTIVATE MENU Dial_sel
value = TRIM(LTRIM(PROMPT()))

* Deactivate dialog box, restore screen and environment, and get rid of
* shadow. Here we return the text located on the button. We could easily
* return the number of the button as well.
DEACTIVATE WINDOW Dial box
IF shad box
DO Shadow WITH INT(num_line / 2) - 5, 40 - y, INT(num_line / 2) + 5, 40 + y, .F.
ENDIF
RESTORE SCREEN FROM Backscreen
ON KEY LABEL TAB
RETURN value


PROCEDURE Shadow
PARAMETER x1, y1, x2, y2, OnOff

* If shadowing is on, use the black shadow, otherwise clear box to normal
* screen colors

IF onoff = .F.
normal = LEFT(SET("ATTRIBUTES"), AT(",", SET("ATTRIBUTES")) - 1)
ELSE
normal = "n+/n"
ENDIF
lnx = x2 + 1
lny = y2 + 2
lndx = 1
lndy = (y2-y1) / (x2-x1)

* Draw Box using @...FILL and appropriate color.
DO WHILE lnx <> x1 .OR. lny <> y1+2
@ lnx, lny FILL TO x2 + 1, y2 + 2 COLOR &normal
lnx = IIF(lnx <> x1, lnx - lndx, lnx)
lny = IIF(lny <> y1 + 2, lny - lndy, lny)
lny = IIF(lny < y1 + 2, y1 + 2, lny)
ENDDO
RETURN


2 Dialog.PRG

FUNCTION Dialog
PARAMETERS msg, but_type, border, but_def, shad_box, f_col, b_col
********************************************************************
* msg = Message that displays within the dialog Box (char)
* but_type = Expression that controls the buttons displayed in the box (num)
* border = Border style (char)
* but_def = Defines the default button when the box is displayed (num)
* shad_box = .T. - Use Shadow Boxes .F. - Don't Use Shadows (logical)
* f_col = Foreground color. Must be one of the valid color codes
* (W,N,R,G,B,RG,RB,GB, and all the high intensity (+) versions
* of these colors. (char)
* b_col = Background color must be one of the valid color codes
* (W,N,R,G,B,RG,RB,GB) (char)
********************************************************************

* NOTE:
* You should have a error trapping routine in your main calling program that traps the ERROR()
* function for error 94: WRONG NUMBER OF PARAMETERS.

SAVE SCREEN TO Backscreen && Save bacground screen for later restore

* Determine length of message passed in order to create a large enough box
msg_len = LEN(TRIM(LTRIM(msg))) +1
* Check for too many or incorrect parameters.

DO CASE
CASE msg_len > 78
RETURN "ERROR"

CASE .NOT. (border = "DOUBLE" .OR. border = "PANEL" .OR. "" = border)
RETURN "ERROR"

CASE .NOT. UPPER(f_col) $ "WNRGBRBW+N+R+G+B+RG+RB+GB+"
RETURN "ERROR"

CASE .NOT. UPPER(b_col) $ "WNRGBRB"
RETURN "ERROR"

ENDCASE

* Save current color information and set color to user-defined.
new color = TRIM(UPPER(f_col)) + "/" + TRIM(UPPER(b_col))


* To use the Tab key to move from button to button.
ON KEY LABEL Tab KEYBOARD CHR(4)

* Establish three as the maximum number of buttons on a dialog box.
DECLARE button[3]
button[1] = ""
button[2] = ""
button[3] = ""

* Establish screen height to properly center dialog box
num line = IIF(RIGHT(SET("DISP"), 2) = "43", 43, 24)

* Determine the length of passed "message" parameter. If it is long enough,
* make the dialog box just a little bigger. If it is very short, make the
* dialog box big enough to accommodate three buttons.

y = IIF(INT(msg_len) > 30, INT(msg_len / 2) + 2, 24)
box len = 2 * y

* Set up window for dialog box and determine if shadow parameter
* is set. If it is set, call shadowing routine.

DEFINE WINDOW Dial_box FROM INT(num line / 2) - 5, 40 - Y TO ;
INT(num line / 2) + 4, 40 + Y &border
IF shad_box
DO Shadow WITH INT(num line / 2) - 5, 40 - Y, INT(num_line / 2) + 4, 40 + Y, .T.
ENDIF
ACTIVATE WINDOW Dial_box
SET COLOR OF NORMAL TO &new_color
SET COLOR OF MESSAGES TO &new_color
CLEAR

* Determine the type of buttons requested and set appropriate parameters.
* These are representative of some of the ones commonly used in Windows
* applications. They could easily be modified to suit your own needs.

DO CASE
CASE but_type = 0
num_but = 1
button[1] = " OK "

CASE but_type = 1
num_but = 2
button[1] =" OK "
button[2]= " CANCEL "

CASE but type = 2
num_but = 3
button[1] = " ABORT "
button[2] = " RETRY "
button[3] = " IGNORE "

CASE but_type = 3
num_but = 3
button[1] = " YES "
button[2] = " NO "
button[3] = " CANCEL "

CASE but_type = 4
num_but = 2
button[1] = " YES "
button[2] = " NO "

CASE but_type = 5
num_but = 2
button[1] = " RETRY "
button[2] = " CANCEL "

ENDCASE

* Get dialog box length to create a bar menu of appropriate size.
* Define the bar menu in a do loop. Deactivate the menu upon selection of
* one of the buttons.

cnt = 1
basex = box_len/(num_but + 1)
DEFINE MENU dial_sel
DO WHILE cnt <= num_but
style = "DOUBLE"
pad_name = "PAD " + STR(cnt, 1)
y_col = (cnt * basex) - (INT(LEN(button[cnt]) / 2))
DEFINE PAD &pad_name OF dial_sel PROMPT button[cnt] AT 4, y_col

* If shadow boxes are set, make sure the buttons appear with shadows as well.
IF shad_box
DO SHADOW WITH 3, y_col - 2, 5, y_col + (LEN(button[cnt])) - 1, .T.
ENDIF
@ 3, y_col - 1 TO 5, y_col + (LEN(button[cnt]))
ON SELECTION PAD &pad_name OF dial_sel DEACTIVATE MENU
cnt = cnt +1
ENDDO

* Determine correct location to place the message (i.e., centered in the box).
msg_loc = INT(box_len / 2) - INT(msg_len / 2)
@ 1, msg_loc SAY msg
cnt = 1

* Move the cursor to the default button as passed by the user.
DO WHILE cnt < but_def
KEYBOARD CHR(4)
cnt = cnt +1
ENDDO

* Activate the dialog box and return the button name
ACTIVATE MENU Dial_sel
value = TRIM(LTRIM(PROMPT()))

* Deactivate dialog box, restore screen and environment, and get rid of
* shadow. Here we return the text located on the button. We could easily
* return the number of the button as well.
DEACTIVATE WINDOW Dial box
IF shad box
DO Shadow WITH INT(num_line / 2) - 5, 40 - y, INT(num_line / 2) + 5, 40 + y, .F.
ENDIF
RESTORE SCREEN FROM Backscreen
ON KEY LABEL TAB
RETURN value


PROCEDURE Shadow
PARAMETER x1, y1, x2, y2, OnOff

* If shadowing is on, use the black shadow, otherwise clear box to normal
* screen colors

IF onoff = .F.
normal = LEFT(SET("ATTRIBUTES"), AT(",", SET("ATTRIBUTES")) - 1)
ELSE
normal = "n+/n"
ENDIF
lnx = x2 + 1
lny = y2 + 2
lndx = 1
lndy = (y2-y1) / (x2-x1)

* Draw Box using @...FILL and appropriate color.
DO WHILE lnx <> x1 .OR. lny <> y1+2
@ lnx, lny FILL TO x2 + 1, y2 + 2 COLOR &normal
lnx = IIF(lnx <> x1, lnx - lndx, lnx)
lny = IIF(lny <> y1 + 2, lny - lndy, lny)
lny = IIF(lny < y1 + 2, y1 + 2, lny)
ENDDO
RETURN


3 Dressing Up the Data by Eric Schlueter

Dressing Up the Data

Erik Schlueter

Have you found yourself in a corner after having placed too much information
in one field and found you needed to break it out into separate fields?

We are often faced with the task of converting existing data to a different
case or to split data into several fields. Take, for example, a poorly
designed database consisting of three fields for all the data used in mailing
labels. The beginning file structure is:

Field Field Name Type Width Dec Index
1 LINE1 Character 35 N
2 LINE2 Character 40 N
3 LINE3 Character 40 N

The data for this file called FIRST.DBF is as follows:

Record# LINE1 LINE2 LINE3
1 john smith 123 s. main st. torrance, ca 90502
2 AMY SMITH 321 OAK DRIVE LONG BEACH, CA 90550
3 William Jones 20101 Hamilton Avenue Gardena, Ca. 90248-0100

There were also no case rules applied to data entry, so some records are all
upper-case, some all lower and some leading caps. The objective is to convert
the database data to all leading caps with the following field structure:

Field Field Name Type Width Dec Index
1 LName Character 18 N
2 FName Character 12 N
3 Address Character 35 N
4 City Character 18 N
5 State Character 2 N
6 Zip Character 10 N

It is always a good practice to work with copies of the data rather than the
original database. Our first steps will be to create a Second database by
copying the structure of First to Second, and then modifying the structure of
Second to include the additional fields shown immediately above (ultimately we
will create a third database with only those six fields). When modifying the
structure, you can either insert the new fields wherever you want them or
place them at the end of the structure list. Then append the records from the
FIRST database. The commands we issue at the dot prompt are as follows:

.USE First
.COPY STRUCTURE TO Second
.USE Second
.MODIFY STRUCTURE
* Add FName, LName, Address, City, State, Zip
.APPEND FROM First

The next steps involve putting the first name data into the FName field and
the last name data into the LName field. The source field for this data is
Line1. To accomplish this we will use the REPLACE command in conjunction with
the SUBSTR() and AT() functions. The simplest way to move the data from Line1
to the FName and LName fields would be to:

REPLACE ALL LName WITH LINE1

and then delete out the first name data from the LName field. This would be
tedious if you had many records and you would have to perform a similar
operation on the first name field. A more elegant solution is to use
functions to specify the exact characters you want copied into the new
fields. First, let's look at the whole command:

.REPLACE ALL LName WITH SUBSTR(Line1, AT(" ", Line1) + 1)

The syntax for the functions used in our case is:

SUBSTR(, ,
[])

AT(,)

The data looks like this:

Record# Line1

1 john smith

By studying the REPLACE command with the correct syntax we can see that the
field we are pulling from is Line1. The starting position might vary because
first names aren't all the same length. But, we know that in our database,
the last name follows the first occurrence of a space in the Line1 field. So
we use this information to locate the character position where we want to
start copying.

The SUBSTR() function requires a start position so we can use the AT()
function to return that number. Our starting position is on the character
immediately following the space. The AT() function will return the position
of the space and all we need do is add 1 to that number.

The third parameter (optional) is the "number of characters." If left blank,
dBASE IV will assume that we want the rest of the characters in the field.
The REPLACE command takes whatever results from the expression following the
"WITH" and puts it in the field specified.

The command line to fill the first name field with the information we want is
very similar to the one just completed:

.REPLACE ALL FName WITH SUBSTR(Line1, 1, AT(" ",Line1)

The major difference here is we know we want to start at character position
one, but we can't say for sure what the number of characters will be since
first name lengths will vary. We do know that the first name is followed by a
space. If we count from the first character position to the space, that number
always equals the character position number returned by the AT() function
hunting for the first space. This sounds like it should be to obvious to
mention, but if the starting character is not the first, you must subtract the
starting position from the character position number returned by the AT()
function to give you the "number of characters" value you need for the third
parameter of the SUBSTR() function.

At this point you might want to check your progress by entering the following
at the dot prompt:

.LIST LName, FName, Line1

Our next challenge is to parse (that's a tech-ese term for breaking up into
smaller parts) Line3 which consists of city followed by a comma, the two
letter abbreviation for state and then a zip code which might be either the 5
number zip or zip plus 4. The contents of the Line3 field for record 1 is
shown below:

Record# LINE3
1 torrance, ca 90502

Doing the replace command for the city and state fields uses almost exactly
the same syntax we used for the first name and last name fields. These
command lines are shown below:

.REPLACE ALL City WITH SUBSTR(Line3, 1, AT(",", Line3) - 1)
.REPLACE ALL State WITH SUBSTR(Line3, AT(",", Line3) + 2, 2)

In doing the replace for the City field we cannot use the space as we did
before because cities can have more than one word in their name (such as Long
Beach or Cardiff by the Sea). Instead we locate using the comma because we
know that the first comma marks the end of the city name. We subtract one
from this location number because we do not want to put the comma into the
City field. The REPLACE for the State field uses the comma as the locator
again, but this time we know that the state field begins two characters to the
right of the comma, so we locate the comma and add two. The State field is
two characters wide, so the number of characters for the third field will
always be two.

The next problem is zip code and how to locate its position within LINE3. It
could be done with a short program, but we would like to keep this part
confined to the dot prompt commands. The problem is we can't be sure that the
zip code begins at a predictable number of columns to the right of that comma
we used to exctract the City and State fields. In one of our data fields we
notice that a period follows the State field. That period would throw the zip
code data one position to the right of where the zip code would start for the
other data. One way to deal with this is to eliminate the city data from the
Line3 field. Shown below are the command line and the syntax for the new
functions used:

.REPLACE ALL Line3 WITH STUFF(Line3, 1, LEN(TRIM(City)) + 2, "")

STUFF(field to be stuffed, start position, number of characters, text to be
stuffed into the field)

LEN()

TRIM()

Ordinarily, the STUFF() function is used to put text into a given position
within a field, but if the "text to be stuffed into the field" is a null (""),
then the STUFF() function will remove number of characters from field to be
stuffed starting at start position. We know the field to be stuffed is the
Line3 field. We know the start position is 1. So now all we need to know is
how many characters we need to remove.

For each record, the City field has already been filled in. If we measure the
length of the City field, it would tell us how many characters long the city
name is for that individual record. The LEN() function returns the length of
a field as a numeric value. Perfect (almost). The LEN() function returns the
length of the data in the field plus all the trailing blanks. To eliminate
the trailing blanks, we use the TRIM() function. The expression
"LEN(TRIM(City))" will give us the number of characters in the City field for
each record. We also want to get rid of the comma and the space following the
comma from the Line3 field. This is done by adding 2 to the LEN(TRIM())
expression. After performing this command line, take a listing of the Line3
field and see for yourself that the city data has been removed from the
field.

We are now ready to copy the zip code information into the Zip field. That
command line is as follows:

.REPLACE ALL Zip WITH SUBSTR(Line3, AT(" ", Line3) + 1)

Note that we are now able to use the space as a locator in the AT() function
expression. This finishes everything we need to do with Line3. We can now
turn our attention to Line2 where we could quite easily just issue the
command:

REPLACE ALL Address WITH Line2

but we also need to convert the entire Address field to lower case so that a
later operation will be able to work with the data more easily. The command
line we want to use at this time is:

REPLACE ALL Address WITH LOWER(Line2)

The syntax for this function is:

LOWER()

The LOWER() function converts all alphabetical characters to lower case. This
is in preparation for converting the data to leading caps.

At this point, all the data has been parsed out to their respective fields
from fields Line1, Line2 and Line3. The next task is to convert the data to
initial caps. The following command lines show how to do this for the FName
and LName:

.REPLACE ALL FName WITH UPPER(SUBSTR(FName, 1, 1) + LOWER(SUBSTR(FName, 2)
.REPLACE ALL LName WITH UPPER(SUBSTR(LName, 1, 1) + LOWER(SUBSTR(LName, 2)

In the above command lines, we are taking the very first character in the
field and converting it to uppercase in the first part of the WITH expression,
and then taking the rest of the field and converting it to lowercase in the
second part of the WITH expression. The plus sign concatenates the two
parts. Note that dBASE IV has no difficulty taking data from a field,
manipulating it and then putting it back into the same field, all in one step.

The next field we want to convert is the State field. It is customary to have
two letter state abbreviations be in all caps. To accomplish this the command
line would be:

.REPLACE ALL State WITH UPPER(State)

The last fields to convert to leading caps are the Address and City fields.
In both of these fields, there exists the possibility of having several words
that require leading caps. In order to deal with all the possibilities we
must write a small program that walks through the field and finds the spaces.
It then converts the alphabetical characters following the space to
uppercase.

* LeadCaps.PRG for the Address field
GOTO TOP
DO WHILE .NOT. EOF()
REPLACE Address WITH UPPER(SUBSTR(Address, 1, 1)) + LOWER(SUBSTR(Address, 2, 34))
x = 1
DO WHILE x < 34
IF SUBSTR(Address, x, 1) = CHR(32)
REPLACE Address WITH;
STUFF(Address, x + 1, 1, UPPER(SUBSTR(Address, x+1, 1)))
ENDIF
x = x + 1
ENDDO
SKIP
ENDDO
* EOF: LeadCaps.PRG

The same program with minor modifications can be used to convert the City
field to leading caps. Simply substitute the word City for the word Address.
And substitute the number 17 for the number 34. The field width of Address is
35. The number we want to use is n-1 or 34. So the width of the City field is
18, the number 17 should be used for the loop control.

The final act is to copy the six fields we want to keep to the Third
database. We could just "COPY TO Third" and then modify the structure and
delete the fields Line1, Line2 and Line3, but there is a more elegant
solution:

.COPY STRUCTURE TO THIRD FIELDS LName, FName, Address, City, State, Zip
.USE Third
.DISPLAY STRUCTURE

Structure for database: C:\DB4\THIRD.DBF
Number of data records: 3
Date of last update : 09/14/91
Field Field Name Type Width Dec Index
1 LName Character 18 N
2 FName Character 12 N
3 Address Character 35 N
4 City Character 18 N
5 State Character 2 N
6 Zip Character 10 N
** Total ** 96

The data for the Third database should now look like the following:

FName LName Address City State Zip

John Smith 123 S. Main St Torrance CA 90502
Amy Smith 321 Oak Drive Long beach CA 90550
William Jones 20101 Hamilton Avenue Gardena CA 90248-0100

The Second database has served its purpose and could be deleted at this
point. The First database might be deleted once you are totally satisfied
that all the data now resides in the Third database.

It should be noted that the above methodology is designed to convert a large
amount of data with the least amount of typing, but it is not perfect. Last
names containing several capitalized letters must be corrected manually (such
as O'Malley or DeSilva). Also, many of the procedures and functions
demonstrated here can be combined, reducing the number of steps and files
necessary to complete the process.


4 Q & A

Calling dBASE IV

Automatic file activation, zero-padded fields and illegal valuesare on our
list of questions and answers this month.

Q. Is there a way to call dBASE IV with a database name as a parameter and
have dBASE IV start with that file active?

A. This can be done within the confines of a .BAT file in combination with a
start-up program in dBASE IV.

* Calldb.bat
@ECHO OFF
CLS
REM Check for parameter.
IF %1x==x GOTO error
REM Set DOS environment variable.
SET dBASE=%1
REM Call dBASE IV with startup program.
DBASE /T Startup
GOTO end
:error
ECHO You must specify the file name you want to open when you are
ECHO using %0 to start dBASE IV!
ECHO Syntax: %0 [database file name with extension]
:end

* Startup.prg
SET CONSOLE OFF
temp = GETENV("dbase") && Get Dos environment variable.
SET CONSOLE ON
IF LEN(TRIM(temp)) = 0 && Check Dos environment variable.
? CHR(7) + "THE DOS ENVIRONMENT VARIABLE WAS NOT CREATED. " + ;
"CHECK YOUR ENVIRONMENT SIZE!"
ELSE
ON ERROR ? CHR(7) + ;
"The file "+ temp +" is not a database file, or is corrupt!"
IF FILE(temp)
USE &temp
ELSE
? CHR(7)+"The file "+temp+" does not exist!"
ENDIF
ON ERROR
ENDIF
* If you want to start directly in the Control Center, remove the asterisk
* from the next line.
* ASSIST

Once you have created both the .BAT file and .PRG, you can then invoke dBASE
IV with the syntax:

Calldb

This assumes dBASE IV and CalldB.BAT are in the path, that you have enough
environment space to create another DOS variable, and that the complete
filename is specified. If dBASE IV is not in the path, you can modify the
CalldB.BAT file to move you to the correct drive/directory before you execute
dBASE IV.

This works well for Windows or any other utility that allows you to associate
a program with an extension. Within Windows you must pre-define the DOS
variable with the maximum length filename (12 characters). Within the
AutoExec.BAT file, add a line something like:

set dbase=filename.ext

Otherwise, Windows will run out of environment space when you try and create
the DOS environment variable.

Leading Zeros

Q. I have a numeric field in my database called Code with a width of 5. I
want my fields to have leading zeroes, but whenever I put the zeroes before
the number, they disappear when I save the field. What can I do to save my
leading zeroes?

A. There are a number of approaches to solving this problem. In the first
approach, you can keep the field as a numeric field. When printing a dBASE IV
report form, you can choose the Show Leading Zeroes option from the Picture
Functions menu when examining the structure of the Code field. Although the
field itself will still have no leading zeroes, it will display on the report
with leading zeros. When displaying from within a program, the L function of
the @..SAY or ? commands will provide for leading zeroes.

The second approach puts leading zeroes in a character field. Create a
character field called CodeChar with a width of 5. The Code numeric field
still exists. Execute the following command from the dot prompt to fill the
CodeChar field with the contents of the Code numeric field will leading
zeroes:

REPLACE ALL CodeChar WITH RIGHT("00000" + LTRIM(STR(Code)), 5)

The STR function supplies the character equivalent of the Code field. The
LTRIM() function removes any leading spaces from the converted Code field. The
RIGHT() function takes the 5 right-most characters of the expression. If Code
equals 34, the RIGHT() function will be using the 5 right-most characters of
0000034, resulting in 00034.

Data Entry is a Crime

Q. I have a screen form with a memo field in an open window. Whenever I try
to enter data with this screen form, I get the message "Illegal Value". I've
also noticed that if I put information on line 22 of the screen form, it
overwrites the menu on the top of the screen. What do I do to fix these
problems?

A. The screen form generator creates forms with 22 lines per screen page.
However, the screen form generator gives no indication that you are crossing a
page boundary. Row numbers that are evenly divisible by 22 are the boundaries
of pages and should be avoided (lines 22, 44, 66, 88 and so on).

Therefore, when creating an open window for a memo, keep the memo between
lines 1 and 21 on page 1, 23 and 43 on page 2, and so on. When placing fields
and typing text, skip the boundary lines.


5 SQL Database Recovery by Dan Madoni

SQL Database Recovery by Dan Madoni

Woe betide the user who doesn't tread carefully on the sacred grounds of SQL.

Once there was a dBASE IV user that was using SQL with the Standard Edition of
dBASE IV. He purchased a copy of Server Edition and when he installed it, it
overwrote all the SQLHOME references to his SQL databases. This posed a
serious problem: how do you recover SQL databases? The databases exist on the
hard drive in the form of subdirectories and the tables exist on the hard
drive as database files within the subdirectories. The only obstacle is that
dBASE IV doesn't know how to get to them or manage them. This could happen
whether or not you are installing Server Edition if you are not wary of each
step of the installation process.

Before you go trying to piece everything back together, make sure that you
check Config.DB. The SQLHOME line should equal the SQLHOME subdirectory.
This is usually a directory called SQLHOME that exists off of the dBASE home
directory. This is often the simplest solution.

There are two approaches that I know of to correct this problem. The first is
quite simple but is not 100% reliable. If you are unable to successfully
complete the steps in Plan A, proceed to Plan B.

Plan A:

First, QUIT from dBASE IV and move to your SQL database directory. For
example, in the example code below, the name of the SQL database is MYDB.

The sequence of commands in Plan A:

C:\DBASE>CD MYDB
C:\DBASE\MYDB>MD \TEMP
C:\DBASE\MYDB>COPY *.* \TEMP
C:\DBASE\MYDB>DEL \TEMP\SYS*.*
C:\DBASE>DEL MYDB\*.*
C:\DBASE>RD MYDB
SQL. CREATE DATABASE MYDB;
SQL. RUN COPY \TEMP\*.*
C:\DBASE\MYDB
DBDEFINE;

If the directory does not exist, enter the name of the directory you were in
when it was created. Move to that directory and try again. Create a
temporary directory, using the MKDIR (or MD) command in DOS.

This directory will be used to hold backups of table data while some tweaking
is done. Copy the SQL tables form the database (subdirectory) to the TEMP
directory and delete everything that is not a data table.

Move one directory down and get rid of the SQL database subdirectory (all
files beginning with the letters SYS).

Now start dBASE IV and SET SQL ON. At the SQL dot prompt, issue the CREATE
DATABASE command referencing MYDB.

Copy the database tables from the TEMP directory back into the database
subdirectory with the RUN COPY command. Make sure to substitute the names in
the example with the names of your paths where appropriate. Once the files
have been copied, issue a DBDEFINE command followed by a semi-colon at the SQL
dot prompt. After some hard drive activity, the restoration of the database
should be complete. Don't forget to delete the TEMP directory and repeat the
above steps as necessary for each database.

Plan B:

This method is much more direct since it delves right into the heart of the
dBASE IV SQL management databases to fix the problem. If you are familiar
with the methods dBASE IV uses to manage SQL databases and tables, some of the
following explanation might be old hat.

When you create an SQL database, you are actually creating a subdirectory
given the same name as the database. The SQLHOME directory contains a dBASE
IV database file called SysDbs.DBF which contains information on what
databases exist and where to find them. If the name of a database is MyDb,
there would be a subdirectory off whatever directory that MyDb was created and
an entry in the SysDbs database with the name and path of MyDb.

Inside the MyDb subdirectory, there are several dBASE IV databases that
contain information on the tables that make up MyDb. The file that is of
concern is SysTables.DBF. The data tables also reside in this subdirectory as
dBASE IV databases.

With this in mind, as long as the subdirectories and data exist in their
places, we can modify a couple of system DBF files just as we would any other
DBF and subsequently tell dBASE IV where everything is.

To do this, start dBASE IV from the directory in which it is installed.
Proceed to the dot prompt and type:

SET DIRECTORY TO SQLHOME

Once in the SQLHOME subdirectory, we can try to manually fix the SysDbs file.
The sequence of commands shown below goes beyond simply opening the SysDbs and
making modifications. SysDbs has to be copied to a temporary database since
it is a Read-Only DBF:

USE SYSDBS
COPY TO TEMP
USE TEMP
BROWSE

There will probably be one entry for the Samples SQL database in this file.
Notice that the Name field has the name of the Samples database and the Path
field indicates where it is located. The Creator and Created fields are not
important for our purposes.

Add a record to the database, typing in the name of the SQL database into the
Name field, (such as MyDb) and the path where it is located in the Path field,
(such as C:\DBASE\MYDB). Press Ctrl-End to save the changes made to the Temp
database and copy it over the old SysDbs as shown below:

COPY TO SYSDBS

Close and erase the Temp file:

USE
ERASE TEMP.DBF

Now, SET SQL ON and try to START the database:

START DATABASE MYDB;

If you are successful, make sure that the tables are still intact by issuing a
SELECT command, (assume in the following example that the table is called
"MYTABLE"):

SELECT * FROM MYTABLE;

If you see your data, you can pretty much assume that success has smiled upon
you. If you get an error indicating that the table does not exist, but the
DBF files with the table names exist in the subdirectory, type DBDEFINE; at
the SQL dot prompt:

Read Me Last

You may not achieve definitive results by following one of the above plans.
You may have try a combination of steps from both of them. Hopefully, you
have acquired an understanding of how dBASE IV manages SQL data. Once you
have a clear understanding of how it works along with a basic understanding of
dBASE IV and SQL, you will find that recovering SQL databases is almost always
possible as long as the tables still exist on the hard drive.


6 Corrigenda: A Short Course in Weights and Measures

Corrigenda: A Short Course in Weights and Measures

In last month's edition of TechNotes we included a utility that made various
conversions between American and metric weight and fluid measurements (see
"Weight and Fluid Conversions", October 1991). The vast majority of dBASE IV
applications revolve around business and, alas, our illiteracy in science
showed through. Many thanks to Peter Ingreman for pointing out that there
were many unstated assumptions in the article.

Science-minded folk will no doubt be aware that a kilogram is a measure of
mass and a pound is a measure of force. You can't really convert one to the
other knowing only the number of kilograms or pounds. Even if you stay within
one system (American or metric), you still have problems: you can convert
fluid to weight only knowing the density of the fluid.

For all practical purposes (given our penchant for business applications), the
conversion table presented in the article is valid because most folks not
involved in pursuits of scientific theory think of things as having a certain
weight. We want to know how many pounds (or kilograms) we can buy for a
certain amount of money. We typically don't worry about the assumptions of
temperature, mass, gravity or density.


7 Automatically Opening a Memo Window

In last month's edition, a Q & A entitled "Look, No Hands!" talked about the
possibility of directly entering EDIT mode when a memo window appears. The
answer specified use of the READKEY() function, although the UDF that followed
is conspicuously absent of the use of that function. The reference should
have been to the LASTKEY() function in the text preceding the code.
Additionally, it should be noted that this functionality will only be valid
when using the dBASE editor and not an external editor.


8 Function Junction

Function Junction by Adam Menkes

We've printed dozens of UDFs, touted their flexibility and power and still.
Let's review the basics

What is a UDF? A User-Defined Function is just that, a function defined by
you, the user. Although dBASE IV has many functions, there may be times when
you need something that is not included. For example, if you wanted a
function that took some date, added seven days to it, and returned the value
of a new date, your UDF would look something like this :

FUNCTION Date7
PARAMETER DatePassed
DatePassed = DatePassed + 7
RETURN DatePassed

This function could also be written more concisely, by performing the
calculation as part of the return value.

FUNCTION Date7
PARAMETER DatePassed
RETURN DatePassed + 7

Although this is rather simple function (more aptly, a Useless Defined
Function), it does give you some foundation for creating them. The first few
examples can be done just as easily without these functions.

. ? {07/01/91} + 7

is exactly the same as

. ? Date7({07/01/91})

and

. ? CTOD("07/01/91") + 7

The statement FUNCTION Date7 names your function, Date7, so that you may call
it up later. The PARAMETER is what value or values passed to the UDF for the
calculation. You may have many parameters (10 literal, 50 variable).

After you perform your calculation, you RETURN a value. This value does not
have to be the same data type as the parameter passed.

Passing two or more parameters is functionally the same as passing one, it
just gives more options. For example, you want to create a more generic date
function that adds some number of days to some date, your new function might
look like:

FUNCTION DateX
PARAMETER DatePassed, DaysPassed
RETURN DatePassed + DaysPassed

Our extra parameter means that we don't have to hard-code the date increment
value (seven). DateX(DATE(), 7) is the same as Date7(DATE()).

How do you use these FUNCTIONs?

In your program, format screens, reports, queries, or at the dot prompt you
may reference your function just as any other dBASE IV function. For example,
you want to know the date 180 days from today (assume today is 7/1/91),
combine the dBASE IV DATE() function and our new DateX() UDF:

. Today = DATE()
07/01/91
. ? Datex(Today, 180)
12/28/91

Nesting Functions

A lot of confusion occurs when you combine functions. It appears that the
open and closing parentheses don't always match up. Nesting a function means
to use a function within a function. As in the example above, DateX(DATE(),
7) would return the value for today's date plus seven. Since DATE() is a
function by itself with no parameters, it simply uses an open-end
close-parenthesis. Since DateX() has 2 parameters, the valid syntax for this
function is DateX(item1, item2). Therefore, you may not use DateX(item1),
DateX(), or DateX(n1, n2, n3,.).

All dBASE IV functions, including the ones that you write, must be called with
the correct number of parameters. Further, the parameters must be of the
right data type and in the right order. In the DateX() function the first
parameter must be a date and the second parameter must be a number. The
parameters are separated by commas, so that the correct syntax for
incrementing today's date by 180 is DateX(DATE(), 180), not DateX(DATE(180)),
or DateX(DATE())(180) or any of the other increasingly complex combinations of
parentheses and commas.

A more complex nested functionthe dBASE IV function IIF() which takes three
parametersis listed below. See if you can figure out what the possible
return values might be.

IIF(Sex = "M", "Male", "Female")

The IIF() function works with three parameters. The first must evaluate to a
true or false condition. The second and third parameters are the return
values. If the first parameter equals true, IIF() will return second
parameter, else the third parameter is returned. For instance:

IIF(Sex = "M", "Male", IIF(Sex = "F", "Female", "Neither"))

This statement would translate as: if Sex equals "M", the return value is
male, otherwise the return value is whatever is after the 2nd comma. This may
be a little over simplified, but in this nested IIF() example, the implied
otherwise condition is another IIF(). This second IIF() evaluates (in
pseudo-code) - to: "if Sex equals F, the return value is Female, otherwise the
return value is Neither."

The reason this works is that the second IIF() condition will only be
evaluated if (or should I say iif) the first condition is false. In this
case, if the value of Sex is not equal to "M", the second IIF() will be
disregarded.

You can also return a value of a different data type. If you had a database
of numbers 1 to 26 and wanted to convert these to letters, one way you could
do this is to use:

IIF(Number = 1, "A", IIF(Number = 2, "B",
IIF(Number = 3, "C", . IIF(Number = 25, "Y",
"Z")))))))))))))))))))))))))

Note the 25 right (closing) parentheses. There are not 26 because if the
first 25 conditions are false, Number = 26 is implied that it must be "Z",
therefore you don't need to evaluate for that condition. Granted, a logical
scenario like this is better suited for an array than such a deeply nested
IIF() statement.

While there are some differences between a procedure and a functionnamely in
how they're calledthe main difference is that a function performs an
operation and then returns a value, whereas a procedure returns no value.
There are certain commands you may not do in a function that you can in a
procedure. See the "Commands" and "Functions" sections of Language Reference
for more information.

Your library of UDFs become their own overlay that dBASE IV accesses like it
would its own overlay files. But don't forget: to access this overlay, you
must SET PROCEDURE TO this file of UDFs. For example, if you saved all your
PROCEDUREs and FUNCTIONs under the name Library.PRG, you would SET PROCEDURE
TO Library.

UDFs can be as simple or as complex as need be. But more importantly, they
provide an access for you to increase the functionality of your product.


9 New on the BBS

New on the BBS

Our BBS contains thousands of files, many of which you may find of
interest.

dBIINFO.ZIP Several utilities to get information about .DBF, .NDX and .MDX
files. Reports the number of records in a .DBF file, the number of tags in
a .MDX, returns the index expression of a .MDX tag and returns the index
expression of a .NDX file. Works with Framework III/IV as well.

HPLASER.ZIP When printing to an HP LaserJet II or below in landscape mode,
you get a page eject before each print job. This is particularly
irritating to people trying to print envelopes. This is a replacement
print driver to fix the problem.

25N1.ZIP A printer driver for the Pacific Data 25-in-1 cartridge
supporting nearly all fonts.

All .ZIP files are compressed using PKZIP and require PKUNZIP (also on the
BBS) for expansion.


10 Manual Overwrite

MANUAL OVERWRITE

The Fundamentals of Popups

Understanding the basics of popups opens up great functionality to new dBASE
IV users.

Among the many additions to the command structure of the dBASE language that
have appeared in dBASE IV, menu commands are probably the biggest code
reducers and labor savers. But getting acquainted with popups by trying to
piece together all of the necessary commands in Language Reference can be a
difficult learning experience.

There are basically two types of menus in the dBASE IV language: popups and
menus. Both operate similarly but are defined differently and have some
mutually exclusive features. Both are considered "light-bar" menus where you
use the cursor keys to highlight a desired option that will perform a specific
task when you press the Enter key. If you've ever had to program one of these
in dBASE III PLUS, you'll greatly appreciate these additions to the language.

Both are control structures in the sense that once you activate either one, it
has control of the program until you deactivate it somehow. As a programmer,
you define what tasks they perform but once you activate them they are in
control until deactivated.

Popups can be described as "vertical light-bar" menus. You have a box with a
series of prompts inside of it and you use the up-arrow and down-arrow keys to
navigate through the available selections. Once you press Enter on an item, a
pre-defined process is executed.

There are basically three steps to defining a popup:

1. Give it a name.
2. Give it some selectable items.
3. Assign an action to be performed when any item is selected from the popup.

Corresponding to these three steps are the commands:

1. DEFINE POPUP
2. DEFINE BAR
3. ON SELECTION POPUP

To assign the name and properties of a popup, you use the DEFINE POPUP
command. With this command you must at least specify its name and the
beginning row and column coordinates that the popup will be displayed in. See
Language Reference for additional options.

If you choose to make your popup a field list, a files list, or a structure
list, the second step, DEFINE BAR will be taken care of for you. A field list
would prompt you with all the values in a particular field in an active
database. A files list would prompt you with a list of file names. You can
limit what files are displayed by supplying a wild card skeleton that the
files must all match. A structure list would prompt you with all of the field
names in the structure of an active database or with a list of the fields
currently in the SET FIELDS list.

If you didn't make it a field, files, or structure list popup, you need to
define, bar by bar, what the contents of the highlight bars will be for this
popup. This is done one at a time with the DEFINE BAR command. Each defined
bar in a popup must be given a unique number and a prompt. You can optionally
assign each bar a message to be displayed whenever that bar is highlighted.
You can define the bar so that it can never be selected or you can specify a
condition that would need to be true in order for that bar to be
non-selectable or skipped over with the SKIP FOR clause.

In order for this popup to be able to do any useful work for us, we must tell
it what to do when we press Enter on one of the selectable prompts. This is
where the ON SELECTION POPUP command comes in. If you define a popup but
don't provide an ON SELECTION for it, nothing happens when you press Enter.
Two of the most common things that are done with the ON SELECTION POPUP
command are:

* have the popup deactivate itself.
* branch control of the program to a procedure with a DO CASE structure that
can handle any of the prompts that may have been selected and, if
necessary, deactivate the popup.

So how can you tell my program what item was selected from the popup menu?
dBASE IV has two functions for this: PROMPT() and BAR(). PROMPT() returns the
prompt of the most recently selected popup bar. BAR() returns the bar number
of the most recently selected popup bar. Both of these work even after the
popup is deactivated. Now, refer to the code called PopTest1.PRG (the code
for this and other examples follows this article).

In this program we have a complete popup definition. We give it a name and
starting coordinates and tell dBASE IV to fill in the bars with file names.
We also tell dBASE IV to deactivate the popup whenever it has been selected.
In this way, the popup deactivates itself. But the PROMPT() and BAR()
functions still remember what item was last selected.

Next, PopTest2 shows a slight variation on the first program that has almost
the same effect.

In this example, it's more clear how the ACTIVATE POPUP command controls the
whole program and that it's in control until the popup is deactivated. It is
very important to understand that the ACTIVATE POPUP command is being executed
as long as the popup is active. The only thing we are certain of after the
popup has been deactivated is that is was deactivated. We don't know how. A
popup can be deactivated in one of three ways:

* pressing the Esc key to abandon the popup,
* pressing the left or right arrow keys also abandon the popup,
* issuing the DEACTIVATE POPUP command in some other part of the code.

So how do we know if the popup was abandoned or selected? We can check for
the value of LASTKEY() or check the PROMPT() function. If PROMPT() returns a
null character, nothing was selected. If we want to force a selection from
the popup, we simply keep re-activating it until the PROMPT() function returns
something other than a null, as shown in PopTest3.PRG.

Notice the SHOW POPUP command in this example code. The reason we use it here
is because whenever a popup is abandoned or selected, its image is cleared
from the screen and whatever was originally on that portion of the screen is
restored. The SHOW POPUP command puts an image of the popup on the screen.
Now, when the popup is deactivated or selected, dBASE IV restores the image of
the popup, making this whole process of forcing a selection look much
smoother.

A different way to handle the problem of forcing a selection is shown in
PopTest4.PRG, but this one allows you to select to quit the popup. This is a
very common way of dealing with flow control through a popup. The main
routine activates the popup in a loop, making sure that it wasn't aborted
accidentally. The action that is assigned to be performed when this popup is
selected is to run a procedure that branches out to different tasks, depending
on which bar was selected from the popup. But no matter where it branches off
to, this popup is still active and is expecting to receive back control of the
program.

Of course, you can have this routine deactivate the popup, as is done in this
example. When the Quit option is selected, the DEACTIVATE POPUP command is
issued and the control of the program returns immediately to the command
immediately after the ACTIVATE POPUP command in the main routine, which is the
IF command that allows the user to exit the loop if they actually selected an
item.

In this example, the only way to quit this menu is to choose the Quit option
that we've defined. If you put a DEACTIVATE POPUP at the end of each of the
CASE statements, selecting any item would cause it to be deactivated.

Popups really are simple, once you know how they work and how to define them.


11 Code fo Manual Overwrite

* PopTest1.PRG
CLEAR
DEFINE POPUP Test FROM 5,5 PROMPT FILES
ON SELECTION POPUP Test DEACTIVATE POPUP

ACTIVATE POPUP Test

? "You selected the file " + PROMPT() + ;
", it was bar number " + LTRIM(STR(BAR()))
* End of PopTest.PRG

* PopTest2.PRG
CLEAR
DEFINE POPUP Test FROM 5,5 PROMPT FILES
ON SELECTION POPUP Test DO PopProc

ACTIVATE POPUP Test
RETURN
* End of main routine

* Procedure PopProc
PROCEDURE PopProc
@ 5,20 CLEAR TO 6,79
@ 5,20 SAY "You selected the file " + PROMPT()
@ 6,20 SAY "it was bar number " + LTRIM(STR(BAR()))
RETURN
* End of PopTest2.PRG

* PopTest3.PRG
CLEAR
DEFINE POPUP Test FROM 5,5 PROMPT FILES
ON SELECTION POPUP Test DEACTIVATE POPUP

SHOW POPUP Test
DO WHILE .T.
ACTIVATE POPUP Test
IF "" # PROMPT()
CLEAR
@ 5,20 SAY "You selected the file " + PROMPT()
@ 6,20 SAY "it was bar number " + LTRIM(STR(BAR()))
EXIT
ELSE
@ 5,20 SAY "You must select an item with the key"
LOOP
ENDIF
ENDDO
* End of PopTest3.PRG

* PopTest4.PRG
CLEAR
DEFINE POPUP Test FROM 5,5
DEFINE BAR 1 OF Test PROMPT "Popup Header " SKIP
DEFINE BAR 2 OF Test PROMPT "=============" SKIP
DEFINE BAR 3 OF Test PROMPT "First Choice "
DEFINE BAR 4 OF Test PROMPT "Second Choice"
DEFINE BAR 5 OF Test PROMPT " QUIT "
ON SELECTION POPUP Test DO PopProc

SHOW POPUP Test
DO WHILE .T.
ACTIVATE POPUP Test
IF "" # PROMPT()
EXIT
ENDIF
ENDDO
CLEAR
RETURN
* End of main routine

PROCEDURE PopProc
DO CASE
CASE BAR() = 3
* The first choice was selected, do something
CASE BAR() = 4
* The second choice was selected, do something else
CASE BAR() = 5
* The Quit bar was chosen, deactivate the popup
DEACTIVATE POPUP
ENDCASE
RETURN
* End of PopTest4.PRG


12 Catching Some Arrays by Adam L. Menkes

Catching Some Arrays by Adam L. Menkes

Using the power of UDFs and procedures, arrays become even more powerful.
One advantage of using arrays for processing data instead of working directly
with the database is the speed at which the information may be processed.
When working with a database file, you are limited not only by the speed of
the processor, but also by the disk access speed of your floppy disk or hard
drive. With an array, all information is processed in memory without disk
read/write activity. This is useful if you are working in an environment
where you do not have access rights to the current drive or directory, or
simply are limited on disk space. There is no need for file or record
locking.

Another advantage is being able to mix data types. Array[1] could store a Date
{12/31/91} while Array[2] might store the character string "New Year's Eve".
Additionally, there is no need to name "fields". Array[2] = "SMITH" is as
valid as mName = "SMITH". The difference is that where memory variables are
name oriented, arrays are position oriented.

A disadvantage with using arrays is that you are limited by available memory
(RAM) and by dBASE IV limitations: 1,170 elements in version 1.1; 33,554,431
elements in Server Edition, with no more than 65,535 elements in either
dimension. However, these are not unreasonable limitations since an array of
Array[4, 65535] (4 * 65,535 = 262,140 elements) would require over 16
megabytes of memory (each empty array element allocates 64 bytes).

Another disadvantage is that once an array is declared, the size is static,
that is, it can not be changed without losing the contents of the array (the
size can be dynamic in the Server Edition). Also, you cannot do global
operations on the array elements, only on one element at a time. The
functions presented in the following pages allow more flexibility when using
arrays.

Procedures

ASort sorts the array elements by the column specified, either ascending or
descending (Similar to INDEX ON or SORT ON). AFill fills an array with data of
any type (except MEMO) and is similar to REPLACE ALL. ACopy copies the array
to another name, similar to COPY TO. ADel, like DELETE and PACK in one
command, removes an element from an array whereas the PROCEDURE AIns adds an
element (like APPEND BLANK or INSERT BLANK). AChange will convert a
one-dimensional array to a two-dimensional array (Adam[10] becomes Adam[1,
10]) or a row from a two-dimensional array to a one-dimensional one (Adam[x,
7] becomes Adam[7] where x is any row in the array). AFlip will change the
ROW/COLUMN orientation to COLUMN/ROW such that Adam[x, y] (Adam[12, 23]) will
become Adam[y, x] (Adam[23, 12]) without altering the data in these elements.

Functions

ARows() returns the number of rows in the array by incrementing the array
until the TYPE() is 'U' (Undefined). If it is a one-dimensional array (for
example, Adam[20]) there are no rows. If it is a two-dimensional array (like
Adam[20, 40]), it will return 20. The array name is either passed as a
literal or a variable:

. totalRow = ARows("Adam") && passed as a literal.
. mArray = "Adam"
. TotalRow = ARows(mArray) && passed as a variable.

ACols() returns the number of columns in the array by incrementing the array
until the TYPE() is 'U' (Undefined). If it is a one-dimensional
arrayAdam[20]it will return 20. If it is a two-dimensional arrayAdam[20,
40]it will return 40. Uses ARows() to determine whether it is a 1 or 2
dimensional array.

ASort

This procedure will sort the elements in an array (1 or 2 dimensional) by the
column specified. You may sort it in ascending (the default) or descending
order. All the elements in the specified column do not have to be of the same
data type, however, it will determine what type to sort based on the data type
of the last element in the array. All elements of a different data type will
retain their position.

This procedure starts at the last element of the array and determines whether
or not there is another element that evaluates to a greater value. If it
does, it switches the two elements, then evaluates the last element against
all the others again, continuing this switching until there is no greater
value in the array. Once it has determined that the last element is indeed
the greatest value, it begins this same comparison and switch process for the
second to last element. This continues until it has reached the first element
(nothing left to compare).

In a descending sort, it simply evaluates to the lesser value. Rather than
writing two separate procedures to handle this, it was easier to pass a
parameter for ascending or descending (actually, the way it evaluates is
Descending or not descending). You may also notice that I have reduced the
code even more by substituting the comparison operator ("<= " and ">=") and
using macro substitution. Rather than having code that reads:

IF mAscDesc = "D"
.Commands
IF variable <= other variable
.Commands
ENDIF
ELSE
.Commands
IF variable >= other variable
.Commands
ENDIF
ENDIF

your code reads :

IF variable &comparison other variable
.Commands
ENDIF

AFill

When you DECLARE an array, the default is the same as when you declare a
memory variable PUBLIC or PRIVATE (.F.). With memory variables, you can STORE
a value TO var1, var2,.varn. With databases, you may REPLACE ALL
WITH a value. With the following procedure, you can fill the array with a
value. It is basically a simple loop, and works with both 1 and 2 dimensional
arrays. To fill column 4 in array Array1 with "Empty cell", perform the
following commands:

. mStuff = "Empty cell"
. DO AFill WITH "Array1", 4, mStuff

ACopy

This procedure makes a copy of an array (1 or 2 dimensional). If you have an
array, Array1[20, 30] and want to copy all the elements to Array2[20, 30],
simply use :

. DO ACopy WITH "Array1", "Array2"

ADel

This procedure removes a column from an array (1 or 2 dimensional) and resizes
the array. For example, if Adam[1] = 1, Adam[2] = 2, Adam[3] = 3, and the
command DO ADel WITH "Adam", 2 were issued, the results with DISPLAY MEMORY

would show: instead of: or:

Adam[1] N 1 Adam[1] N 1 Adam[1] N 1
Adam[2] N 3 Adam[2] L .F. Adam[2] N 3
Adam[3] N 3 Adam[3] L .F.

Although this is different than the way other software products handle
deleting an element from an array, this method should perform as if it were
deleting a record in a database and subsequently packing it since it would be
easy to use Adam[2] = .F.

AIns

AIns, which inserts an element into a 1 or 2 dimensional array, is similar to
ADel in how it works. AIns copies data to a temporary array, adds a column
instead of removing one, and copies the data back, leaving the inserted column
blank (.F.).

AChange

Procedure AChange will convert a one-dimensional array into a two-dimensional
array, and vice versa. Given the following 2 arrays:

Array1[3] Array2[2, 3]

Array1[1] N 10 Array2[1, 1] N 1
Array1[2] N 20 Array2[1, 2] N 2
Array1[3] N 30 Array2[1, 3] N 3
Array2[2, 1] N 4
Array2[2, 2] N 5
Array2[2, 3] N 6

DO AChange WITH "Array1", 1 | WITH "Array2", 1 | WITH "Array2", 2

will result as follows :

Array1[1, 3] Array2[3] Array2[3]

Array1[1, 1] N 10 Array2[1] N 1 Array2[1] N 4
Array1[1, 2] N 20 Array2[2] N 2 Array2[2] N 5
Array1[1, 3] N 30 Array2[3] N 3 Array2[3] N 6

AFlip

AFlip will "flip" an array, that is, switch the rows and columns. A
one-dimensional array will become a two-dimensional array and then the rows
and columns will be switched (notice that Array1 has the elements [1, 1], [2,
1], and [3, 1] instead of [1, 1], [1, 2], and [1, 3]. This procedure allows
for data to be evaluated row-wise instead of column-wise without having to
write more UDFs. This is similar to the way COPY STRUCTURE EXTENDED works by
making FIELDS in the source database as "records" in the target database.
Since the columns in an array are like fields in a database and rows are like
records, processing record-oriented data is now as simple as processing
column-oriented data by "flipping" the rows and columns.

Array1[3] Array2[2, 3]
Array1[1] N 10 Array2[1, 1] N 1
Array1[2] N 20 Array2[1, 2] N 2
Array1[3] N 30 Array2[1, 3] N 3
Array2[2, 1] N 4
Array2[2, 2] N 5
Array2[2, 3] N 6

DO AFlip with "Array1" DO AFlip with "Array2"

Array1[3, 1] Array2[3, 2]

Array1[1, 1] N 10 Array2[1, 1] N 1
Array1[2, 1] N 20 Array2[1, 2] N 4
Array1[3, 1] N 30 Array2[2, 1] N 2
Array2[2, 2] N 5
Array2[3, 1] N 3
Array2[3, 2] N 6


FUNCTION ARows
* Returns the number of rows in an array.
PARAMETER a_Array
a_Rows = 1
DO WHILE TYPE("&a_Array[a_Rows, 1]") <> "U"
a_Rows = a_Rows + 1
ENDDO
RETURN a_Rows - 1


FUNCTION ACols
* Returns the number of columns in an array.
PARAMETER a_Array
* Requires ARows()
a_Cols = 1
DO WHILE IIF(ARows(a_Array) = 0, TYPE("&a_Array[a_Cols]") <> "U", ;
TYPE("&a_Array[1, a_Cols]") <> "U")
a_Cols = a_Cols + 1
ENDDO
RETURN a_Cols - 1


PROCEDURE ASort
* Requires ARows(), ACols()
* Sorts elements in an array, either ascending (default) or descending.
PARAMETER a_Array, a_Col, mAscDesc
ascDesc = IIF(UPPER(mAscDesc) = "D", "<=", ">=")
PRIVATE hold var

* Temporary variable for holding data when switching two elements.
m_Rows = ARows(a_Array) && # of Rows
m_Cols = ACols(a_Array) && # of Column

IF m_Rows = 0 && One-dimensional array.
m_Rows = m_Cols && Switch rows and columns
m_Cols = 1 && and set columns = 1.
m_Loop1 = "Loop Row" && Set the looping conditions
m_Last1 = "Last Row" && for a one-dimensional array -
m_Loop2 = "Loop Row" && Note that 'columns' (rows)
m_Last2 = "Last Row" && are irrelevant.
ELSE && Two-dimensional array.
m_Loop1 = "Loop Row, a_Col" && Set the looping conditions
m_Last1 = "Last Row, a_Col" && for comparison of the last
m_Loop2 = "Loop Row, Curr Col" && column and the current one.
m_Last2 = "Last Row, Curr Col"
ENDIF

IF m_Rows > 1 .AND. a_Col <= m_Cols
loop row = m_Rows

last row = m_Rows
DO WHILE Last Row > 1
switched = .F.
IF TYPE("&a_Array[&m_Last1]") $ "CNFD"
DO WHILE Loop Row >= 1

* Skip element if it is a different data type.
IF TYPE("&a_Array[&m_Loop1]") <> TYPE("&a_Array[&m_Last1]")
loop Row = loop Row - 1
ELSE
* Skip element if it is a lesser (greater) value.
IF &a_Array[&m_Last1] &ascDesc &a_Array[&m_Loop1]
loop Row = loop Row - 1
ELSE
* Store element if it is greater (lesser) value to Hold Var.
* Replace the current element with the comparative element.
* Replace the comparative element with Hold Var and continue.
curr Col = 1
DO WHILE curr Col <= m_Cols
hold var = &a_Array[&m_Last2]
&a_Array[&m_Last2] = &a_Array[&m_Loop2]
&a_Array[&m_Loop2] = hold var
curr Col = curr Col + 1
ENDDO
switched = .T.
EXIT
ENDIF
ENDIF
ENDDO
ENDIF

IF .NOT. switched
last Row = Last Row - 1
ENDIF

* If no elements were switched, it was the largest value, continue.
loop row = last row
ENDDO
ENDIF
RELEASE hold var
RETURN
* EOP: ASort.PRG


PROCEDURE AIns
* Inserts an element into an array.
PARAMETERS a_Array, a_Col
* Requires AROWS(), ACOLS(), PROCEDURE ACOPY

a_Temp = "A_" + LTRIM(STR(INT(RAND(-1) * 1000000), 6))

* Create a temporary array to copy the information to.
m_Rows = ARows(a_Array)
m_Cols = ACols(a_Array)

IF m_Rows = 0 .AND. m_Cols = 0
RELEASE &a_Temp
RETURN
ENDIF

DO ACopy WITH a_Array, a_Temp
IF m_Rows = 0 && One-dimensional array.
m_declare = "m_Cols"
mRowCol="xCurCol"
m_Rows = 1
ELSE && Two-dimensional array.
m_declare = "m_Rows, m_Cols"
mRowCol="xCurRow, xCurCol"
ENDIF

DECLARE &a_Array[&m_declare + 1]

xCurCol = 1
DO WHILE xCurCol <= m_Cols + 1
xCurRow = 1
DO WHILE xCurRow <= m_Rows
DO CASE
CASE xCurCol < a_col
&a_Array[&mRowCol] = &a_Temp[&mRowCol]

CASE xCurCol = a_col
* DO NOTHING

CASE xCurCol > a_col
&a_Array[&mRowCol] = &a_Temp[&mRowCol - 1]

ENDCASE
xCurRow = xCurRow + 1
ENDDO
xCurCol = xCurCol + 1
ENDDO
RELEASE &a_Temp
RETURN
* EOP: AIns.PRG


PROCEDURE ADel
*- Deletes element from an array. Requires AROWS(), ACOLS(), PROCEDURE ACOPY
PARAMETERS a_Array, a_Col
a_Temp="A_"+ LTRIM(STR(INT(RAND(-1) * 1000000), 6))
*- Create a temporary array to copy the information to.

m_Rows = aRows(a_Array)
m_Cols = ACols(a_Array)

IF m_Rows = 0 .AND. m_Cols = 0
RELEASE &a_Temp
RETURN
ENDIF

IF m_Cols = 1 && If only 1 column left in the array,
RELEASE &a_Array && release it from memory.
RETURN
ENDIF

DO ACopy WITH a_Array, a_Temp && Copy the data to another array.

IF m_Rows = 0
m_declare = "m_Cols"
mRowCol="xCurCol"
m_Rows = 1
ELSE && 2-dimensional array.
m_declare = "m_Rows, m_Cols"
mRowCol="xCurRow, xCurCol"
ENDIF

DECLARE &a_Array[&m_declare - 1]

xCurCol = 1
DO WHILE xCurCol <= m_Cols - 1
xCurRow = 1
DO WHILE xCurRow <= m_Rows
* Store the contents from the temporary array[Column + 0] back into
* the original array. If the current column is the deleted one,
* store the contents of the temporary array[Column + 1].
&a_Array[&mRowCol] = &a_Temp[&mRowCol + IIF(xCurCol >= a_col, 1, 0)]
xCurRow = xCurRow + 1
ENDDO
xCurCol = xCurCol + 1
ENDDO

RELEASE &a_Temp
RETURN
* EOP: ADel.PRG


PROCEDURE AFill
*- Fills an array with a value. Requires ARows(), ACols()
PARAMETERS a_Array, a_Col, m_Var

m_Rows = ARows(a_Array)
m_Cols = ACols(a_Array)

IF m_Rows = 0 .AND. m_Cols = 0
RETURN
ENDIF

IF m_Rows = 0 && 1-dimensional array.
mRowCol="xCurRow" && NOT "xCurCol".
m_Rows = m_Cols
ELSE && 2-dimensional array.
mRowCol="xCurRow, xCurCol"
ENDIF

xCurCol = a_Col
xCurRow = 1
DO WHILE xCurRow <= m_Rows
&a_Array[&mRowCol] = m_Var
xCurRow = xCurRow + 1
ENDDO
RETURN
* EOP: AFIll.PRG


PROCEDURE ACopy
*_Copies a one or two dimensional array.
PARAMETERS m_from, m_to
PUBLIC &m_to

m_Rows = aRows(m_from)
m_Cols = ACols(m_from)

IF m_Rows = 0 .AND. m_Cols = 0
RELEASE &m_to
RETURN
ENDIF

IF m_Rows = 0
m_declare = "m_Cols"
mRowCol="xCurCol"
m_Rows = 1
ELSE
m_declare = "m_Rows, m_Cols"
mRowCol="xCurRow, xCurCol"
ENDIF

DECLARE &m_to[&m_declare]
xCurCol = 1
DO WHILE xCurCol <= m_Cols
xCurRow = 1
DO WHILE xCurRow <= m_Rows
&m_to[&mRowCol] = &m_from[&mRowCol]
xCurRow = xCurRow + 1
ENDDO

xCurCol = xCurCol + 1
ENDDO

RETURN
* EOP: ACopy.PRG


PROCEDURE AChange
PARAMETER a_Array, a_Row
* Array name, row of data (irrelevent for 1-dim array)
* Requires AROWS(), ACOLS(), PROCEDURE ACOPY

a_temp = "A_"+ LTRIM(STR(INT(RAND(-1) * 1000000), 6))
* Create a temporary array to copy the information to.
m_Rows = aRows(a_Array)
m_Cols = ACols(a_Array)

IF m_Rows = 0 .AND. m_Cols = 0
RETURN
ENDIF

IF m_Rows = 0
mDeclare = "1, m_Cols"
mRowCol1 = "xCurCol"
mRowCol2 = "1, xCurCol"
ELSE
mDeclare = "m_Cols"
mRowCol1 = "a_Row, xCurCol"
mRowCol2 = "xCurCol"
ENDIF

DECLARE &a_Temp[&mDeclare]
xCurCol = 1

DO WHILE xCurCol <= m_Cols
&a_Temp[&mRowCol2] = &a_Array[&mRowCol1]
xCurCol = xCurCol + 1
ENDDO

DO ACOPY WITH a_Temp, a_Array
RELEASE a_Temp
RETURN
* EOP: AChange.PRG


PROCEDURE AFlip
PARAMETER a_Array
* Requires ARows(), ACols(), procedures AChange, ACopy

m_Rows = aRows(a_Array)
m_Cols = ACols(a_Array)

IF m_Rows = 0 .AND. m_Cols = 0
RETURN
ENDIF

IF m_Rows = 0
m_Rows = 1
DO aChange WITH a_Array, 1
ENDIF

a_Temp="A_"+ LTRIM(STR(INT(RAND(-1) * 1000000), 6))

* Create a temporary array to copy the information to.
DECLARE &a_Temp[m_Cols, m_Rows]

xCurCol = 1
DO WHILE xCurCol <= m_Cols
xCurRow = 1
DO WHILE xCurRow <= m_Rows
&a_Temp[xCurCol, xCurRow] = &a_Array[xCurRow, xCurCol]
xCurRow = xCurRow + 1
ENDDO
xCurCol = xCurCol + 1
ENDDO

DO ACOPY WITH a_Temp, a_Array
RELEASE a_Temp
RETURN
EOP: AFlip.PRG


13 Array Code

FUNCTION ARows
* Returns the number of rows in an array.
PARAMETER a_Array
a_Rows = 1
DO WHILE TYPE("&a_Array[a_Rows, 1]") <> "U"
a_Rows = a_Rows + 1
ENDDO
RETURN a_Rows - 1


FUNCTION ACols
* Returns the number of columns in an array.
PARAMETER a_Array
* Requires ARows()
a_Cols = 1
DO WHILE IIF(ARows(a_Array) = 0, TYPE("&a_Array[a_Cols]") <> "U", ;
TYPE("&a_Array[1, a_Cols]") <> "U")
a_Cols = a_Cols + 1
ENDDO
RETURN a_Cols - 1


PROCEDURE ASort
* Requires ARows(), ACols()
* Sorts elements in an array, either ascending (default) or descending.
PARAMETER a_Array, a_Col, mAscDesc
ascDesc = IIF(UPPER(mAscDesc) = "D", "<=", ">=")
PRIVATE hold var

* Temporary variable for holding data when switching two elements.
m_Rows = ARows(a_Array) && # of Rows
m_Cols = ACols(a_Array) && # of Column

IF m_Rows = 0 && One-dimensional array.
m_Rows = m_Cols && Switch rows and columns
m_Cols = 1 && and set columns = 1.
m_Loop1 = "Loop Row" && Set the looping conditions
m_Last1 = "Last Row" && for a one-dimensional array -
m_Loop2 = "Loop Row" && Note that 'columns' (rows)
m_Last2 = "Last Row" && are irrelevant.
ELSE && Two-dimensional array.
m_Loop1 = "Loop Row, a_Col" && Set the looping conditions
m_Last1 = "Last Row, a_Col" && for comparison of the last
m_Loop2 = "Loop Row, Curr Col" && column and the current one.
m_Last2 = "Last Row, Curr Col"
ENDIF

IF m_Rows > 1 .AND. a_Col <= m_Cols
loop row = m_Rows

last row = m_Rows
DO WHILE Last Row > 1
switched = .F.
IF TYPE("&a_Array[&m_Last1]") $ "CNFD"
DO WHILE Loop Row >= 1

* Skip element if it is a different data type.
IF TYPE("&a_Array[&m_Loop1]") <> TYPE("&a_Array[&m_Last1]")
loop Row = loop Row - 1
ELSE
* Skip element if it is a lesser (greater) value.
IF &a_Array[&m_Last1] &ascDesc &a_Array[&m_Loop1]
loop Row = loop Row - 1
ELSE
* Store element if it is greater (lesser) value to Hold Var.
* Replace the current element with the comparative element.
* Replace the comparative element with Hold Var and continue.
curr Col = 1
DO WHILE curr Col <= m_Cols
hold var = &a_Array[&m_Last2]
&a_Array[&m_Last2] = &a_Array[&m_Loop2]
&a_Array[&m_Loop2] = hold var
curr Col = curr Col + 1
ENDDO
switched = .T.
EXIT
ENDIF
ENDIF
ENDDO
ENDIF

IF .NOT. switched
last Row = Last Row - 1
ENDIF

* If no elements were switched, it was the largest value, continue.
loop row = last row
ENDDO
ENDIF
RELEASE hold var
RETURN
* EOP: ASort.PRG


PROCEDURE AIns
* Inserts an element into an array.
PARAMETERS a_Array, a_Col
* Requires AROWS(), ACOLS(), PROCEDURE ACOPY

a_Temp = "A_" + LTRIM(STR(INT(RAND(-1) * 1000000), 6))

* Create a temporary array to copy the information to.
m_Rows = ARows(a_Array)
m_Cols = ACols(a_Array)

IF m_Rows = 0 .AND. m_Cols = 0
RELEASE &a_Temp
RETURN
ENDIF

DO ACopy WITH a_Array, a_Temp
IF m_Rows = 0 && One-dimensional array.
m_declare = "m_Cols"
mRowCol="xCurCol"
m_Rows = 1
ELSE && Two-dimensional array.
m_declare = "m_Rows, m_Cols"
mRowCol="xCurRow, xCurCol"
ENDIF

DECLARE &a_Array[&m_declare + 1]

xCurCol = 1
DO WHILE xCurCol <= m_Cols + 1
xCurRow = 1
DO WHILE xCurRow <= m_Rows
DO CASE
CASE xCurCol < a_col
&a_Array[&mRowCol] = &a_Temp[&mRowCol]

CASE xCurCol = a_col
* DO NOTHING

CASE xCurCol > a_col
&a_Array[&mRowCol] = &a_Temp[&mRowCol - 1]

ENDCASE
xCurRow = xCurRow + 1
ENDDO
xCurCol = xCurCol + 1
ENDDO
RELEASE &a_Temp
RETURN
* EOP: AIns.PRG


PROCEDURE ADel
*- Deletes element from an array. Requires AROWS(), ACOLS(), PROCEDURE ACOPY
PARAMETERS a_Array, a_Col
a_Temp="A_"+ LTRIM(STR(INT(RAND(-1) * 1000000), 6))
*- Create a temporary array to copy the information to.

m_Rows = aRows(a_Array)
m_Cols = ACols(a_Array)

IF m_Rows = 0 .AND. m_Cols = 0
RELEASE &a_Temp
RETURN
ENDIF

IF m_Cols = 1 && If only 1 column left in the array,
RELEASE &a_Array && release it from memory.
RETURN
ENDIF

DO ACopy WITH a_Array, a_Temp && Copy the data to another array.

IF m_Rows = 0
m_declare = "m_Cols"
mRowCol="xCurCol"
m_Rows = 1
ELSE && 2-dimensional array.
m_declare = "m_Rows, m_Cols"
mRowCol="xCurRow, xCurCol"
ENDIF

DECLARE &a_Array[&m_declare - 1]

xCurCol = 1
DO WHILE xCurCol <= m_Cols - 1
xCurRow = 1
DO WHILE xCurRow <= m_Rows
* Store the contents from the temporary array[Column + 0] back into
* the original array. If the current column is the deleted one,
* store the contents of the temporary array[Column + 1].
&a_Array[&mRowCol] = &a_Temp[&mRowCol + IIF(xCurCol >= a_col, 1, 0)]
xCurRow = xCurRow + 1
ENDDO
xCurCol = xCurCol + 1
ENDDO

RELEASE &a_Temp
RETURN
* EOP: ADel.PRG


PROCEDURE AFill
*- Fills an array with a value. Requires ARows(), ACols()
PARAMETERS a_Array, a_Col, m_Var

m_Rows = ARows(a_Array)
m_Cols = ACols(a_Array)

IF m_Rows = 0 .AND. m_Cols = 0
RETURN
ENDIF

IF m_Rows = 0 && 1-dimensional array.
mRowCol="xCurRow" && NOT "xCurCol".
m_Rows = m_Cols
ELSE && 2-dimensional array.
mRowCol="xCurRow, xCurCol"
ENDIF

xCurCol = a_Col
xCurRow = 1
DO WHILE xCurRow <= m_Rows
&a_Array[&mRowCol] = m_Var
xCurRow = xCurRow + 1
ENDDO
RETURN
* EOP: AFIll.PRG


PROCEDURE ACopy
*_Copies a one or two dimensional array.
PARAMETERS m_from, m_to
PUBLIC &m_to

m_Rows = aRows(m_from)
m_Cols = ACols(m_from)

IF m_Rows = 0 .AND. m_Cols = 0
RELEASE &m_to
RETURN
ENDIF

IF m_Rows = 0
m_declare = "m_Cols"
mRowCol="xCurCol"
m_Rows = 1
ELSE
m_declare = "m_Rows, m_Cols"
mRowCol="xCurRow, xCurCol"
ENDIF

DECLARE &m_to[&m_declare]
xCurCol = 1
DO WHILE xCurCol <= m_Cols
xCurRow = 1
DO WHILE xCurRow <= m_Rows
&m_to[&mRowCol] = &m_from[&mRowCol]
xCurRow = xCurRow + 1
ENDDO

xCurCol = xCurCol + 1
ENDDO

RETURN
* EOP: ACopy.PRG


PROCEDURE AChange
PARAMETER a_Array, a_Row
* Array name, row of data (irrelevent for 1-dim array)
* Requires AROWS(), ACOLS(), PROCEDURE ACOPY

a_temp = "A_"+ LTRIM(STR(INT(RAND(-1) * 1000000), 6))
* Create a temporary array to copy the information to.
m_Rows = aRows(a_Array)
m_Cols = ACols(a_Array)

IF m_Rows = 0 .AND. m_Cols = 0
RETURN
ENDIF

IF m_Rows = 0
mDeclare = "1, m_Cols"
mRowCol1 = "xCurCol"
mRowCol2 = "1, xCurCol"
ELSE
mDeclare = "m_Cols"
mRowCol1 = "a_Row, xCurCol"
mRowCol2 = "xCurCol"
ENDIF

DECLARE &a_Temp[&mDeclare]
xCurCol = 1

DO WHILE xCurCol <= m_Cols
&a_Temp[&mRowCol2] = &a_Array[&mRowCol1]
xCurCol = xCurCol + 1
ENDDO

DO ACOPY WITH a_Temp, a_Array
RELEASE a_Temp
RETURN
* EOP: AChange.PRG


PROCEDURE AFlip
PARAMETER a_Array
* Requires ARows(), ACols(), procedures AChange, ACopy

m_Rows = aRows(a_Array)
m_Cols = ACols(a_Array)

IF m_Rows = 0 .AND. m_Cols = 0
RETURN
ENDIF

IF m_Rows = 0
m_Rows = 1
DO aChange WITH a_Array, 1
ENDIF

a_Temp="A_"+ LTRIM(STR(INT(RAND(-1) * 1000000), 6))

* Create a temporary array to copy the information to.
DECLARE &a_Temp[m_Cols, m_Rows]

xCurCol = 1
DO WHILE xCurCol <= m_Cols
xCurRow = 1
DO WHILE xCurRow <= m_Rows
&a_Temp[xCurCol, xCurRow] = &a_Array[xCurRow, xCurCol]
xCurRow = xCurRow + 1
ENDDO
xCurCol = xCurCol + 1
ENDDO

DO ACOPY WITH a_Temp, a_Array
RELEASE a_Temp
RETURN
EOP: AFlip.PRG


14 E T C

E T C

Appending Only Unique Records

How do you figure out whether or not new records appended to your master
database and other tidbits.

The need sometimes arises for the capability of appending records from another
database but only those records that don't already exist in the database they
are appending to. If you can establish some criteria for determining what
unique means, you can create an index on that expression in the database to be
appended and use the following technique:

USE Destiny IN 1
USE Destiny IN 2 ORDER UniKey AGAIN
APPEND FROM Source FOR .NOT. SEEK(UniKey, 2)

UniKey would be the expression that is used to determine uniqueness. For
example, you only want records that don't have the same first and last names
already in the current database:

USE Destiny
INDEX ON Firstname + Lastname TAG Firstlast
USE Destiny AGAIN IN 2 ORDER Firstlast
APPEND FROM Source FOR .NOT. SEEK(Firstname + Lastname, 2)

Buddy, Can You Spare a Quarterly Report?

Quarterly reports are a fact of life. If you're in need of generating reports
that encompass data from the last three months, here's an efficient way to
group a report.

First, index on the date field involved and then use the following as your
group expression:

INT((MONTH(Datefield) - 1) / 3)

Where in the Manual?

So where do you go to find information on the pagination characteristics of
laser printer drivers? It's the elusive Appendix F at the end of Language
Reference. By noting the superscripted numbers that reference footnotes at
the bottom of page F-4, you should be able to capably track down the printer
driver for you.

Pagination adjustment is not a requirement of dBASE IV. It is a requirement
for the printer and is found in the appendices of most laser printer manuals
that we've ever come across.

Keep in mind that the requirement for using 60 lines is not for all laser
printers. It is for those laser printers which have a default top and bottom
margin of 1/2" each. Most laser printers which use a Canon engine have this
default, most notably, Hewlett-Packard. Thus, the laser printers give ten
inches of printable space on a page, instead of eleven. At the usual six
lines per inch, this gives 60 printable lines.

Note that there is a driver which increases the number of lines printed per
inch and gives 66 lines in portrait mode and 51 lines in landscape mode.
HPLas2I.PR2 is recommended in lieu of setting the page length to 60 lines for
all occasions except the printing of labels.

Constructing a Field List

Within an application, it is sometimes preferable to give the user the
capability of constructing their own field list for copying or reporting
purposes. With the help of popups, you can give your users much more variety
in obtaining specifically the data they need.

This routine uses the STRUCTURE option of DEFINE POPUP to define a field list
from user selection. The DO WHILE loop builds a list of the fields selected
by the user. For each selection, it adds the field name followed by a comma
to the list. After the last selection, it strips the final comma and performs
a COPY FIELDS operation using the defined field list. The program also allows
the user to select the database file from a popup list.

* FldList.PRG
CLEAR
SET DBTRAP OFF
SET TALK OFF
SET ECHO OFF

* Prompt user to select a database file from a popup list.
DEFINE POPUP FilePop FROM 10,25 TO 18,60 PROMPT FILES LIKE *.DBF
ON SELECTION POPUP FilePop DEACTIVATE POPUP
ACTIVATE POPUP FilePop
USE (PROMPT())

* Prompt user to select fields from selected database.
flds = ""
DEFINE POPUP FldPop FROM 4,24 TO 17,62 PROMPT STRUCTURE ;
MESSAGE "Press when done"
ON SELECTION POPUP FldPop DEACTIVATE POPUP

DO WHILE .T.
ACTIVATE POPUP FldPop
IF "" = PROMPT()
EXIT
ENDIF
flds = flds + TRIM(PROMPT()) + ","
@ 18,0 SAY "Fields selected:"
@ 19,0 SAY flds
ENDDO

RELEASE POPUP FldPop
flds = SUBSTR(flds, 1, LEN(flds) - 1)
CLEAR
SET TALK ON
COPY FIELDS &flds TO NewFile

A BROWSE or DISPLAY command could be used in place of a COPY in the last line
of the above code.

Logic Block

Recently, we heard from a user who was running multiple queries on a
database. Among the multiple queries, he was doing simple filtering using a
condition box with expressions such as:

STATE = "CA" .OR. STATE = "NV"

No matter what he did, this expression or any other expression in a condition
box using the .OR. operator would return the error message "Syntax Error".
The query would work fine by placing "CA" and "NV" in different lines under
the STATE field in the file skeleton, or using .AND. in the condition box, but
not if the .OR. operator was used.

Checking the environment, rebuilding the database from scratch, and using file
recovery utilities, were all to no avail. After testing the procedure, it was
finally discovered that one of the field names was "OR".

A conflict in logic within dBASE IV occurs when utilizing fields that are
reserved words in situations like this. Fields with names such as "T", "F",
"Y", "N", "AND", or "OR" should be avoided.