Category : Dbase (Clipper, FoxBase, etc) Languages Source Code
Archive   : TN9011.ZIP
Filename : DIYPOPUP.TXT

 
Output of file : DIYPOPUP.TXT contained in archive : TN9011.ZIP
This article is reprinted from the November 1990 edition of
TechNotes/dBASE IV. Due to the limitations of this media, certain
graphic elements such as screen shots, illustrations and some tables
have been omitted. Where possible, reference to such items has been
deleted. As a result, continuity may be compromised.

TechNotes is a monthly publication from the Ashton-Tate Software
Support Center. For subscription information, call 800-545-9364.

Do-It-Yourself Popup
Martin Leon

When you're hard at work designing an application, it can be
particularly frustrating to run up against a brick wall in the way of
a concept that you need to implement that the software doesn't seem to
be able to do. One such case is that of producing a popup that
displays more than one field for the operator to choose from. Well,
like most developers, you've probably learned from experience that
when you can't do exactly what you want, you improvise!

A clear-cut example of this often-desired functionality is when you
want your user to see both the first and last name of a customer in a
database so that they can select a record to modify, delete or
otherwise process in some way. You tried simulating the effect by
using BROWSE NOEDIT NOAPPEND with a macro but you quickly come to find
that it doesn't really look like a popup. In addition, you don't have
the key handling capabilities without having to create more macros and
using ON KEY LABEL statements for every possible keystroke scenario.

And then there's the case where you want to prompt the user with a
prompt that varies from record to record depending on the result of a
calculation? For example, you want to display a list of all the
insurance policies in a database with the word Current displayed after
the paid-up accounts or Expired after those past a renew date. Or, you
want to display all records in the database but you want to make
special note of the ones that are flagged for deletion.

Since popups aren't, to date, capable of displaying multiple fields or
calculated expressions and you only have cursor control keys to work
with, developers search the syntactical vaults for viable
alternatives. The BROWSE option can display calculated fields but the
highlight can move from field to field in the BROWSE table and the
highlight only covers one field at a time. Also, it has practically no
key handling capabilities. It's difficult, at best, to program the
macros and keyboard "stuffs" necessary to incorporate the usage of
function keys to automate processing of a record.

See the Etc. section in the October 1990 edition of TechNotes/dBASE IV
for defining bars within a loop.

Well, in an attempt to heed the call, here's a set of routines that
create a pseudo popup-style picklist where you can specify nearly any
string expression as the prompt to the user and you can position it
anywhere on the screen. Beyond that, you can customize it to respond
to different keys in different ways. You can prompt the user with a
concatenated string representing as many fields as you can fit across
the screen or change the way it responds to the Enter key, or even
what keys to respond to.

For example, instead of just having it move the record pointer to the
record selected by pressing Enter, you could have it call an EDIT
routine or delete the record. You can add keyboard traps for the
function keys and have them perform a REPLACE routine. Any changes
made to the data are reflected immediately, if they affect the
information that is used to prompt the user, upon the next iteration
of the main loop. The syntax is

DO PickList WITH "", , , , ,
, ,

The picklist must be defined as being at least three lines high. The
colors are optional but you must pass a null string ("") in its
place. In that case, the colors default to the settings of COLOR OF
NORMAL and COLOR OF FIELDS. Consistently, the border defaults to a
single line when a null string parameter is passed.

Picklist.prg respects filter conditions and follows the current order
of the currently active database. The speed of execution depends
greatly on the string expression you're using as the prompt but it
should be acceptable to most. True, it's not a popup in the sense of
being able to be kept in memory and activated at will. Even so, it
will greatly expand your popup horizons as you can easily modify it to
your needs.

The procedure can be thought of as three basic components:
initialization, key handling, and prompt manipulation. The first
component sets up some memory variables, paints the box and puts the
prompts on the screen. Because of the usage of macro substitution you
can use any valid string expression as the prompt for the user, which
allows you to use calculations as part of the prompt.

