Do-It-Yourself Popup
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 "<Prompt string>", <Top>, <Left>, <Bottom>, <Right>,
<Normal text color>, <Highlight color>, <Border type>
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 of 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.
* ============ Picklist.PRG
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
mTypeCheck = TYPE("mFields")+TYPE("mTop")+TYPE("mLeft")+TYPE("mBott")+ ;
TYPE("mRight")+TYPE("mNormColor")+TYPE("mFieldcolor")+TYPE("mBorder")
mError = .F.
DO CASE
&& Check data types
CASE mTypeCheck # "CNNNNCCC"
CLEAR
@ 7,17 SAY "Data type mismatch -- check all parameters"
mError = .T.
&& Check for bottom limit with STATUS ON
CASE ((mBott >21 .AND. SET("DISPLAY") # "EGA43") ;
.OR. (mBott >39 .AND. SET("DISPLAY") = "EGA43")) ;
.AND. SET("STATUS") = "ON"
CLEAR
@ 7,15 SAY "Cannot use this popup on or below STATUS line"
mError = .T.
&& Check for bottom limit with STATUS OFF
CASE ((mBott >24 .AND. SET("DISPLAY") # "EGA43") ;
.OR. (mBott >42 .AND. SET("DISPLAY") = "EGA43")) ;
.AND. SET("STATUS") = "OFF"
CLEAR
@ 7,16 SAY "Bottom coordinate beyond bottom of screen"
mError = .T.
&& Check left & right coordinates
CASE mLeft < 0 .OR. mRight > 79
CLEAR
@ 7,24 SAY "Invalid Column coordinate"
mError = .T.
&& Check to make sure popup can display at least one record
CASE mBott - mTop < 2
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 they were provided, set to colors passed on 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 determine 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 <END>
mChcnum = 1 && or <PgDn>
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 record in database
&& and it is already highlighted
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
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 + mRowoffset, mLeftcol SAY mPrompt[mChcnum]
@ mToprow + mHighchc - 1, mLeftcol GET mPrompt[mHighchc]
CLEAR GETS
mChcnum = mHighchc
mRowoffset = mChcnum - 1
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 + mRowoffset, mLeftcol SAY mPrompt[mChcnum]
@ mToprow + mHighchc - 1, mLeftcol GET mPrompt[mHighchc]
CLEAR GETS
mChcnum = mHighchc
mRowoffset = mChcnum - 1
LOOP
ENDIF
&& Highlight is at bottom record displayed but not at EOF
&& Move record pointer down to next "page" of records and
&& return to main loop
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 + mRowoffset, mLeftcol SAY mPrompt[mChcnum]
@ mToprow, mLeftcol GET mPrompt[1]
CLEAR GETS
mChcnum = 1
mRowoffset = 0
LOOP
ENDIF
&& If highlight is not on top record displayed, move
&& highlight to it and wait for next key
IF mChcnum # 1
@ mToprow + mRowoffset, mLeftcol SAY mPrompt[mChcnum]
@ mToprow, mLeftcol GET mPrompt[1]
CLEAR GETS
mChcnum = 1
mRowoffset = 0
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
LOOP
CASE mKey = 27 && Esc key
&& Move record pointer to where it was before starting this
&& routine and return to calling program
mAbandon = .T.
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 + mRowoffset, mLeftcol SAY mPrompt[mChcnum]
@ mToprow + mHighchc - 1, mLeftcol GET mPrompt[mHighchc]
CLEAR GETS
mChcnum = mHighchc
mRowoffset = mChcnum - 1
LOOP
ENDIF
&& If last record is not displayed, go to it and
&& return to main loop
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
LOOP
CASE mKey = 28 && F1 key
&& This 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 <Enter> to move record pointer"
@ 2,5 SAY "Use <PgUp>, <PgDn>, <Home>, and <End> to see other records"
@ 3,26 SAY "Use <Esc> 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 is just sample code for the F2 key
SAVE SCREEN TO mScreen
mX = RECNO()
GO mRec[mChcnum]
SET CURSOR ON
EDIT NOMENU NOAPPEND NODELETE NEXT 1
* READ is better if you already have a FORMAT set.
SET CURSOR OFF
GO mRec[mChcnum]
mTemp = &mFields && Expands mFields into string expression
mPrompt[mChcnum] = SUBSTR(mTemp, 1, mPromptW)
IF LEN(mPrompt[mChcnum]) < mPromptW
mPrompt[mChcnum] = mPrompt[mChcnum] + ;
SPACE(mPromptW - LEN(mPrompt[mChcnum]))
ENDIF
RESTORE SCREEN FROM mScreen
@ mToprow+mRowoffset, mLeftcol GET mPrompt[mChcnum]
CLEAR GETS
IF mX <= RECCOUNT()
GO mX
ELSE
GO BOTT
SKIP
ENDIF
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
DO WHILE .T.
I = INKEY(0)
IF I = 27
EXIT
ENDIF
@ 5,25 SAY STR(I, 4)
ENDDO
SET TALK ON
SET ESCAPE ON
*End of KeyTest.PRG
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 "<Prompt string>", <Top>, <Left>, <Bottom>, <Right>,
<Normal text color>, <Highlight color>, <Border type>
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 of 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.
* ============ Picklist.PRG
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
mTypeCheck = TYPE("mFields")+TYPE("mTop")+TYPE("mLeft")+TYPE("mBott")+ ;
TYPE("mRight")+TYPE("mNormColor")+TYPE("mFieldcolor")+TYPE("mBorder")
mError = .F.
DO CASE
&& Check data types
CASE mTypeCheck # "CNNNNCCC"
CLEAR
@ 7,17 SAY "Data type mismatch -- check all parameters"
mError = .T.
&& Check for bottom limit with STATUS ON
CASE ((mBott >21 .AND. SET("DISPLAY") # "EGA43") ;
.OR. (mBott >39 .AND. SET("DISPLAY") = "EGA43")) ;
.AND. SET("STATUS") = "ON"
CLEAR
@ 7,15 SAY "Cannot use this popup on or below STATUS line"
mError = .T.
&& Check for bottom limit with STATUS OFF
CASE ((mBott >24 .AND. SET("DISPLAY") # "EGA43") ;
.OR. (mBott >42 .AND. SET("DISPLAY") = "EGA43")) ;
.AND. SET("STATUS") = "OFF"
CLEAR
@ 7,16 SAY "Bottom coordinate beyond bottom of screen"
mError = .T.
&& Check left & right coordinates
CASE mLeft < 0 .OR. mRight > 79
CLEAR
@ 7,24 SAY "Invalid Column coordinate"
mError = .T.
&& Check to make sure popup can display at least one record
CASE mBott - mTop < 2
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 they were provided, set to colors passed on 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 determine 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 <END>
mChcnum = 1 && or <PgDn>
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 record in database
&& and it is already highlighted
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
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 + mRowoffset, mLeftcol SAY mPrompt[mChcnum]
@ mToprow + mHighchc - 1, mLeftcol GET mPrompt[mHighchc]
CLEAR GETS
mChcnum = mHighchc
mRowoffset = mChcnum - 1
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 + mRowoffset, mLeftcol SAY mPrompt[mChcnum]
@ mToprow + mHighchc - 1, mLeftcol GET mPrompt[mHighchc]
CLEAR GETS
mChcnum = mHighchc
mRowoffset = mChcnum - 1
LOOP
ENDIF
&& Highlight is at bottom record displayed but not at EOF
&& Move record pointer down to next "page" of records and
&& return to main loop
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 + mRowoffset, mLeftcol SAY mPrompt[mChcnum]
@ mToprow, mLeftcol GET mPrompt[1]
CLEAR GETS
mChcnum = 1
mRowoffset = 0
LOOP
ENDIF
&& If highlight is not on top record displayed, move
&& highlight to it and wait for next key
IF mChcnum # 1
@ mToprow + mRowoffset, mLeftcol SAY mPrompt[mChcnum]
@ mToprow, mLeftcol GET mPrompt[1]
CLEAR GETS
mChcnum = 1
mRowoffset = 0
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
LOOP
CASE mKey = 27 && Esc key
&& Move record pointer to where it was before starting this
&& routine and return to calling program
mAbandon = .T.
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 + mRowoffset, mLeftcol SAY mPrompt[mChcnum]
@ mToprow + mHighchc - 1, mLeftcol GET mPrompt[mHighchc]
CLEAR GETS
mChcnum = mHighchc
mRowoffset = mChcnum - 1
LOOP
ENDIF
&& If last record is not displayed, go to it and
&& return to main loop
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
LOOP
CASE mKey = 28 && F1 key
&& This 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 <Enter> to move record pointer"
@ 2,5 SAY "Use <PgUp>, <PgDn>, <Home>, and <End> to see other records"
@ 3,26 SAY "Use <Esc> 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 is just sample code for the F2 key
SAVE SCREEN TO mScreen
mX = RECNO()
GO mRec[mChcnum]
SET CURSOR ON
EDIT NOMENU NOAPPEND NODELETE NEXT 1
* READ is better if you already have a FORMAT set.
SET CURSOR OFF
GO mRec[mChcnum]
mTemp = &mFields && Expands mFields into string expression
mPrompt[mChcnum] = SUBSTR(mTemp, 1, mPromptW)
IF LEN(mPrompt[mChcnum]) < mPromptW
mPrompt[mChcnum] = mPrompt[mChcnum] + ;
SPACE(mPromptW - LEN(mPrompt[mChcnum]))
ENDIF
RESTORE SCREEN FROM mScreen
@ mToprow+mRowoffset, mLeftcol GET mPrompt[mChcnum]
CLEAR GETS
IF mX <= RECCOUNT()
GO mX
ELSE
GO BOTT
SKIP
ENDIF
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
DO WHILE .T.
I = INKEY(0)
IF I = 27
EXIT
ENDIF
@ 5,25 SAY STR(I, 4)
ENDDO
SET TALK ON
SET ESCAPE ON
*End of KeyTest.PRG
Comments
Post a Comment