home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power Programming
/
powerprogramming1994.iso
/
progtool
/
microcrn
/
issue_43.arc
/
DBMENU.ARC
/
MAKEMENU.PRG
< prev
next >
Wrap
Text File
|
1988-05-23
|
4KB
|
175 lines
*******************************************************
*** NAME: MAKEMENU.PRG
***
*** AUTHOR: BRETT FISHBURNE
***
*** PURPOSE: CREATE A PROGRAM WHICH MAKES A MENU
***
*******************************************************
PARAMETER Layout, Instruction, Menu
*** PREPARE FOR NEW PROGRAM
DELETE FILE TEMP.MNU
SET ALTERNATE TO TEMP.MNU
*** ESTABLISH ENVIRONMENT
SET TALK OFF
SET ECHO OFF
SET STATUS OFF
SET SCOREBOARD OFF
SET EXACT ON
*** PREPARE THE DATABASES
SELECT 1
USE MENUFILE
SET FILTER TO TRIM(TITLE) = TRIM(MENU)
GOTO TOP
COUNT FOR ELEMENT_TY = 2 TO MAXLETTER
MAXLETTER = CHR(MAXLETTER + 64)
GOTO TOP
SELECT 2
USE TILESETS
SELECT 1
*** GENERATE PROGRAM
SET ALTERNATE ON
*** GENERATE TITLE HEADER
? REPLICATE('*',60)
? '*** NAME: ' + Menu + '.PRG'
? '***'
? '*** AUTHOR: AUTOMATIC MENU GENERATOR (AMG)'
? '***'
? '*** PURPOSE: DRAW THE SCREEN FOR THE ' + Menu
? '***'
? REPLICATE('*',60)
?
*** GENERATE CONSTANTS
? '*** INITIALIZE CONSTANTS'
? "MAXLETTER = '" + MAXLETTER + "'"
?
*** ALLOW THE MENU TO RUN THROUGH ITERATIONS
? '*** SET UP AN INFINITE LOOP'
? 'DO WHILE .T.'
?
*** GENERATE STANDARD MENU BOX
? '*** DRAW BOX'
? 'CLEAR'
? '@ 2,0 TO 2,79 DOUBLE'
? '@ 0,0 TO 21,79 DOUBLE'
?
*** GENERATE HEADER AND FOOTER
? '*** FILL IN HEADER AND FOOTER'
? '@ 1,2 SAY "' + SYSTEM + '"'
? '@ 1,' + STR(40 - INT(LEN(TRIM(TITLE))/2),2) + ' SAY "' +;
TITLE + '"'
? '@ 1,55 SAY TIME()'
? '@ 1,71 SAY DATE()'
? '@ 22,' + STR(40 - INT(LEN(TRIM(Instruction))/2),2) + ' SAY "';
+ Instruction + '"'
?
*** DETERMINE FORMAT
SELECT 2
GOTO Layout
*** GENERATE TILE DESCRIPTORS
? '*** DRAW TILES'
i = '0'
temp2 = 1
DO WHILE temp2 # 0
temp = TILE&i
mline&i = VAL(LEFT(temp,2)) + 1
mhorz&i = VAL(SUBSTR(temp,4,2)) + 2
? '@ ' + temp
i = STR(VAL(i) + 1)
IF i = '10'
EXIT
ELSE
i = LTRIM(i)
temp2 = LEN(TRIM(TILE&I))
ENDIF
ENDDO
?
*** GENERATE OPTIONS AND TITLES FOR TILES
? '*** PUT OPTIONS AND TITLES IN TILES'
SELECT 1
DO WHILE .NOT. EOF()
temp = STR(TILE,1)
DO CASE
CASE ELEMENT_TY = 1
*** TITLE
? '@ ' + STR(mline&temp,2) + ',' + STR(mhorz&temp + ELEMENT_NO,2);
+ ' SAY "' + TRIM(ELEMENT) + '"'
? '@ ' + STR(mline&temp + 1,2) + ',' + STR(mhorz&temp;
+ ELEMENT_NO,2) + ' SAY REPLICATE("-",' + STR(ELEMENT_SI,2);
+ ')'
mline&temp = mline&temp + 2
CASE ELEMENT_TY = 2
*** OPTION
? '@ ' + STR(mline&temp,2) + ',' + STR(mhorz&temp,2);
+ ' SAY "' + CHR(64 + ELEMENT_NO) + ' -- ' + TRIM(ELEMENT);
+ '"'
mline&temp = mline&temp + 1
CASE ELEMENT_TY = 3
*** CONTINUATION
? '@ ' + STR(mline&temp,2) + ',' + STR(mhorz&temp + 5,2);
+ ' SAY "' + TRIM(ELEMENT) + '"'
mline&temp = mline&temp + 1
CASE ELEMENT_TY = 4
*** MESSAGE
? '@ ' + STR(mline&temp,2) + ',' + STR(mhorz&temp + ;
ELEMENT_NO) + ' SAY "' + TRIM(ELEMENT) + '"'
ENDCASE
SKIP
ENDDO
?
*** GENERATE OPTION HANDLER
? '*** WAIT FOR USER RESPONSE'
? 'I = 0'
? 'DO WHILE I = 0'
? ' @ 1,55 SAY TIME()'
? ' I = INKEY()'
?
? ' *** CALL USER OPTION'
? " IF (UPPER(CHR(I)) >= 'A') .AND. (UPPER(CHR(I)) <= MAXLETTER)"
IF ' ' $ MENU
NAME = RTRIM(LEFT(LEFT(MENU,AT(' ',MENU)),7))
ELSE
NAME = RTRIM(LEFT(MENU,7))
ENDIF
? " SUBPROG = '" + NAME + "' + CHR(I)"
? ' DO &SUBPROG'
? ' ELSE'
? ' I = 0'
? ' ENDIF'
? 'ENDDO'
?
? 'ENDDO'
?
? 'RETURN'
*** CLEAN UP AFTERWARDS
SET ALTERNATE OFF
SET ALTERNATE TO
CLOSE DATA
RETURN