The second component is the key processing segment. The CASE
statements are set to "trap" certain keys and either move the
highlight or go to the next set of records. This is where you get to
customize. For example, you could alter this section so that by
pressing the first letter of a field name, an index ordered by that
field is activated and the prompts are now displayed in the new
order. Currently it just moves the record pointer to the record that
is selected when the Enter key is pressed and exits the routine. It
responds to the PgUp, PgDn, Home, and End keys in the same manner as a
popup would.

To add a trap for another key, you would insert a CASE statement that
checks to see if the value of the variable mkey is set to the INKEY()
value for that key. You may want to reference the INKEY() function in
the Language Reference for a complete list of keys and their
respective values. For example, if you wanted to add a reference to
trap the F10 key, the CASE statement would appear as follows:

CASE mKey = -9

Trapping the letter D would need to account for the upper or lower
case alpha key:

CASE mKey = 68 .OR. mKey = 100

Included in the listing for Picklist.prg are two more complete
examples of how you would incorporate other keys into the procedure.
When the F1 key is pressed, the screen is saved, a window is defined
and activated and text is displayed inside. Then a loop waits for any
key to be pressed to deactivate the window and restore the screen to
what its state prior to the F1 key press. Since none of this activity
is specific to the record that is highlighted, the record pointer is
irrelevent and it need not be moved. When the F2 key is pressed, the
record pointer is moved to the record corresponding to the highlighted
prompt and the EDIT command is invoked in such a way that only that
record will edited. Then the record pointer is moved back to where it
was before the EDIT, the screen is restored, and it returns to the
loop, waiting for a key press.

It's very important to note that the record pointer is not necessarily
on the record that is highlighted. If you want to add a key that
affects the highlighted record, you need to move the record pointer by
use of a GO mRec[mChcnum] in your CASE statement for that key. The
array mRec[] keeps track of which record belongs with which prompt .
The memory variable mChcnum is always set to the number of the
currently highlighted record. The array mPrompt[] contains the prompt
strings for the current page of records.

Ending a CASE statement for another key trap with EXIT causes the
program to go back to the top fo the main loop which starts putting up
the prompts for the next page of records, starting with whatever the
current record number is.

The COLOR OF NORMAL and COLOR OF FIELDS have been modified so that if
you go into an EDIT screen, for example, you may not see the colors
you want. You must change these colors to what you'd prefer in your
CASE statement and then revert them back to mNormColor and mFieldColor
by including the following statements:

SET COLOR OF NORMAL TO &mNormColor
SET COLOR OF FIELDS TO &mFieldColor

The logical memory variable mGoBack is used in the key processing
section to control whether the procedure continues or is exited. If
you move the record pointer in the key processing segment by invoking
some other routine, the record pointer stays where your routine left
it and that record becomes the first one displayed upon the next
iteration of the loop. If your routine doesn't return to the
currently selected work area and you leave mGoBack = .F. the routine
will go back to the top of the main loop and try to proceed with
whatever database is in use.

For instance, let's suppose you want to see all of the accounts in a
database with a notation of whether an account is delinquent or not.
You want to see the word Delinquent next to their name if the account
is over 30 days late and an asterisk next to that if they're over 60
days late. In your main program you would do something similar to
the following:

SET PROCEDURE TO PickProc
SET TALK OFF
USE Accounts ORDER Accountno
SET FILTER TO Paid = .F.
@ 5,5 SAY "Choose customer to send delinquency notice to"
DO PickList WITH "STR(Accountno, 5)+ ' ' +Firstname + ' ' + Lastname +
" + ;
"IIF(DATE() - DueDate > 30, 'Delinquent' ,'')" + ;
"IIF(DATE() - DueDate > 60, ' *', ' ')", 6, 1, 16,
53,"","",""

The structure of this example database would be something along these
lines:

FieldName Type Width Decimal Index
ACCOUNTNO Numeric 6 0 Y
FIRSTNAME Character 15
Y
LASTNAME Character 15
Y
DUEDATE Date 8 N
PAID Logical 1 N

The result of the example would be as shown in the table below.

675675 Steve Francisco Delinquent *
845456 Lou Trotsky
734734 Gloria Manfield
956734 Saddam Hussein Delinquent *
734562 Arnold Swatzanooger
763453 Guglielmo Marconi
236734 Bobby Brando Delinquent
745785 Etta Fitzhenry

