Category : Dbase (Clipper, FoxBase, etc) Languages Source Code
Archive   : INSTAPOP.ZIP
Filename : 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
Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!
This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.
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/