home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
World of Shareware - Software Farm 2
/
wosw_2.zip
/
wosw_2
/
DATABASE
/
INSTAPOP.ZIP
/
SURVPROC.PRG
< prev
Wrap
Text File
|
1991-02-19
|
8KB
|
192 lines
* SurvProc.prg
*
* procedure libaray for survey program
*
* 02/17/91
*
*
* Contents
* --------
* GoPopup () main popup activation function
* DefPops popup definitions
* KilPops erase popups from memory
*
****************************************
* GoPopup ()
* ----------
*
* Activates appropriate popup based on current field in READ.
*
* The WHEN clause of all popup-controlled fields should contain
* the gopopup () call. Using the VARREAD () function, the corresponding
* popup is ACTIVATED and then the results are "typed" via the KEYBOARD
* command.
*
function gopopup
private field_is, popped_ok, last_key
*-- Remember the last key pressed (the one that got you to this field)
last_key = lastkey ()
*-- If the key has a negative ASCII value (generated by various function
*-- keys) replace it with the ASCII value for Enter (13), unless it is -400,
*-- the value for Shift-Tab, in which case it will be replaced with 5,
*-- the up arrow. CHR () does not like negatives.
last_key = chr (iif (last_key < 0, iif (last_key = -400, 5, 13), last_key))
*-- Assign current field name to memvar (will be all upper case)
field_is = varread ()
*-- Assume that a popup will be activated
popped_ok = .t.
*-- This CASE structure determines which popup is activated
do case
case field_is = "Q1"
activate popup popq1
case field_is = "Q2"
activate popup popq2
case field_is = "Q3"
activate popup popq3
case field_is = "Q4"
activate popup popq4
case field_is = "Q5"
activate popup popq5
case field_is = "Q6"
activate popup popq6
otherwise
*-- If the field is not one which has a popup defined, do nothing
*-- and indicate that a popup was not activated
popped_ok = .f.
endcase
*-- If a popup was activated, then
if popped_ok
*-- Get the response number (the first non-blank character on the left)
resp_num = left (ltrim (prompt ()), 1)
do case
*-- If the response was not blank (by pressing Esc, for example)
*-- and the response was not not number 0 (to skip)
case "" # resp_num .and. resp_num # "0"
*-- "Type" the response
keyboard resp_num
*-- If the left or right arrow was pressed to exit the popup
case lastkey () = 19 .or. lastkey () = 4 && 19 = left arrow, 4 = right arrow
*-- Go to the previous or next field
keyboard chr (iif (lastkey () = 19, 5, 24)) && 5 = up arrow, 24 = down arrow
otherwise
*-- otherwise, if the key pressed to get to the field in the first
*-- place was an alphabetic key (ASCII value >= 32)
*-- just "type" an Enter (ASCII 13) to move to next field
*-- otherwise, "type" that key again. This will allow you to move
*-- backwards through the fields by pressing Esc at the popup
keyboard iif (asc (last_key) >= 32, chr (13), last_key)
endcase
endif
*-- Must return TRUE for field to be edited, and KEYBOARDed response to be recognized
return .t.
****************************************
* DefPops
* -------
*
* DEFINEs all of the POPUPs that are used in the survey program.
*
* To be called before READ/EDIT/APPEND.
*
* All popups have the question at the top, and a choice number 0 to skip
* the question.
*
* All popups are set to DEACTIVATE upON SELECTION, so that control will
* be returned to the calling function/procedure.
*
procedure defpops
private pop_messg
*-- Define message that will be used for all the popups
pop_messg = "Select: " + chr (17) + chr (196) + chr (217) + " Skip: Esc" + ;
" Previous: " + chr (27) + " Next: " + chr (26)
*-- Define popup for Q1
define popup popq1 from 7, 9 message pop_messg
define bar 1 of popq1 prompt " My idea of a great date is" skip
define bar 2 of popq1 prompt "────────────────────────────" skip
define bar 3 of popq1 prompt " 1 - Dinner in Paris"
define bar 4 of popq1 prompt " 2 - Breakfast in Monaco"
define bar 5 of popq1 prompt " 3 - Lunch at McDonald's"
define bar 6 of popq1 prompt " ─────" skip
define bar 7 of popq1 prompt " 0 - Skip this question"
on selection popup popq1 deactivate popup
*-- Define popup for Q2
define popup popq2 from 9, 9 message pop_messg
define bar 1 of popq2 prompt " My best asset is my" skip
define bar 2 of popq2 prompt "──────────────────────────────────────────────────────" skip
define bar 3 of popq2 prompt " 1 - Quick, open, and inquisitive mind"
define bar 4 of popq2 prompt " 2 - Commanding physical presence"
define bar 5 of popq2 prompt " 3 - Wisdom and maturity"
define bar 6 of popq2 prompt " 4 - Sensitivity and undying devotion"
define bar 7 of popq2 prompt " 5 - Modesty and humility"
define bar 8 of popq2 prompt " 6 - Ability to leap tall buildings in a single bound"
define bar 9 of popq2 prompt " 7 - All of the above"
define bar 10 of popq2 prompt " ─────" skip
define bar 11 of popq2 prompt " 0 - Skip this question"
on selection popup popq2 deactivate popup
*-- Define popup for Q3
define popup popq3 from 11, 9 message pop_messg
define bar 1 of popq3 prompt " The first thing I look" skip
define bar 2 of popq3 prompt " for in a man is" skip
define bar 3 of popq3 prompt "────────────────────────" skip
define bar 4 of popq3 prompt " 1 - Nice hair"
define bar 5 of popq3 prompt " 2 - A big wallet"
define bar 6 of popq3 prompt " 3 - Long fingers"
define bar 7 of popq3 prompt " 4 - A pulse"
define bar 8 of popq3 prompt " ─────" skip
define bar 9 of popq3 prompt " 0 - Skip this question"
on selection popup popq3 deactivate popup
*-- Define popup for Q4
define popup popq4 from 7,28 message pop_messg
define bar 1 of popq4 prompt " I try to avoid men who" skip
define bar 2 of popq4 prompt "───────────────────────────────────" skip
define bar 3 of popq4 prompt " 1 - are named Wendell"
define bar 4 of popq4 prompt " 2 - part their hair in the middle"
define bar 5 of popq4 prompt " 3 - have long fingers"
define bar 6 of popq4 prompt " 4 - bowl regularly"
define bar 7 of popq4 prompt " 5 - eat sushi"
define bar 8 of popq4 prompt " ─────" skip
define bar 9 of popq4 prompt " 0 - Skip this question"
on selection popup popq4 deactivate popup
*-- Define popup for Q5
define popup popq5 from 9,28 message pop_messg
define bar 1 of popq5 prompt " My favorite color is" skip
define bar 2 of popq5 prompt "────────────────────────" skip
define bar 3 of popq5 prompt " 1 - Vermilion"
define bar 4 of popq5 prompt " 2 - Tangerine"
define bar 5 of popq5 prompt " 3 - Goldenrod"
define bar 6 of popq5 prompt " 4 - Chartreuse"
define bar 7 of popq5 prompt " 5 - Cobalt"
define bar 8 of popq5 prompt " 6 - Heliotrope"
define bar 9 of popq5 prompt " 7 - Brown"
define bar 10 of popq5 prompt " ─────" skip
define bar 11 of popq5 prompt " 0 - Skip this question"
on selection popup popq5 deactivate popup
*-- Define popup for Q6
define popup popq6 from 11,28 message pop_messg
define bar 1 of popq6 prompt " My favorite ice cream is" skip
define bar 2 of popq6 prompt "──────────────────────────" skip
define bar 3 of popq6 prompt " 1 - Strawberry"
define bar 4 of popq6 prompt " 2 - Vanilla"
define bar 5 of popq6 prompt " 3 - Chocolate"
define bar 6 of popq6 prompt " 4 - Neopolitan"
define bar 7 of popq6 prompt " ─────" skip
define bar 8 of popq6 prompt " 0 - Skip this question"
on selection popup popq6 deactivate popup
return
****************************************
* KilPops
* -------
*
* Releases popups from memory (not patricide).
*
*
procedure kilpops
release popup popq1, popq2, popq3, popq4, popq5, popq6
return