Note the usage of single quotes within the double quotes in the prompt
string-this allows a string within a string. The DO statement is
passing along a string to the procedure PickList in PickProc.prg which
gets received into the memory variable mFields. In this example we
piece together the ACCOUNTNO, FIRSTNAME, LASTNAME, and a calculated
expression into the prompt string. ACCOUNTNO is converted to a string
with the STR() function and the calculated expression uses an IIF() to
add the word Delinquent after the name if the account is over 30 days
late. A second calculated expression adds an asterisk after the word
Delinquent if the account is over 60 days late. In the procedure
PickList, the string mFields is expanded into part of a command. The
command is

mTemp = &mFields

which is expanded to

mTemp = STR(Accountno,5) +' '+ Firstname +' '+ Lastname + ;
IIF(DATE() - DueDate > 30, 'Delinquent','') + ;
IIF(DATE() - DueDate > 60,' *',' ')

The result is that the values for each of the fields and the result of
the calculated expressions are evaluated for each record and this is
what the user is prompted with. If only for the fact that you can
prompt the user with more than one field without using a BROWSE, this
procedure is worth the time it takes to type it in.

The PROMPT(), BAR() or PAD() functions will not be applicable for use
here. However, since this program physically shifts the record
pointer to the record represented by the item that is highlighted when
you press the Enter key, the use of these functions should not be
needed.

At the end of the listing for Picklist.prg is another small program
called KeyTest.prg. It will display the INKEY() number for the key
you press. To end KeyTest, just press the Escape key. It's useful
when you do not want to look through the manual for key values.

PROCEDURE Picklist
PARAMETER mFields, mTop, mLeft, mBott, mRight, mNormcolor,
mFieldcolor, mBorder

mCursor = SET("CURSOR")
mEscape = SET("ESCAPE")
mTalk = SET("TALK")

SET CURSOR OFF
SET ESCAPE OFF
SET TALK OFF

mError = .F.
DO CASE
CASE ((mBott > 21 .AND. SET("DISPLAY") #
"EGA43") ;
.OR. (mBott > 39 .AND. SET("DISPLAY") =
"EGA43")) ;
.AND. SET("STATUS") = "ON"
*--- Check for bottom limit with STATUS ON
CLEAR
@ 7,15 SAY "Cannot use this popup on or below
STATUS line"
mError = .T.
CASE ((mBott > 24 .AND. SET("DISPLAY") #
"EGA43") ;
.OR. (mBott > 42 .AND. SET("DISPLAY") =
"EGA43")) ;
.AND. SET("STATUS") = "OFF"
*--- Check for bottom limit with STATUS OFF
CLEAR
@ 7,16 SAY "Bottom coordinate beyond bottom of
screen"
mError = .T.
CASE mLeft < 0 .OR. mRight > 79
*--- Check left & right coordinates
CLEAR
@ 7,24 SAY "Invalid Column coordinate"
mError = .T.
CASE mBott - mTop < 2
*--- Check to make sure popup can display at
least one record
CLEAR
@ 7,19 SAY "Popup must be at least 3 lines
high"
mError = .T.
ENDCASE

IF mError
@ 5,5 TO 9,70 DOUBLE
@ 11, 32 SAY "Press Any Key"
mX = 0
DO WHILE mX = 0
mX = INKEY()
ENDDO
SET CURSOR &mCursor
SET ESCAPE &mEscape
SET TALK &mTalk
RETURN
ENDIF

*--- Save colors of NORMAL and FIELDS to restor when done
mFieldSet = SET("ATTRIBUTES")
mNormSet = LEFT(mFieldSet, AT(",", mFieldSet) - 1)
DO WHILE "," $ mFieldSet
mFieldSet = SUBSTR(mFieldSet, AT(",", mFieldSet) + 1)
ENDDO


*--- If provided, set to colors passed from calling program
IF LEN(mNormcolor) # 0
SET COLOR OF NORMAL TO &mNormcolor
ENDIF
IF LEN(mFieldcolor) # 0
SET COLOR OF FIELDS TO &mFieldcolor
ENDIF

