home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Black Box 4
/
BlackBox.cdr
/
database
/
vpi1_303.arj
/
MEMBERS.PRG
< prev
next >
Wrap
Text File
|
1991-12-30
|
5KB
|
160 lines
***************************************************************************
** MEMBERS.PRG
** (C) Copyright 1990-1992, Sub Rosa Publishing Inc.
**
** A demonstration program provided VP-Info Level 1 users.
** This program may be copied freely. If it is used in commercial code,
** please credit the source, Sub Rosa Publishing Inc.
**
** MEMBERS is compatible with all current versions of VP-Info.
**
** This short program offers most of the functionality require for basic
** list management. Add provisions to delete records and print reports
** and you have a full-blown application.
**
** MEMBERS demonstrates the use of a "scratch" file used in tandem with
** EDIT and BROWSE. This is a simple transaction-mode approach to record
** maintenance. All 'scratch pad' work is done in the temporary file.
** The master file is only updated after confidence in the new data
** is established.
**
** Note the heavy use of the SELECT command, command redirection and field
** redirection (i.e., adding #n to a command or field name) to force
** VP-Info to work on the intended file. New Info users often go wrong
** by ending up in the wrong SELECT area, forgetting that the compiler
** assumes a SELECT area without knowing which branch of the code
** execution will follow. Therefore it is a good precaution to specify
** the SELECT area explicitly.
**
** Sid Bursten and Bernie Melman
***************************************************************************
USE#1 members index members
USE#2 membtemp
ON escape
WINDOW ;cancel any existing window
CURSOR 23,0 ;move cursor to bottom line
SET save on ;restore normal setting
CANCEL ;return to 1> prompt
ENDON
SET save on ;ensure changes are written to disk (this is default)
SET talk off ;suppress "NO FIND" messages
IF :color <> 7
SET color to 62 ; yellow on blue (for variety!?)
ENDIF
DO WHILE t ;put main menu in an infinite loop
COLOR :color,0,0,24,79,177 ;fill screen with pattern of character 177
* 177 is a shaded fill character.
WINDOW 6,16,19,64 double ;declare space for menu text
MODE = '?'
ERASE ;fills window with blanks
TEXT
MEMBERS MAIN MENU
0. Exit to Sample Programs Menu
1. Choose a starting record
2. Browse master file
3. Edit current record
4. Edit a new record
5. Exit to Conversational VP-Info
ENDTEXT
CURSOR 12,26 ;positions menu cursor over 1st character of 1st choice
SELECTION = menu(5,35) ;five choices (plus 0), bar width 35
DO CASE
CASE selection=0
CHAIN samples
CASE selection=1 ;choose starting record
SELECT 1
PERFORM start_rec
SET save off ;only allow changes in option 3
BROWSE
SET save on ;restore standard setting
CASE selection=2 ;browse master file
SELECT 1
SET save off ;only allow changes in option 3
BROWSE
SET save on ;restore standard setting
CASE selection=3 ;edit copy of current record
WINDOW
PERFORM over2
SELECT 2
EDIT
WINDOW 17,30,22,75 double
?? cen('What do you want done with these changes:',45)
? ' 1. Make changes permanent'
? ' 2. Add this as a new record to main file'
? ' 3. Discard the changes'
CURSOR 18,31
ans=menu(3,43)
DO CASE
CASE ans=1
PERFORM over1
CASE ans=2
APPEND to 1
ENDCASE
SELECT 1
CASE selection=4 ;blank record in temp file
SELECT 2
ZAP
APPEND blank
FLUSH
WINDOW
EDIT
WINDOW 20,30,22,75 double
?? cen('Add this record to the master file (Y/N)?',45)
CURSOR 21,52
IF !(chr(inkey()))='Y'
APPEND to 1
ENDIF
SELECT 1
CASE selection=5 ;exit to 1> prompt
WINDOW ;reset window to full screen
ERASE
CANCEL
ENDCASE
ENDDO
*
* *** END OF MEMBERS.PRG main program module ***
*
PROCEDURE start_rec
CLEAR gets
mkey=blank(10)
ERASE
TEXT
ENTER ESTIMATE OF LAST NAME -
up to 10 characters
LAST NAME: @mkey
ENDTEXT
READ
MKEY = !(trim(mkey)) ;get rid of trailing blanks
FIND &mkey
IF #=0 ;no find - so go to next record
GOTO :near
ENDIF
ENDPROCEDURE start_rec
*
PROCEDURE over1
REPLACE cust_no#1 with cust_no#2
REPLACE lname#1 with lname#2
REPLACE fname#1 with fname#2
REPLACE street#1 with street#2
REPLACE city#1 with city#2
REPLACE state#1 with state#2
REPLACE zip#1 with zip#2
REPLACE home_phone#1 with home_phone#2
REPLACE work_phone#1 with work_phone#2
ENDPROCEDURE; over1
PROCEDURE over2
REPLACE cust_no#2 with cust_no#1
REPLACE lname#2 with lname#1
REPLACE fname#2 with fname#1
REPLACE street#2 with street#1
REPLACE city#2 with city#1
REPLACE state#2 with state#1
REPLACE zip#2 with zip#1
REPLACE home_phone#2 with home_phone#1
REPLACE work_phone#2 with work_phone#1
ENDPROCEDURE; over2
* *** end of MEMBERS.PRG ***