Category : Dbase (Clipper, FoxBase, etc) Languages Source Code
Archive   : INSTAPOP.ZIP
Filename : SURVMAIN.PRG

* SurvMain.prg
*
* Main survey program
*
* 02/17/91
*

*-- Set up
*-- save SETtings
private old_talk, old_status, old_conf, old_bell, old_exact
old_talk = set ("talk")
old_stat = set ("status")
old_conf = set ("confirm")
old_bell = set ("bell")
old_exact = set ("exact")
*-- make SETtings for program
set talk off
set status off && no status bar
set confirm off && don't have to press Enter after every field
set bell off && turn off annoying bell
set exact off && don't require exact string matches
*-- procedure
set procedure to survproc
*-- databases
use survey
*-- format
set format to survform

*-- display background
clear
do backgrnd
@ 0, 0 say "Insta-Pop Demo"

*-- Show main menu popup
define popup survmain from 3, 2
define bar 1 of survmain prompt " Da Main Menu" skip
define bar 2 of survmain prompt "ÄÄÄÄÄÄÄÄÄÄÄÄÄÄ" skip
define bar 3 of survmain prompt " Add new" ;
message "Add new surveys to database"
define bar 4 of survmain prompt " Lookup old" ;
message "Lookup old surveys by ID #"
define bar 5 of survmain prompt " Reports" ;
message "Print reports and statistics"
define bar 6 of survmain prompt "ÄÄÄÄÄÄÄÄÄÄÄÄÄÄ" skip
define bar 7 of survmain prompt " Info" ;
message "Information about this program and how it was made. GOOD READING!"
define bar 8 of survmain prompt " Quit" ;
message "Pretty obvious"
on selection popup survmain do mainmenu
activate popup survmain
*-- Popup will maintain control until Quit option is selected. When
*-- that happens, close everything
release popup survmain
close format
close databases
close procedure
*-- reset SETtings
set exact &old_exact
set bell &old_bell
set confirm &old_conf
set status &old_stat
set talk &old_talk
clear

*-- and then quit. But for this test program, just return to dot prompt
return
*
*-- EOP: survmain




****************************************
* MainMenu
* --------
*
* Processes the choices made from popup survmain and takes the
* appropriate action
*
procedure mainmenu
private choice
*-- trim leading blanks and make choice lower case for string matching
choice = lower (ltrim (prompt ()))
do case
case choice = "add"
*-- define the popups
do defpops
*-- save the screen
save screen to scratch
*-- let 'er rip
append
*-- restore screen
restore screen from scratch
release screen scratch
*-- undefine the popups to keep memory clear
do kilpops
case choice = "lookup"
*-- display message "Not done"
do notdone
case choice = "reports"
*-- display message "Not done"
do noway
case choice = "info"
*-- tell the user all about this program
do info
case choice = "quit"
*-- return control to main program be deactivating the popup
deactivate popup
endcase
return


****************************************
* Backgrnd
* --------
*
* Displays a (funky) background to give screen depth
*
*
procedure backgrnd
private rw
@ 1, 0 say replicate ("Ü", 80)
@ 23, 0 say replicate ("ß", 80)
rw = 20
do while rw > 1
@ rw, 0 say replicate ("°±²", 80)
rw = rw - 3
enddo
return

****************************************
* NotDone
* -------
*
* Display message saying "Not done".
*
procedure notdone
*-- screen will be restored by procedure clearmsg
save screen to scratch
*-- print message
@ 6,20 to 9,58
@ 7,21 clear to 8,57
@ 7,22 say "Sorry, but that part of the program"
@ 8,22 say "is not done yet."
*-- wait for a key press
on key do clearmsg
return


****************************************
* NoWay
* -----
*
* Display message saying "Not done" in somewhat plainer language.
*
procedure noway
*-- screen will be restored by procedure clearmsg
save screen to scratch
@ 7,20 to 11,54 double
@ 8,21 clear to 10,53
@ 8,22 say "What are you kidding? There is"
@ 9,22 say "no way that this thing would be"
@ 10,22 say "working at this juncture."
*-- wait for a key press
on key do clearmsg
return


****************************************
* ClearMsg
* --------
*
* Clears the message by restoring the screen to its previous state.
*
* Normally, an ON KEY procedure should clear the keyboard buffer by
* using an INKEY () statement, otherwise, the ON KEY procedure would
* be called continuously. But in this case, we want to pass the key
* pressed to the popup, so we simply deactivate the ON KEY. That
* way, the message stays on screen until we press a key, and that
* key does what it supposed to do normally.
*
procedure clearmsg
*-- restore screen and release it
restore screen from scratch
release screen scratch
*-- don't wait for another key
on key
return


****************************************
* Info
* ----
*
* Describes how this Insta-Popup program was written
*
procedure info
private wait_key
*-- screen will be restored at end of procedure
save screen to scratch
*-- clear message line
@ 24, 0 clear to 24,79
*-- display a nice border
@ 2,20 to 21,79 double
@ 3,21 clear to 20,78
@ 2,47 say " Info "
*-- and print inside a borderless window
define window scratch from 3,22 to 20,77 none
activate window scratch
text
The making of the Survey program
** Featuring Insta-Pop format screens **
ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ

1. Create the Survey database file.

SURVEY.dbf has an ID field, six question fields
named Q1 - Q6, and a field for the initials of
the person who typed in the data.

It is a good idea to have a field at both the
beginning and the end of the READ/APPEND/EDIT
screen that does not have an instant popup. That
way, a person can get out of the record right away
at the beginning or go back at the end.

Press any key to continue...
endtext
wait_key = inkey (0)
text

2. Create the popup activation UDF.

Since we are using format (.fmt) files, we need a
procedure file containing our popup activation
UDF, in this case called GOPOPUP (). The procedure
file is named SURVPROC.

The function includes a CASE structure to control
which popup named POPQ1 - POPQ6 is activated, some
logic to KEYBOARD the correct response, and must
RETURN .T. so that it can be used in the screen
definition.




Press any key to continue...
endtext
wait_key = inkey (0)
text

3. Create the screen and generate a format (.fmt)
file. Put GOPOPUP () in all of the Permit edit if
clauses for each of the fields with an instant
popup. Our screen/format is named SURVFORM.

4. Edit the .fmt if necessary.

In this case, we had the questions going down in
two columns. The screen generator reads fields
across, not down, so the .fmt file had to be
edited so that the questions were in order.

You should CLOSE FORMAT and erase the .fmo file
before making any changes.


Press any key to continue...
endtext
wait_key = inkey (0)
text

5. Create a "define all the relevant popups"
procedure.

A single procedure can define all of the popups
in advance. That way, all the popups will be in
memory and should perform faster.

You may want to refer to the coordinates generated
by the screen designer to help in the placement of
the popups.

6. Create a "release all of those popups I just
defined" procedure. This is for when the program is
finished; you don't want all those unwanted popups
lying around.

Press any key to continue...
endtext
wait_key = inkey (0)
text

7. Create the main procedure. The logic of this for
a program that just APPENDs is like:

SET PROCEDURE TO
USE
SET FORMAT TO
DO
APPEND
DO
CLOSE FORMAT
CLOSE DATABASES
CLOSE PROCEDURE

This is essentially what this program, SURVMAIN,
does.

** End of Info. Press any key to return to main menu.
endtext
wait_key = inkey (0)
deactivate window scratch
release window scratch
restore screen from scratch
release screen scratch
return