mPromptW = mRight - mLeft - 1
@ mTop, mLeft CLEAR TO mBott, mRight
@ mTop, mLeft TO mBott, mRight &mBorder

IF EOF()
SKIP -1
ENDIF

*--- Save current record pointer and save record number of top
record
mTmpRec = RECNO()
GO TOP
mToprec = RECNO()
GO mTmpRec
mMaxRecs = mBott - mTop - 1
mKey = 0
mGoBack = .F.
DECLARE mPrompt[mMaxRecs], mRec[mMaxRecs]

DO WHILE .NOT. mGoBack
mChcnum = 1
mToprow = mTop + 1
mLeftcol = mLeft + 1
mRowoffset = 0
mLastcurs = 0

*--- This loop puts text into prompts
DO WHILE mRowoffset + 1 <= mMaxRecs
IF .NOT. EOF()
mTemp = &mFields && Expands
mFields into string expression
mPrompt[mChcnum] = SUBSTR(mTemp, 1,
mPromptW)

*--- If prompt doesn't fill entire
box, add spaces
IF LEN(mPrompt[mChcnum]) < mPromptW
mPrompt[mChcnum] =
mPrompt[mChcnum] + ;
SPACE(mPromptW -
LEN(mPrompt[mChcnum]))
ENDIF

mRec[mChcnum] = RECNO()
@ mToprow+mRowoffset , mLeftcol SAY
mPrompt[mChcnum]
ENDIF
mRowoffset = mRowoffset + 1
mChcnum = mChcnum + 1
SKIP

*--- If last record reached, clear rest of box
IF EOF()
DO WHILE mRowoffset + 1 <= mMaxRecs
@ mToprow+mRowoffset, mLeftcol
SAY SPACE(mPromptW)
mRowoffset = mRowoffset +1
ENDDO
EXIT
ENDIF
ENDDO

mHighchc = mChcnum - 1
IF mKey # 2 .AND. mKey # 3 && if the last key
pressed wasn't
mChcnum = 1 && or

mRowoffset = 0
ELSE
mChcnum = mHighchc
mRowoffset = mHighchc - 1
ENDIF

@ mToprow+mRowoffset , mLeftcol GET mPrompt[mChcnum]
CLEAR GETS

*---This loops traps the keys
DO WHILE .T.
mKey = INKEY()
DO CASE

CASE mKey = 5 && Up arrow

*--- If first record displayed
is first in database
* and it is already
highlighted wait for next key
IF mRec[1] = mToprec .AND.
mChcnum = 1
LOOP
ENDIF

*--- If first record is
highlighted but is not top record,
* shift prompt contents
down
IF mRec[1] # mToprec .AND.
mChcnum = 1
GO mRec[1]
mX = mHighchc
DO WHILE mX > 1
mRec[mX] =
mRec[mX - 1]
mPrompt[mX] =
mPrompt[mX - 1]
mX = mX - 1
ENDDO

*--- Get prompt for
additional record to be displayed
SKIP -1
mRec[1] = RECNO()
mTemp = &mFields
mPrompt[1] =
SUBSTR(mTemp, 1, mPromptW)
IF LEN(mPrompt[1]) <
mPromptW
mPrompt[1] =
mPrompt[1] + ;
SPACE(mPromptW
- LEN(mPrompt[1]))
ENDIF
SKIP + mMaxrecs

*--- If maximum
possible records aren't displayed
IF mHighchc < mMaxrecs
mHighchc =
mHighchc + 1
SKIP -1
mRec[mHighchc]
= RECNO()
mTemp =
&mFields

mPrompt[mHighchc] = SUBSTR(mTemp, 1, mPromptW)
IF
LEN(mPrompt[mHighchc]) < mPromptW

mPrompt[mHighchc] = mPrompt[mHighchc] + ;

SPACE(mPromptW - LEN(mPrompt[mHighchc]))
ENDIF
SKIP
ENDIF

*--- Redisplay prompts
with new contents
mX = 1
DO WHILE mX < mHighchc
+ 1
@ mToprow + mX
- 1, mLeftcol SAY mPrompt[mX]
mX = mX + 1
ENDDO
mChcnum = 2

