'=========================================================================== ' Subject: Drop-down menu in PBCC Date: 07-01-01 ( : ) ' Author: Jerry Fielden Code: PBCC ' Origin: Packet: PBCC.ABC '=========================================================================== 'This is a simple Drop Down Menu coded with PBCC. No APIs used. 'Only 9 Drops and 9 Selections per Drop is possible with this menu. 'Public Domain 'Author: Jerry Fielden DECLARE SUB GetSelection (RRow&, SelectNr&, DropNr&, Keynumber&, _ Lcol&, Rcol&, CCol&) DECLARE SUB fillscreen() DECLARE SUB GetKey (Keynumber&, char$, Rgt&, Lft&, RRow&, CCol&) DECLARE SUB DropDownMenu(MenuCode&) DECLARE SUB Exits() DECLARE SUB MenuBar() DECLARE SUB Drop(Dropnr&, nos&) SUB DropDownMenu(MenuCode&) DIM DropName$(10) : DIM Select1$(10): DIM select3$(10):DIM Select5$(10) DIM Select4$(10):DIM Select5$(10):DIM Select6$(10):DIM Select7$(10) DIM select2$(10) GOSUB LoadArray PCOPY 1, 3 ' Copy the original screen MenuBar ' Put top menu bar on screen. PCOPY 1, 4 LOCATE 2, 3 : COLOR 15, 5 DropNr&=1 : PRINT DropName$(DropNr&) DO IF GoDownArrow& THEN:GoDownArrow&=0:KeyNumber&=20480:GOTO HopGetKey GetKey Keynumber&, Char$, Rgt&, Lft&, RRow&, CCol& HopGetKey: IF Rgt& THEN Keynumber& = 27 'Right Mouse Button IF Lft& THEN 'Left Mouse Button IF RRow& = 2 THEN 'If On the Menu Bar. GoAgain: 'Another chance to click on Drop name PCOPY 4, 1 SelectNr& = 0 : DropNr& = 0 IF CCol& > 2 AND CCol& < 9 THEN 'checking for boundries Lcol& = 2 : Rcol& = 18 'Left and right Boundries DropNr& = 1 : Drop 1, 3 'print drop1 to screen GetSelection RRow&, SelectNr&, DropNr&, Keynumber&, _ Lcol&, Rcol&, CCol& ELSEIF CCol& > 12 AND CCol& < 22 THEN Lcol& = 13 : Rcol& = 34 DropNr& = 2 : Drop 2, 4 GetSelection RRow&, SelectNr&, DropNr&, Keynumber&, _ Lcol&, Rcol&, CCol& ELSEIF CCol& > 22 AND CCol& < 33 THEN Lcol& = 22 : Rcol& = 41 DropNr& = 3 : Drop 3, 6 GetSelection RRow&, SelectNr&, DropNr&, Keynumber&, _ Lcol&, Rcol&, CCol& ELSEIF CCol& > 32 AND CCol& < 43 THEN ' Need to add more Lcol& = 32 : Rcol& = 58 ' of these if Drops DropNr& = 4 : Drop 4, 5 ' are added. GetSelection RRow&, SelectNr&, DropNr&, Keynumber&, _ Lcol&, Rcol&, CCol& END IF IF RRow& = 2 AND DropNr& THEN GOTO GoAgain 'Drop was selected END IF 'instead of selection END IF IF Keynumber& = 50 THEN ' Selected out of boundries was detected Keynumber& = 0 ITERATE LOOP ' Go try it again END IF SELECT CASE Keynumber& CASE 19712 ' R I G H T A R R O W IF DropNr& < 4 THEN '<--Change this to your number of drops INCR DropNr& ' To be used with Column Calculations PCOPY 4, 1 ' Wipe previous drop and put new Drop LOCATE 2, DropNr&*10-7 'Calc location of column & Locate COLOR 15, 5 PRINT DropName$(DropNr&) 'Print Drop Name on MenuBar END IF SelectNr& = 0 IF xfz& > 0 THEN GoDownArrow& = 1 'Setup to prevent cross level GOTO ITERATE LOOP END IF CASE 19200 ' L E F T A R R O W IF DropNr& > 1 THEN DECR DropNr& PCOPY 4, 1 LOCATE 2, DropNr& * 10 - 7 COLOR 15, 5 PRINT DropName$(DropNr&) 'Shows drop name using keys END IF SelectNr& = 0 IF xfz& > 0 THEN GoDownArrow& = 1 ITERATE LOOP END IF CASE 20480 ' DOWN ARROW downx: IF DropNr& = 1 AND SelectNr& < 3 THEN IF SelectNr&=0 THEN 'Let it scroll the first time drop 1, 3 : PCOPY 1, 5 'and PCopy, to be used with rest. ELSEIF SelectNr& > 0 THEN PCOPY 5, 1 END IF INCR SelectNr& 'Increase nr to go to new line LOCATE SelectNr&*2+2, 3 'Locate it on the correct row COLOR 15, 4 PRINT Select1$(SelectNr&) ELSEIF DropNr& = 2 AND SelectNr& < 4 THEN IF SelectNr&=0 THEN ' |_________________________ drop 2, 4 : PCOPY 1, 5 ' | These numbers must equal ELSEIF SelectNr& > 0 THEN ' | the number of selections PCOPY 5, 1 ' | for these Drops END IF ' |_________________________ INCR SelectNr& LOCATE SelectNr&*2+2, 13 COLOR 15, 4 PRINT Select2$(SelectNr&) ELSEIF DropNr& = 3 AND SelectNr& < 6 THEN IF SelectNr&=0 THEN ' drop 3, 6 : PCOPY 1, 5 '---------------------------- ELSEIF SelectNr& > 0 THEN ' If new Drops are added to PCOPY 5, 1 ' this Menu then new ELSEIF END IF ' blocks like these are needed. INCR SelectNr& ' One of the numbers need to LOCATE SelectNr&*2+2, 23 ' be changed and a new Drop# COLOR 15, 4 ' will need to be created. PRINT Select3$(SelectNr&) '----------------------------- ELSEIF DropNr& = 4 AND SelectNr& < 5 THEN IF SelectNr&=0 THEN ' Do a slow drop down from MenuBar drop 4, 5 : PCOPY 1, 5 ' Copy to page to use later ELSEIF SelectNr& > 0 THEN ' if selection after #1 PCOPY 5, 1 ' Display fast drop END IF COLOR 15, 4 INCR SelectNr& ' Increase for Row Calculation LOCATE SelectNr&*2+2, 33 ' Calculate Row and Locate PRINT Select4$(SelectNr&) ' Print selection name on new Row END IF xfz& = SelectNr& 'store for use with left & right Arrows CASE 18432 ' U P A R R O W IF SelectNr& = 0 THEN PCOPY 4, 1 : ITERATE LOOP IF DropNr& = 1 THEN ' Doing Drop 1 here DECR SelectNr& 'To be used for Row Calculations PCOPY 5, 1 'Cover last Selection name COLOR 15, 4 LOCATE SelectNr&*2+2, 3 'Calculate row and Locate PRINT Select1$(SelectNr&) 'Print Selection at new row ELSEIF DropNr& = 2 THEN 'If you Add a new Drop DECR SelectNr& 'you would also need to PCOPY 5, 1 'add one of these COLOR 15, 4 'ELSEIF blocks and insert LOCATE SelectNr&*2+2, 13 'it at the bottom. You PRINT Select2$(SelectNr&) 'will also need to correct 'some of the numbers. ELSEIF DropNr& = 3 THEN 'Doing Drop 3 here DECR SelectNr& PCOPY 5, 1 COLOR 15, 4 LOCATE SelectNr&*2+2, 23 PRINT Select3$(SelectNr&) ELSEIF DropNr& = 4 THEN 'Doing Drop 4 here DECR SelectNr& PCOPY 5, 1 COLOR 15, 4 LOCATE SelectNr&*2+2, 33 PRINT Select4$(SelectNr&) END IF IF SelectNr& = 0 THEN PCOPY 4, 1 : LOCATE 2, DropNr& * 10 - 7 COLOR 15, 5 :PRINT DropName$(DropNr&) END IF xfz& = SelectNr& - 1 CASE 27 MenuCode& = 0 EXIT SUB ' Exit menu CASE 13 DR$ = STR$(DropNr&) : SN$ = STR$(SelectNr&) 'Make into String Number$ = RTRIM$(DR$) + LTRIM$(SN$) 'To combine MenuCode& = VAL(Number$) 'And change to number IF MenuCode& = 13 THEN ' See if Exit was selected Exits ' Call the exit routine GetKey Keynumber&, char$, Rgt&, Lft&, RRow&, CCol& IF char$ = "y" OR char$ = "Y" THEN EXIT SUB ELSEIF CCol& > 5 AND CCol& < 11 THEN 'See if mouse is on yes EXIT SUB 'If he is exit sub ELSE MenuCode& = 0 : EXIT SUB END IF END IF EXIT SUB CASE ELSE END SELECT LOOP LoadArray: ' Names on the Menu Bar DropName$(1) = " File " DropName$(2) = " Screen " DropName$(3) = " Area " DropName$(4) = " Misc " DropName$(5) = " Help " Select1$(1) = " Open Alt-0 " ' Names on the first Drop Select1$(2) = " Save Alt-S " Select1$(3) = " Exit Alt-X " Select2$(1) = " Clear Screen Alt-C " ' 2nd Drop Select2$(2) = " Save Screen Alt-A " Select2$(3) = " Text Color Alt-T " Select2$(4) = " BG Color Alt-G " Select3$(1) = " Clear Area F2 " ' 3rd Drop Select3$(2) = " Color Area F5 " Select3$(3) = " Flip Down F6 " Select3$(4) = " Flip Side F7 " Select3$(5) = " Copy Area F9 " Select3$(6) = " Paste Area F10 " Select4$(1) = " Margin & Wordwrap Alt-R " ' 4th Drop Select4$(2) = " Set Margin Alt-M " Select4$(3) = " Set Wordwrap Alt-W " Select4$(4) = " Shell to Dos Alt-H " Select4$(5) = " Extended ASCII Alt-E " RETURN END SUB SUB MenuBar() PCOPY 1, 2 : PAGE 2, 1 'The top Menu bar can easily be 'changed by Typing over the Drop names COLOR 1, 9 : LOCATE 1, 1 PRINT STRING$(80, 220); COLOR 15, 4 'If you don't like red stripe, change to 15,1 PRINT " File Screen Area Misc "; COLOR 1, 0 PRINT STRING$(80, 223); ' bottom black shadow PCOPY 2,1 : PAGE 1, 1 END SUB '----------------------------------------------------------------------- 'Insert new drops by adding more DATA SUB Drop(Dropnr&, nos&) PCOPY 1, 2 : PAGE 2, 1 dRow& = 2 dNx$ = READ$(Dropnr&): nx&=VAL(dNx$) FOR x& = 1 TO nos& IF x& = 1 THEN 'do number of selections on drop dWide$=READ$(nx&) 'Read drop width from DATA INCR nx&: dCol$=READ$(nx&) 'Read starting column from DATA END IF INCR nx&: dSelection$=READ$(nx&) 'Get selection label from DATA INCR nx& : dFuncKey$ = READ$(nx&) 'Get function key label dRow& = dRow& + 2 'setup row for selections LOCATE dRow&, VAL(dCol$):COLOR 0, 1: PRINT CHR$(177); 'Lft Side shadow COLOR 15, 1:PRINT dSelection$;:COLOR 12,1:PRINT dFuncKey$; 'print labels COLOR 0, 1: PRINT CHR$(177):LOCATE dRow&+1, VAL(dCol$) 'Rgt side shadow COLOR 0, 1:PCOPY 2, 1 : PAGE 1, 1:SLEEP 40:PAGE 2, 1 'put in pause PRINT CHR$(177) + STRING$(VAL(dWide$), 32) + CHR$(177) 'put in spaces IF x& = 5 THEN EXIT FOR 'If last selection exit PCOPY 2, 1 : PAGE 1, 1:SLEEP 40:PAGE 2, 1 'Another delay dRow$ ="": dSelection$ = "" : dFuncKey$ = "" NEXT x& LOCATE dRow&+2, VAL(dCol$) 'Bottom shadow PRINT CHR$(177) + STRING$(VAL(dWide$), 220) + CHR$(177) PCOPY 2, 1 : PAGE 1, 1 : EXIT SUB 'display drop DATA "5", "13", "23", "37" 'start READ nr for each drop DATA "16", "2", " Open ", "Alt-O "," Save ","Alt-S " 'Drop 1 DATA " Exit ","Alt-X " '1st nr is drop width & 2nd nr is start col. DATA "21","12", " Clear Screen ","Alt-C "," Save Screen ", "Alt-R " DATA " Text Color ","Alt-T "," BG COLOR ","Alt-G " 'Drop 2 DATA "19", "22" DATA " Clear Area ", " F2 ", " Color Area ", " F5 " 'Drop 3 DATA " Flip Down ", " F6 ", " Flip Side ", " F7 " DATA " Copy Area ", " F9 ", " Paste Area ", " F10" DATA "26", "32", " Margin & Wordwrap ", "Alt-P " 'Drop 4 DATA " SET Margin ", "Alt-M ", " Set Wordwrap ", "Alt-W " DATA " Dos Shell ", "Alt-H ", " Extended ASCII ", "Alt-E " END SUB SUB GetKey (Keynumber&, char$, Rgt&, Lft&, RRow&, CCol&) MOUSE ON char$ = "": Keynumber& = 0 : RRow& = 0 Rgt& = 0 : Lft& = 0 : CCol& = 0 char$ = WAITKEY$ IF ASC(char$, 4) = 1 THEN Lft& = 1 'Get left mouse button IF ASC(char$, 4) = 2 THEN Rgt& = 2 'Get right mouse Button RRow& = MOUSEY : CCol& = MOUSEX 'Get mouse cursor location IF Rgt& OR Lft& THEN MOUSE OFF : EXIT SUB Keynumber& = CVI(char$ + CHR$(0)) MOUSE OFF END SUB SUB GetSelection (RRow&, SelectNr&,DropNr&, Keynumber&, Lcol&, Rcol&, CCol&) GetKey Keynumber&, char$, Rgt&, Lft&, RRow&, CCol& IF CCol& > Lcol& AND CCol& < Rcol& AND RRow& > 3 THEN 'Set boundries IF RRow& = 4 THEN SelectNr& = 1 : Keynumber& = 13 ' Gets selection number ELSEIF RRow& = 6 THEN SelectNr& = 2 : Keynumber& = 13 'If a Drop has more than 6 ELSEIF RRow& = 8 THEN 'selections, you'll need to SelectNr& = 3 : Keynumber& = 13 'add more ELSEIFs to the bottom. ELSEIF RRow& = 10 THEN IF DropNr& = 1 THEN 'Drop 1 is the only drop that PCOPY 4, 1 'has less than 4 selections, it Keynumber& = 50 : EXIT SUB 'would exit here END IF 'The rest would get their select SelectNr& = 4: Keynumber& = 13 'numbers and traveling orders ELSEIF RRow& = 12 THEN IF DropNr& = 1 OR DropNr& = 2 THEN 'Both drop1 and drop2 here PCOPY 4, 1 Keynumber& = 50 :EXIT SUB ' Keynumber&=50 is a flag to let END IF ' the calling routine know a SelectNr& = 5: Keynumber& = 13 ' selection wasn't made. ELSEIF RRow& = 14 THEN IF DropNr&=1 OR DropNr&=2 OR DropNr&=4 THEN '3 of the 4 drops here. PCOPY 4, 1 'Because all drops bottom boundries Keynumber& = 50 : EXIT SUB 'may be different, it exits on the END IF 'ones that doesn't work. SelectNr& = 6: Keynumber& = 13 'Drop 3 is the only one that can ELSE 'receive these numbers. PCOPY 4, 1 Keynumber& = 50 'flag for out of bounds selections END IF ELSE Keynumber& = 50 : PCOPY 4, 1 END IF END SUB 'Fill the Screen with charecters SUB fillscreen() PCOPY 1, 2 :PAGE 2, 1 COLOR 1, 11 PRINT STRING$(2000, 176); SLEEP 500 COLOR 14, 1 : LOCATE 10, 32 'make a box LOCATE 11, 32 :PRINT CHR$(201) + STRING$(14, 205) + CHR$(187) LOCATE 12, 32:PRINT CHR$(186) + " PBCC Drop " + CHR$(186) LOCATE 13, 32:PRINT CHR$(186) + " Down MENU " + CHR$(186) COLOR 15, 4 LOCATE 14, 32:PRINT CHR$(186) + " Click Right " + CHR$(186) LOCATE 15, 32:PRINT CHR$(186) + " Mouse Button " + CHR$(186) LOCATE 16, 32 :PRINT CHR$(200) + STRING$(14, 205) + CHR$(188) PCOPY 2, 1 : PAGE 1, 1 END SUB SUB Exits() PCOPY 1, 2 : PAGE 2, 1 ' exit box COLOR 0, 1: LOCATE 10, 2 PRINT CHR$(178, 177, 176) + " " + CHR$(176,177,178) LOCATE 11, 2:PRINT CHR$(178, 177, 176);: COLOR 15,1 PRINT " E X I T ";: COLOR 0, 1: PRINT CHR$(176,177,178) LOCATE 12, 2 PRINT CHR$(178, 177, 176) + " " + CHR$(176,177,178) LOCATE 13, 2:PRINT CHR$(178, 177, 176);: COLOR 11,1 PRINT " Are you sure? ";: COLOR 0, 1: PRINT CHR$(176,177,178) LOCATE 14, 2 PRINT CHR$(178, 177, 176) + " " + CHR$(176,177,178) LOCATE 15, 2 PRINT CHR$(178, 177, 176) + " " + CHR$(176,177,178) LOCATE 15,5: COLOR 4,11 :PRINT " Yes " LOCATE 15, 14 : PRINT " No " LOCATE 16, 2 : COLOR 0, 1 PRINT CHR$(178, 177, 176) + " " + CHR$(176,177,178) PCOPY 2, 1 : PAGE 1, 1 END SUB '---------------------- M A I N ---------------------------------------- FUNCTION PBMAIN() MOUSE 7, DOUBLE, DOWN CURSOR OFF fillscreen ' Fill the screen with charecters DO GetKey Keynumber&, char$, Rgt&, Lft&, RRow&, CCol& 'Click the mouse 'or hit a key IF Rgt& OR Keynumber& = 27 THEN 'Call menu with ESC Key or DropDownMenu MenuCode& 'right mouse button. END IF IF MenuCode& = 13 THEN EXIT FUNCTION 'If Exit was selected, bye PCOPY 3, 1 'If not, put back Original screen LOCATE 24, 10 'MenuCode& is a two digit number that gives you the Drop number, which 'is the 1st digit, the second digit is the Selection number. IF you 'click ON EXIT, the number is 13, which is 1st Drop AND 3rd Selection. 'Display MenuCode& on screen LOCATE 20, 30 : COLOR 1, 11 PRINT " Drop "+ CHR$(196,196,191,218,196,196)+ " Selection " LOCATE 21, 38 : PRINT CHR$(25,25) LOCATE 22, 37 : PRINT MenuCode& LOOP END FUNCTION _ _ _ _