'=========================================================================== ' Subject: VARIABLE MENU SOURCE CODE Date: 11-15-97 (00:24) ' Author: Xtance Coders Alliance Code: QB, QBasic, PDS ' Origin: harryst@castel.nl Packet: MENU.ABC '=========================================================================== ' .$$$$$$$$. .$$$$$$$$. .$$$$$$$$. .$$$$$$$$$. $. .$ ' $$$$$ $$$$ss$$$$ $$$$$ s$$$$ $$$$$ $$$$$ $$$$$ $s s$ ' $$$$$ $$$$$$$$$$ $$$$$ $$$$$ $$$$$ $$$$$ $$$$$ $$.$$ ' $$$$ $$$$$$$$$$ $$$$ $$$$$ $$$$ $$$$$ $$$$$ $$s$$ ' s$$ $$$$$$$$$$ $$s $$$$$ $$s $$$$$ $$$$$ $$$$$ ' s $$$$$$$$$$ s $$$$$ s $$$$$ $$$$$ $$$$$ ' $$$$$$$$$$ $$$$$ $$$$$$$$$$$ $$$$$ ' $$$$$$$$$$ $$$$$ $$$$$ $$$$$ $$$$$ ' $$$$$$$$$$ $$$$$ $$$$$ $$$$$ $$$$$ ' $$$$$$$$$$ $$$$$ $$$$$ $$$$$ $$$$$ ' s $$$$$$$$$$ s $$$$$ s $$$$$ $$$$$ $$$$$ ' s$$ $$$$$$$$$$ $$s $$$$$ $$s $$$$$ $$$$$ $$$$$ ' $$$$ $$$$$$$$$$ $$$$ $$$$$ $$$$ $$$$$ $$$$$ S$S ' $$$$$ $$$$$$$$$$ $$$$$ $$$$$ $$$$$ $$$$$ $$$$$ . ' $$$$$$$$$$$$$$$$$$$$$$$$ $$$$$$$$$$$$ $$$$$ $$$$$ s$s ' .$$$$$$$$$$$$$$$$$$$$$$. .$$$$$$$$$$. .$$$. .$$$. $$$$$ ' ' Xtance Coders Alliance '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' This program is made by Mr. Snow from Xtance Coders Alliance and ' DeeJee'z Team 1997 ' ' for All Basic Programmers in the Big Fat World ' ' E-Mail to harryst@castel.nl ' or to mrsnow@freemail.nl ' ' ' Credit me please.. if you use any routines from my source DECLARE SUB EndMenu () DECLARE SUB MenuBuild (Choice%, Total%, ExitChoice%, ExitKey$, LineBuild%) DECLARE SUB Test4 () DECLARE SUB Test3 () DECLARE SUB WhipeScreen () DECLARE SUB Test2 () DECLARE SUB Test1 () DEFINT A-Z '$DYNAMIC DIM SHARED MenuItem$(10), MenuText$(10), MenuRow(10), MenuCol(10) DIM SHARED ForeColor, BackColor, ItemColor COLOR 7, 0 PRINT "Mr. Snow's variable menu source code.. easy to make your own menu." PRINT PRINT "(c) Copyright 1997 by Xtance Productions" PRINT "email to harryst@castel.nl" PRINT PRINT "there are 4 types of menus look at your selve and [ALT-Q] Exit" PRINT PRINT PRINT "Press [Enter] to continue...." DO: LOOP UNTIL INKEY$ = CHR$(13) COLOR 7, 0 CLS ' The key ALT-Q Don't work for now... i build it in version 2 better, also box ' scroll and some other nice routines then.. ' * Freatures ' ' use menudata file ' fade in / out ' graphical layout? ' Music? ' Input routines ' And So On CALL Test1 CALL WhipeScreen CALL Test2 CALL WhipeScreen CALL Test3 CALL WhipeScreen CALL Test4 CALL WhipeScreen CALL EndMenu REM $STATIC SUB EndMenu Text$ = "Thank you for trying my menu source code..." GOSUB SlowWrite LOCATE 3, 10 Text$ = "Now here's a final working menu... cya....." GOSUB SlowWrite Menu: MenuItem$(1) = "Read More": MenuRow(1) = 35: MenuCol(1) = 8 MenuItem$(2) = "Exit": MenuRow(2) = 35: MenuCol(2) = 9 Choice = 1 Total = 2 ForeColor = 7 BackColor = 1 ItemColor = 15 LOCATE 7, 33: PRINT "旼컴컴컴컴컴�" LOCATE 8, 33: PRINT "� �" LOCATE 9, 33: PRINT "� �" LOCATE 10, 33: PRINT "읕컴컴컴컴컴�" CALL MenuBuild(Choice, Total, ExitChoice, ExitKey$, 0) COLOR 7, 0 IF ExitChoice = 1 THEN GOSUB WriteMore GOSUB Menu ELSE CALL WhipeScreen LOCATE 1, 1: Text$ = "(c) Copyright 1997 by Mr. Snow from Xtance Productions" GOSUB SlowWrite LOCATE 3, 1: Text$ = "� E-Mail harryst@castel.nl" GOSUB SlowWrite LOCATE 4, 1: Text$ = "� E-Mail mrsnow@freemail.nl" GOSUB SlowWrite LOCATE 5, 1: Text$ = "� E-Mail xca@freemail.nl" GOSUB SlowWrite LOCATE 7, 1: Text$ = "Greets the All Basic Code Friend." GOSUB SlowWrite END END IF EXIT SUB SlowWrite: FOR z = 1 TO LEN(Text$) i = ASC(MID$(Text$, z, 1)) PRINT CHR$(i); FOR w& = 1 TO 50000: NEXT w& NEXT z RETURN WriteMore: CLS Text$ = "I'm Mr. Snow and i'm 17 jears old living in Holland (Europe)" LOCATE 1, 10: GOSUB SlowWrite Text$ = "I realy like the All Basic Code Packets and sending sources" LOCATE 3, 1: GOSUB SlowWrite Text$ = "i have send sources under the name of Eric Bruggema and" LOCATE 4, 1: GOSUB SlowWrite Text$ = "some under Harry Stok and Xtance Coders Alliance" LOCATE 5, 1: GOSUB SlowWrite Text$ = "If you like to e-mail me about some source code questions be my guest" LOCATE 7, 1: GOSUB SlowWrite Text$ = "but i'd like to see also source codes from anyone else..." LOCATE 8, 1: GOSUB SlowWrite Text$ = "so please send me some source codes.." LOCATE 9, 1: GOSUB SlowWrite Text$ = "no more to tell greets Mr. Snow (Holland)" LOCATE 15, 20: GOSUB SlowWrite Text$ = "Press [Enter] to continue to the menu." LOCATE 20, 20: GOSUB SlowWrite DO: LOOP UNTIL INKEY$ = CHR$(13) RETURN END SUB SUB MenuBuild (Choice, Total, ExitChoice, ExitKey$, LineBuild) IF Choice = 0 THEN Choice = 1 END IF IF Total < 1 THEN PRINT "Sorry, but no menu total is given.." EXIT SUB END IF GOSUB SetupNewScreen DO GOSUB BuildMenuScreen DO a$ = INKEY$ LOOP UNTIL a$ <> "" SELECT CASE a$ CASE CHR$(0) + CHR$(77), CHR$(0) + CHR$(80) Choice = Choice + 1 IF Choice > Total THEN Choice = 1 END IF CASE CHR$(0) + CHR$(75), CHR$(0) + CHR$(72) Choice = Choice - 1 IF Choice < 1 THEN Choice = Total END IF CASE CHR$(13) ExitChoice = Choice EXIT SUB CASE CHR$(27), ExitKey$ ExitChoice = Choice EXIT SUB CASE ELSE ' PRINT ASC(RIGHT$(a$, 1)) END SELECT LOOP END SetupNewScreen: IF LineBuild > 0 THEN COLOR ForeColor, BackColor LOCATE LineBuild, 1: PRINT STRING$(80, 32); END IF RETURN BuildMenuScreen: FOR z = 1 TO Total IF z <> Choice THEN COLOR ForeColor, BackColor ELSE COLOR ItemColor, BackColor END IF LOCATE MenuCol(z), MenuRow(z): PRINT MenuItem$(z) NEXT z RETURN END SUB SUB Test1 MenuItem$(1) = "File": MenuRow(1) = 4: MenuCol(1) = 1 MenuItem$(2) = "Edit": MenuRow(2) = 10: MenuCol(2) = 1 MenuItem$(3) = "View": MenuRow(3) = 16: MenuCol(3) = 1 MenuItem$(4) = "Search": MenuRow(4) = 22: MenuCol(4) = 1 MenuItem$(5) = "Run": MenuRow(5) = 30: MenuCol(5) = 1 MenuItem$(6) = "Debug": MenuRow(6) = 35: MenuCol(6) = 1 MenuItem$(7) = "Calls": MenuRow(7) = 42: MenuCol(7) = 1 MenuItem$(8) = "Options": MenuRow(8) = 49: MenuCol(8) = 1 MenuItem$(9) = "Help": MenuRow(9) = 75: MenuCol(9) = 1 Choice = 1 Total = 9 ForeColor = 7 BackColor = 1 ItemColor = 15 CALL MenuBuild(Choice, Total, ExitChoice, ExitKey$, 1) END SUB SUB Test2 MenuItem$(1) = "File": MenuRow(1) = 2: MenuCol(1) = 1 MenuItem$(2) = "Edit": MenuRow(2) = 2: MenuCol(2) = 2 MenuItem$(3) = "View": MenuRow(3) = 2: MenuCol(3) = 3 MenuItem$(4) = "Search": MenuRow(4) = 2: MenuCol(4) = 4 MenuItem$(5) = "Run": MenuRow(5) = 2: MenuCol(5) = 5 MenuItem$(6) = "Debug": MenuRow(6) = 2: MenuCol(6) = 6 MenuItem$(7) = "Calls": MenuRow(7) = 2: MenuCol(7) = 7 MenuItem$(8) = "Options": MenuRow(8) = 2: MenuCol(8) = 8 MenuItem$(9) = "Help": MenuRow(9) = 2: MenuCol(9) = 9 Choice = 1 Total = 9 ForeColor = 7 BackColor = 1 ItemColor = 15 ExitKey$ = CHR$(0) + CHR$(17) CALL MenuBuild(Choice, Total, ExitChoice, ExitKey$, 0) END SUB SUB Test3 MenuItem$(1) = "File": MenuRow(1) = 1: MenuCol(1) = 1 MenuItem$(2) = "Edit": MenuRow(2) = 9: MenuCol(2) = 2 MenuItem$(3) = "View": MenuRow(3) = 16: MenuCol(3) = 3 MenuItem$(4) = "Search": MenuRow(4) = 24: MenuCol(4) = 4 MenuItem$(5) = "Run": MenuRow(5) = 32: MenuCol(5) = 5 MenuItem$(6) = "Debug": MenuRow(6) = 40: MenuCol(6) = 6 MenuItem$(7) = "Calls": MenuRow(7) = 48: MenuCol(7) = 7 MenuItem$(8) = "Options": MenuRow(8) = 56: MenuCol(8) = 8 MenuItem$(9) = "Help": MenuRow(9) = 64: MenuCol(9) = 9 Choice = 1 Total = 9 ForeColor = 7 BackColor = 1 ItemColor = 15 ExitKey$ = CHR$(0) + CHR$(17) CALL MenuBuild(Choice, Total, ExitChoice, ExitKey$, 0) END SUB SUB Test4 MenuItem$(1) = "File": MenuRow(1) = 4: MenuCol(1) = 9 MenuItem$(2) = "Edit": MenuRow(2) = 10: MenuCol(2) = 8 MenuItem$(3) = "View": MenuRow(3) = 16: MenuCol(3) = 7 MenuItem$(4) = "Search": MenuRow(4) = 22: MenuCol(4) = 6 MenuItem$(5) = "Run": MenuRow(5) = 30: MenuCol(5) = 5 MenuItem$(6) = "Debug": MenuRow(6) = 35: MenuCol(6) = 4 MenuItem$(7) = "Calls": MenuRow(7) = 42: MenuCol(7) = 3 MenuItem$(8) = "Options": MenuRow(8) = 49: MenuCol(8) = 2 MenuItem$(9) = "Help": MenuRow(9) = 75: MenuCol(9) = 1 Choice = 1 Total = 9 ForeColor = 7 BackColor = 1 ItemColor = 15 CALL MenuBuild(Choice, Total, ExitChoice, ExitKey$, 0) END SUB SUB WhipeScreen COLOR 7, 0 FOR z = 25 TO 1 STEP -1 LOCATE z, 1: PRINT STRING$(80, 32); 'FOR w& = 1 TO 100000: NEXT w& NEXT z END SUB