ENDIF

mChcnum = IIF(mChcnum = 1,
mHighchc, mChcnum - 1)
mRowoffset = IIF(mChcnum = 1,
0, mChcnum - 1)
mLastone = IIF(mChcnum =
mHighchc, 1, mChcnum+1)
mThisone = mChcnum

@ mToprow+IIF(mChcnum =
mHighchc, 0, mRowoffset+1) , ;
mLeftcol SAY mPrompt[mLastone]
@ mToprow+mRowoffset ,
mLeftcol GET mPrompt[mThisone]
CLEAR GETS

CASE mKey = 24 && Dn arrow

*--- If last prompt is
highlighted and it is last record
* wait for the next key
IF EOF() .AND. mChcnum =
mHighchc
LOOP
ENDIF

*--- If not at last record and
bottom prompt is highlighted,
* shift prompt contents up
IF .NOT. EOF() .AND. mChcnum =
mHighchc
mX = 1
DO WHILE mX < mMaxrecs
mRec[mX] =
mRec[mX + 1]
mPrompt[mX] =
mPrompt[mX + 1]
mX = mX + 1
ENDDO

*--- Get prompt for
additional record to be displayed
mRec[mMaxrecs] =
RECNO()
mTemp = &mFields
mPrompt[mMaxrecs] =
SUBSTR(mTemp, 1, mPromptW)
IF
LEN(mPrompt[mMaxrecs]) < mPromptW

mPrompt[mMaxrecs] = mPrompt[mMaxrecs] + ;
SPACE(mPromptW
- LEN(mPrompt[mMaxrecs]))
ENDIF
SKIP

*--- Redisplay prompts
with new contents
mX = mMaxrecs
DO WHILE mX > 0
@ mToprow + mX
- 1, mLeftcol SAY mPrompt[mX]
mX = mX - 1
ENDDO
mChcnum = mMaxrecs - 1
ENDIF

mChcnum = IIF(mChcnum <
mHighchc, mChcnum + 1, 1)
mRowoffset = IIF(mChcnum = 1,
0, mChcnum - 1)
mLastone = IIF(mChcnum = 1,
mHighchc, mChcnum-1)
mThisone = mChcnum

@ mToprow+IIF(mChcnum = 1,
mHighchc-1, mRowoffset-1),;
mLeftcol SAY mPrompt[mLastone]
@ mToprow+mRowoffset ,
mLeftcol GET mPrompt[mThisone]
CLEAR GETS

CASE mKey = 13 && Enter key

*--- Move record pointer and
go back to calling program
GO mRec[mChcnum]
mGoback = .T.
EXIT

CASE mKey = 3 && PgDn key

*--- If last record in .DBF is
displayed but not highlighted,
* move highlight to bottom
and wait for next key

IF EOF() .AND. mChcnum #
mHighchc
@ mToprow + mChcnum -
1, mLeftcol SAY mPrompt[mChcnum]
@ mToprow + mHighchc -
1, mLeftcol GET mPrompt[mHighchc]
CLEAR GETS
mChcnum = mHighchc
LOOP
ENDIF

*--- If highlight is not on
last record that is displayed,
* move highlight to it and
wait for next key
IF mChcnum # mHighchc
@ mToprow + mChcnum -
1, mLeftcol SAY mPrompt[mChcnum]
@ mToprow + mHighchc -
1, mLeftcol GET mPrompt[mHighchc]
CLEAR GETS
mChcnum = mHighchc
LOOP
ENDIF

*--- Highlight is at bottom
record displayed but not at EOF
* Move record pointer down
to next "page" of records and
* return to paint new
prompts
IF .NOT. EOF()
GO mRec[1]
SKIP + mMaxRecs
mGoback = .F.
EXIT
ENDIF

*--- If none of the above is
true, wait for another key
LOOP

CASE mKey = 18 && PgUp key

*--- If top record displayed
is top of .DBF but it is
* not highlighted, move
highlight to it and wait for next key
IF mRec[1] = mToprec .AND.
mChcnum # 1
@ mToprow + mChcNum -
1, mLeftcol SAY mPrompt[mChcnum]
@ mToprow, mLeftcol
GET mPrompt[1]
CLEAR GETS
mChcnum = 1
LOOP
ENDIF

