home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware 1 2 the Maxx
/
sw_1.zip
/
sw_1
/
DBASE
/
VPI1_303.ZIP
/
MENUSAVE.PRG
< prev
next >
Wrap
Text File
|
1992-01-05
|
3KB
|
116 lines
***************************************************************************
** MENUSAVE.PRG
** (C) Copyright 1991-1992, Sub Rosa Publishing Inc.
**
** A demonstration program provided to Info users.
** This program may be copied freely. If it is used in commercial code,
** please credit the source, Sub Rosa Publishing Inc.
**
** MENUSAVE posts a menu on the screen, but takes a default action
** if the user makes no choice after four seconds. The default acttion
** presents a message in random colors at random postions on the screen -
** which would prevent burn-in of the memu if it had been left on the
** for a long time.
**
** The other choices include a variety of sounds and effects
** available to the info programmer.
**
** Note that menu selection can be made by selection of a trigger
** letter e.g. X for exit, T for Tear, etc.
**
** Sid Bursten and Bernie Melman
***************************************************************************
mcolor=:color
ok=rand(val(time(3))) ; choose a starting random number based on the time
SET sound on
ON escape
SCREEN 1
SET color to mcolor
WINDOW
CURSOR 23,0
SET sound off
CANCEL
ENDON
IF :color <> 7
SET color to 31; white on blue
ENDIF
SET WIDTH to 80
COLOR :color,0,0,24,79,177 ;fill screen with pattern
* 177 is the fill character ▒.
COLOR 112,7,20,21,66 ;draw black box to become shadow
WINDOW 6,18,19,62 DOUBLE COLOR :color ;declare space for menu text
DO WHILE t ;put main menu in an infinite loop
:color=mcolor
WINDOW
ERASE ;fills window with blanks
COLOR :color,0,0,24,79,177 ;fill screen with pattern
* 177 is the fill character ▒.
COLOR 112,7,20,21,66 ;draw black box to become shadow
WINDOW 6,18,19,62 DOUBLE COLOR :color ;declare space for menu text
TEXT
DEMO MAIN MENU
Choose by number or one of "XRTSMC"
0. eXit to Sample Programs Menu
1. sound Tear
2. sound Ring
3. screen Swap
4. return to Main demonstration menu
5. exit to Conversation VP-Info
ENDTEXT
CURSOR 12,25 ; positions menu cursor over 1st character of 1st choice
*
* five choices,menu bar width 37,timeout after 4 seconds
CHOICE=menu("XTRSMC",37,4)
DO CASE
CASE choice=0
SET sound off
CHAIN samples
CASE choice=1
SOUND 5
CASE choice=2
SOUND 7
CASE choice=3
SCREEN 1,2
CLS
SCREEN t
CASE choice=5
SET sound off
WINDOW
ERASE
CANCEL
CASE choice=65 ; timeout
WINDOW
ERASE
PERFORM scrnsave
ENDCASE
ENDDO
PROCEDURE scrnsave
DO WHILE t
IF ifkey()
dummy=inkey()
BREAK
ENDIF
* SOUND 3
row=(rand()*22)+1 ; range is 1-22
col=(rand()*65)+1 ; range is 1-65
IF :color<>7
flag=t
DO WHILE flag
:color=rand()*127+1 ;yields a color between 1 and 128
IF :color<>7
flag=f
ENDIF
ENDDO
ENDIF
WINDOW row,col,row+1,col+13
@ row,col say cen('VP-Info',14)
@ row+1,col say cen('Screen Saver',14)
SCREEN 1
* SOUND 8
DELAY .3 ;wait long enough to see something
ENDDO
ENDPROCEDURE ; scrnsave
*** end of MENUSAVE.PRG