home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power-Programmierung
/
CD1.mdf
/
magazine
/
nan_news
/
vol1
/
no3
/
menudemo.prg
< prev
next >
Wrap
Text File
|
1987-02-13
|
6KB
|
223 lines
*************************************************************
* Program.....: Menudemo
* Author......: Jason Castle
* Date........: 07/18/86
* Purpose.....: To demonstrate use of Clipper
* extensions to create pull-down menus:
*
* SET MESSAGE TO <expN>
* @ <row,col> PROMPT <expC> [MESSAGE <expC>]
* MENU TO <memvar>
* KEYBOARD
* SET KEY
* SAVE SCREEN
* RESTORE SCREEN
* @ <row,col> TO <row,col>
*
* Note........: This is a take-off on MENU.PRG provided on
* the Clipper Utilities disk. Modified slightly
* for publication 12/86. Runs under Winter '85
* or Autumn '86 versions.
*************************************************************
*
CLEAR
*
* display menu description on line 24:
SET MESSAGE TO 24
*
* single-line frame for BOX command:
single = CHR(218) + CHR(196) + CHR(191) + CHR(179) + CHR(217) +;
CHR(196) + CHR(192) + CHR(179) + CHR(32)
*
* double-line frame for BOX command:
double = CHR(201) + CHR(205) + CHR(187) + CHR(186) + CHR(188) +;
CHR(205) + CHR(200) + CHR(186) + CHR(32)
*
*
menu_id = 1 && top level menu item
item_id = 1 && pull-down menu item
*
* Rectangle to designate area available to program modules:
@ 2,0,23,79 BOX single
*
* main loop:
*
sysquit = .F.
*
DO WHILE .NOT. sysquit
DO WHILE (menu_id != 0)
SET INTENSITY ON
@ 01,00 PROMPT " File " ;
MESSAGE 'Open, Save, or Print a file; Quit system'
@ 01,06 PROMPT " Edit " ;
MESSAGE 'Copy, Paste, or Erase a selection'
@ 01,12 PROMPT " Reports " ;
MESSAGE 'Weekly, Monthly, Summary, Regions reports'
@ 01,21 PROMPT " Utilities " ;
MESSAGE 'Change date, Reindex files, etc.'
MENU TO menu_id
*
IF (menu_id != 0) && esc to exit
SAVE SCREEN
DO Sub_Menu WITH menu_id
RESTORE SCREEN
* if not esc from top menu or quit from menu 1 put
* up small menu in center of screen.
IF (item_id != 0) .AND. !(item_id = 4 .AND. menu_id = 1)
SET INTENSITY OFF
* next 8 lines are for demo purposes only:
@ 10,30,15,50 BOX double
@ 12,35 SAY 'Menu no.: ' + LTRIM(STR(menu_id))
@ 13,35 SAY 'Item no.: ' + LTRIM(STR(item_id))
@ 24,0
nput = ' '
@ 24,0 SAY 'Press any key to continue...' ;
GET nput PICTURE '!'
READ
*
DO CASE
CASE menu_id = 1
* File:
DO CASE
CASE item_id = 1
* DO Open && Put program modules
CASE item_id = 2 && into these slots
* DO Save
CASE item_id = 3
* DO Print
CASE item_id = 4
* DO Quit:
EXIT
ENDCASE
CASE menu_id = 2
* Edit:
DO CASE
CASE item_id = 1
* DO Copy
CASE item_id = 2
* DO Paste
CASE item_id = 3
* DO Erase
ENDCASE
CASE menu_id = 3
* Reports:
DO CASE
CASE item_id = 1
* DO Weekly
CASE item_id = 2
* DO Monthly
CASE item_id = 3
* DO Summary
CASE item_id = 4
* DO Regions
ENDCASE
CASE menu_id = 4
* Utilities:
DO CASE
CASE item_id = 1
* DO Date
CASE item_id = 2
* DO Reindex
CASE item_id = 3
* DO Purge
CASE item_id = 4
* DO Backup
CASE item_id = 5
* DO Space_on_disk
ENDCASE
ENDCASE
@ 2,0 CLEAR
@ 2,0,23,79 BOX single
ENDIF
* if quit from menu 1 then exit from loop
IF (item_id = 4 .AND. menu_id = 1)
EXIT
ENDIF
ENDIF
ENDDO
*
SET INTENSITY OFF
* Quit System:
halt = 'N'
@ 24,0
@ 24,0 SAY 'Are you sure you wish to quit system? [Y/N]'
@ 24,45 GET halt PICTURE '!'
READ
IF halt = 'Y'
sysquit = .T.
ELSE
menu_id = 1
LOOP
ENDIF
ENDDO
*
CLEAR
RETURN
* End-of-Program
**************************************
PROCEDURE Sub_Menu
PARAMETER menu_number
*
DO CASE
CASE menu_number = 1
* File:
@ 2,0,7,8 BOX double
@ 3,1 PROMPT ' Open '
@ 4,1 PROMPT ' Save ' && add MESSAGEs to these
@ 5,1 PROMPT ' Print ' && PROMPTs, if desired
@ 6,1 PROMPT ' Quit '
CASE menu_number = 2
* Edit:
@ 2,6,6,14 BOX double
@ 3,7 PROMPT ' Copy '
@ 4,7 PROMPT ' Paste '
@ 5,7 PROMPT ' Erase '
CASE menu_number = 3
* Reports:
@ 2,12,7,22 BOX double
@ 3,13 PROMPT ' Weekly '
@ 4,13 PROMPT ' Monthly '
@ 5,13 PROMPT ' Summary '
@ 6,13 PROMPT ' Regions '
CASE menu_number = 4
* Utilities:
@ 2,21,8,31 BOX double
@ 3,22 PROMPT ' Date '
@ 4,22 PROMPT ' Reindex '
@ 5,22 PROMPT ' Purge '
@ 6,22 PROMPT ' Backup '
@ 7,22 PROMPT ' Space '
ENDCASE
* assign to cursor keys procedures for shifting right and left:
SET KEY 19 TO Left_Arrow
SET KEY 4 TO Right_Arrow
*
MENU TO item_id
*
* release left and right arrow keys:
SET KEY 19 TO
SET KEY 4 TO
*
RETURN
*ENDPROC: Sub_Menu
**************************************
PROCEDURE Left_Arrow
PARAMETER pn, pl, rv
* esc, up arrow, return:
KEYBOARD CHR(27) + CHR(5) + CHR(13)
RETURN
*ENDPROC: Left_Arrow
**************************************
PROCEDURE Right_Arrow
PARAMETER pn, pl, rv
* esc, right arrow, return:
KEYBOARD CHR(27) + CHR(4) + CHR(13)
RETURN
*ENDPROC: Right_Arrow
**************************************
* End-of-File