*--- If highlight is not on
top record displayed, move
* highlight to it and wait
for next key
IF mChcnum # 1
@ mToprow + mChcnum -
1, mLeftcol SAY mPrompt[mChcnum]
@ mToprow, mLeftcol
GET mPrompt[1]
CLEAR GETS
mChcnum = 1
LOOP
ENDIF

*--- Highlight is at top
record displayed but not at top of DBF.
* Move record pointer up
one "page" worth of records and
* return to main loop to
display new prompts
IF mRec[1] # mToprec
GO mRec[1]
SKIP - mMaxRecs
mGoback = .F.
EXIT
ENDIF

*--- If none of the above is
true, wait for next key

CASE mKey = 27 && Esc key

*--- Move record pointer to
where it was before starting this
* routine and return to
calling program
mGoback = .T.
GO mTmpRec
EXIT

CASE mKey = 26 && Home key

*--- If already at top of DBF,
wait for next key
IF mRec[1] = mTopRec
LOOP
ELSE && go
top and return to main loop to display new prompts
GO TOP
mGoback = .F.
EXIT
ENDIF

CASE mKey = 2 && End key

*--- If last record in DBF is
displayed but not highlighted,
* move highlight to it and
wait for next key
IF EOF() .AND. mChcnum #
mHighchc
@ mToprow + mChcnum -
1, mLeftcol SAY mPrompt[mChcnum]
@ mToprow + mHighchc -
1, mLeftcol GET mPrompt[mHighchc]
CLEAR GETS
mChcnum = mHighchc
LOOP
ENDIF

*--- If last record is not
displayed, go to it and
* return to main loop to
display new prompts
IF .NOT. EOF()
GO BOTTOM
SKIP - (mMaxrecs - 1)
mGoback = .F.
EXIT
ENDIF

*--- If none of the above is
true, go back and wait for next key

CASE mKey = 28 && F1 key

This case clause is just
sample code for the F1 key
DEFINE WINDOW TempWin FROM 5,4
TO 14,75
ACTIVATE WINDOW TempWin
@ 1,3 SAY "Use cursor keys to
choose. " + ;
"Press to move
record pointer"
@ 2,5 SAY "Use , ,
, and " + ;
"to see other records"
@ 3,26 SAY "Use to
abandon"
@ 5,23 SAY "Press Any Key to
Continue"
mX = 0
DO WHILE mX = 0
mX = INKEY()
ENDDO
DEACTIVATE WINDOW TempWin

CASE mKey = -1 && F2 key

* This case clause is just
sample code for the F2 key
SAVE SCREEN TO mScreen
mX = IIF(.NOT. EOF(),
RECNO(),0)
GO mRec[mChcnum]
SET CURSOR ON
EDIT NOMENU NOAPPEND NODELETE
NEXT 1
SET CURSOR OFF
RESTORE SCREEN FROM mScreen
IF mX = 0
GO BOTTOM
SKIP
LOOP
ENDIF
GO mX
ENDCASE
ENDDO
ENDDO
* Put colors back to what they were and set CURSOR, ESCAPE,
and TALK back
SET COLOR OF NORMAL TO &mNormSet
SET COLOR OF FIELDS TO &mFieldSet
SET CURSOR &mCursor
SET ESCAPE &mEscape
SET TALK &mTalk
RETURN
* End of Picklist.prg
KeyTest.prg
SET TALK OFF
SET ESCAPE OFF
CLEAR
I = 0
DO WHILE .T.
I = INKEY()
IF I # 0
IF I = 27
EXIT
ENDIF
@ 5,25 SAY STR(I, 3)
I = 0
ENDIF
ENDDO
SET TALK ON
SET ESCAPE ON
* End of KeyTest.prg



  3 Responses to “Category : Dbase (Clipper, FoxBase, etc) Languages Source Code
Archive   : TN9011.ZIP
Filename : DIYPOPUP.TXT

  1. Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!

  2. This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.

  3. But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/