* 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