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

 
Output of file : MENUS.PRG contained in archive : PDMENUS.ZIP
* Program ...: MENUS.PRG
* By ........: John Cunningham
* : Personalized Database Systems
* : (415) 644-0476
* Date ......: 05/25/87

* See MAKEMENU.PRG for additional info.

PROCEDURE paint
PRIVATE menu, smenu
wselect 0
@ 0, mhoriz0 GET menu0 && highlight first menu option
IF ISCOLOR()
set color to w/b, b/w, b
ENDIF
CLEAR GETS
STORE 1 TO menu
DO WHILE menu STORE STR(menu,1) TO smenu
@ 0, mhoriz&smenu SAY menu&smenu
STORE menu+1 TO menu
ENDDO
wselect 1
wrestore from menu0
wselect 0
RETURN

PROCEDURE menu
* uses the variables as defined by the program MAKEMENU.PRG
* needs to have the variables MENU, OPTION, and MCHOICE as its working
* variables... do not change these variables.

STORE STR(menu,1) TO smenu
STORE STR(option,1) to soption

DO WHILE .T.
@ option,0 say ''
STORE inkey() TO key
DO WHILE key=0
STORE inkey() TO key
ENDDO
DO CASE

CASE key=13 && RETURN

mchoice = menu*10+option
RETURN

CASE key=5 && UP

@ option, 0 SAY menu&smenu.&soption && clear current
STORE MOD(option-1, moptions&smenu) TO option && select next
STORE STR(option,1) TO soption && store to charform
@ option, 0 GET menu&smenu.&soption && display next
CLEAR GETS

CASE key=24 && DOWN

@ option, 0 SAY menu&smenu.&soption && clear current
STORE MOD(option+1, moptions&smenu) TO option && select next
STORE STR(option,1) TO soption && store to charform
@ option, 0 GET menu&smenu.&soption && display next
CLEAR GETS

CASE upper(chr(key))$mcodes&smenu && first character hit

@ option, 0 SAY menu&smenu.&soption && clear current
STORE MOD(at(upper(chr(key)),mcodes&smenu)-1, moptions&smenu) TO option
STORE STR(option,1) TO soption && store to charform
@ option, 0 GET menu&smenu.&soption && display next
CLEAR GETS

mchoice = menu*10+option
RETURN

CASE key=19 && LEFT

wselect 0
@ 0, mhoriz&smenu SAY menu&smenu
STORE MOD(menu-1, menus) TO menu && clear highlighted
STORE STR(menu,1) TO smenu && title bar stuff and
@ 0, mhoriz&smenu GET menu&smenu && select next bar
CLEAR GETS
wselect 1

WRESTORE FROM menu&smenu && restore disk based screen
store 0 to option
STORE STR(option,1) TO soption

CASE key=4 && RIGHT

wselect 0
@ 0, mhoriz&smenu SAY menu&smenu
STORE MOD(menu+1, menus) TO menu && clear highlighted
STORE STR(menu,1) TO smenu && title bar stuff and
@ 0, mhoriz&smenu GET menu&smenu && select next bar
CLEAR GETS
wselect 1

WRESTORE FROM menu&smenu && restore disk based screen
store 0 to option && d.b.screens all are 0
STORE STR(option,1) TO soption

* select menu by number (1 is left menu and increments to the right)
case val(chr(key))>0 .and. val(chr(key))<=menus

wselect 0
@ 0, mhoriz&smenu SAY menu&smenu
STORE val(chr(key))-1 TO menu && clear highlighted
STORE STR(menu,1) TO smenu && title bar stuff and
@ 0, mhoriz&smenu GET menu&smenu && select next bar
CLEAR GETS
wselect 1

WRESTORE FROM menu&smenu && restore disk based screen
store 0 to option && d.b.screens all are 0
STORE STR(option,1) TO soption

ENDCASE

ENDDO
RETURN




  3 Responses to “Category : Dbase (Clipper, FoxBase, etc) Languages Source Code
Archive   : PDMENUS.ZIP
Filename : MENUS.PRG
”

  1. Daniel says:
    January 27, 2013 at 3:59 pm

    Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!

  2. Joshie says:
    March 18, 2014 at 4:57 pm

    This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.

  3. DiskingRound says:
    January 14, 2015 at 10:57 pm

    But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/