'===========================================================================
' Subject: MENU SYSTEM                        Date: 05-17-96 (11:47)       
'  Author: Claude Gagn‚                       Code: QB, QBasic, PDS        
'  Origin: cgagne@globalserve.on.ca         Packet: MENU.ABC
'===========================================================================
'*******************************************************************
'* This is some routine from my own library                        *
'* Use the tab key to navigate into the menu                       *
'*                                                                 *
'* Some routine are written in French because I'm from Quebec      *
'* Excuse my english, I'am learning since only 5 month             *
'*                                                                 *
'* You can Email me at cgagne@globalserve.on.ca                    *
'*                                                                 *
'* Feel free to copy or modify these routines                      *
'*                                                                 *
'* Claude Gagn‚, Toronto (since 5 month ) 1996                     *
'* If you want more, Email me!                                     *
'*******************************************************************

DECLARE FUNCTION yesnobox! (msg$, default%)
DECLARE FUNCTION menusystem! (menuitem$(), handle$)
DECLARE SUB cadre (gauche%, droit%, haut%, bas%, couleur, ombre, coultitre, titre$)
DECLARE SUB dayofweek (range, colone)
DECLARE SUB Delai (ticks!)
DECLARE SUB click ()
DECLARE SUB messagebox (msg$)
DECLARE SUB appuietouche ()
CONST vrai = -1
CONST faux = NOT vrai
'******************************
'* String array for the menu  *
'******************************

DIM menu$(6)
menu$(1) = "  File  "
menu$(2) = "  Edit  "
menu$(3) = " Option "
menu$(4) = "  Color "
menu$(5) = "  Help  "
menu$(6) = "  Quit  "

'*****************************************
' Demo Here                              *
' Erase this part and put your code here *
'*****************************************

CLS
cadre 1, 80, 1, 23, 15, 0, 1, "Desk ( box without shadow and Dayofweek routine)"
dayofweek 1, 1

LOCATE 21, 12
PRINT " Look the transparent shadow !!!!!!!! "
cadre 10, 70, 10, 20, 7, 1, 1, "Box with shadow"
SLEEP
cadre 15, 65, 15, 18, 3, 0, 1, "Box without shadow"
SLEEP
answer = yesnobox(" This is a Yesnobox, do you like it! ", 1)
        IF answer = 1 THEN
                cadre 1, 80, 1, 23, 15, 0, 1, "Now, the Menu System !"
                SLEEP 2

                menuanswer% = 0
                DO UNTIL menuanswer% = 6
                menuanswer% = menusystem(menu$(), "Main Menu")
                LOOP
                cadre 1, 80, 1, 23, 15, 0, 1, "This is it !"
                messagebox ("That's the end of this demo")
                
                
        END IF
        IF answer = 2 THEN
                CLS
        END IF
END

SUB appuietouche
'****************************************************
'* Wait until a key is pressed                      *
'****************************************************

CALL cadre(20, 60, 20, 21, 7, 1, 1, "  Instruction...")

COLOR 0, 7
LOCATE 21, 28
PRINT "Press any key to continue..."

DO
LOOP UNTIL LEN(INKEY$)

END SUB

SUB cadre (gauche%, droit%, haut%, bas%, couleur, ombre, coultitre, titre$)
'***************************************************************
'* Box routine like CPAV                                       *
'* Claude Gagn‚, cgagne@globalserve.on.ca                      *
'*                                                             *
'* gauche% = left : left col                                   *
'* droit% = right : right col                                  *
'* haut%  = up    : up row                                     *
'* bas%   = down  : down row                                   *                                             
'* couleur= color : color of the box                           *
'* ombre = shadow : 1 = transparent shadow                     *
'*                  0 = no shadow                              *
'*coultitre= color of the title                                *
'* titre$ = title : text on the top of the box                 *
'***************************************************************
                oldgauche% = gauche%
                olddroit% = droit%
                oldhaut% = haut%
                oldbas% = bas%

         IF ombre = 1 THEN
'*******************************
'* Vertical shadow             *
'*******************************

        FOR i% = haut% + 1 TO bas%
                FOR j% = 1 TO 2
                        car = SCREEN(i%, droit% + j%)
                        car1$ = CHR$(car)
                        car$ = car$ + car1$
                                IF car$ = CHR$(219) THEN
                                        car$ = " "
                                END IF
                       
                        LOCATE i%, (droit% + j%)
                        COLOR 8, 0
                        PRINT car$
                        car$ = ""
                NEXT j%
        NEXT i%
'********************************
'* horizontal shadow            *
'********************************

        FOR k% = gauche% + 2 TO (droit% + 2)
                car = SCREEN(bas% + 1, k%)
                car1$ = CHR$(car)
                        IF car1$ = CHR$(219) THEN
                                car1$ = " "
                        END IF

                car$ = car$ + car1$


        NEXT k%
        LOCATE bas% + 1, gauche% + 2
        COLOR 8, 0
        PRINT car$


         END IF




                COLOR couleur
                LOCATE haut%, gauche%
                        PRINT "Û"
                LOCATE haut%, droit%
                        PRINT "Û"
                LOCATE bas%, gauche%
                        PRINT "Û"
                LOCATE bas%, droit%
                        PRINT "Û"
                ligne = (droit% - gauche%)
                motif$ = STRING$(ligne + 1, CHR$(219))
                ligne1 = droit% + gauche%
                      
                                LOCATE haut%, gauche%
                                PRINT motif$
                                LOCATE bas%, gauche%
                                PRINT motif$
                                FOR i = haut% + 1 TO bas% - 1
                                        haut% = haut% + 1
                                        LOCATE haut%, gauche%
                                        PRINT motif$
                                NEXT i
                                  COLOR coultitre
                                  LOCATE oldhaut%, oldgauche%
                                  PRINT motif$
                                  titre% = LEN(titre$)
                                  titre% = INT((ligne1 - titre%) / 2) + 1
                                  COLOR 15, coultitre
                                  LOCATE oldhaut%, titre%
                                  PRINT titre$



END SUB

SUB click
SOUND 800, .05

END SUB

SUB dayofweek (range, colone)
'*************************************************
'* To find the day of the week                   *
'* range = row                                   *
'* colone = col                                  *
'*************************************************

Month = VAL(MID$(DATE$, 1, 2))
day = VAL(MID$(DATE$, 4, 2))
Year = VAL(MID$(DATE$, 9, 2))
DIM day$(7)
                day$(7) = " Sunday "
                day$(1) = " Monday "
                day$(2) = " Tuesday "
                day$(3) = " Wednesday "
                day$(4) = " Thursday "
                day$(5) = " Friday "
                day$(6) = " Saturday "

    IF Month < 3 THEN
   
      Month = Month + 10
      Year = Year - 1
    
    ELSE
      Month = Month - 2
    END IF
  
    Y1 = Year / 100
    y2 = Year MOD 100
    dow = ((day + 2 + INT(2.6 * Month - .1) + y2 + y2 / 4 + Y1 / 4 - 2 * Y1 + 49) MOD 7) + 1

SELECT CASE dow
        CASE 1
               
                jour$ = day$(dow)
        CASE 2
                jour$ = day$(dow)
        CASE 3
                jour$ = day$(dow)
        CASE 4
                jour$ = day$(dow)
        CASE 5
                jour$ = day$(dow)
        CASE 6
                jour$ = day$(dow)
        CASE 7
                jour$ = day$(dow)
END SELECT
Month$ = MID$(DATE$, 1, 2)
Year$ = MID$(DATE$, 7, 4)
LOCATE range, colone
PRINT jour$; day; "/" + Month$ + "/"; Year$
END SUB

 SUB Delai (ticks!)
 'The next sub is just a little delay
 '
    begintime! = TIMER
    DO
         LOOP UNTIL TIMER - begintime! > ticks!
END SUB

FUNCTION menusystem! (menuitem$(), handle$)

'******************************************************************
'* This is a menu routine using a text button                     *
'* Use the TAB key for navigate                                   *
'* Menuitem$() = string array containing the menu items           *
'* Handle$ = Title of the menu. It appear on the top of the menu  *
'******************************************************************

DIM colone%(UBOUND(menuitem$))

PCOPY 0, 1
CALL cadre(1, 80, 1, 4, 7, 0, 1, handle$)

oncontinu = vrai
default% = 1
answer% = 0

WHILE oncontinu = vrai
        col.depart% = 1
        row% = 2
        fond% = 7


        FOR i% = 1 TO UBOUND(menuitem$)
                longueur.bouton% = LEN(menuitem$(i%))
                longueur.bouton% = longueur.bouton% + 2
                haut.bouton$ = STRING$(longueur.bouton% - 2, "Ä")
                bas.bouton$ = STRING$(longueur.bouton% - 2, "Ä")
                fin.bouton% = col.depart% + longueur.bouton%
                colone%(i%) = col.depart%
                CSG$ = "Ú"
                CSD$ = "¿"
                CIG$ = "À"
                CID$ = "Ù"
                verticale$ = "³"

                LOCATE row%, col.depart%
                COLOR 15, fond%
                PRINT CSG$; haut.bouton$
                LOCATE row% + 1, col.depart%
                PRINT verticale$
                LOCATE row% + 2, col.depart%
                PRINT CIG$

                COLOR 0, fond%
                LOCATE row%, fin.bouton% - 1
                PRINT CSD$
                LOCATE row% + 1, fin.bouton% - 1
                PRINT verticale$
                LOCATE row% + 2, col.depart% + 1
                PRINT bas.bouton$
                LOCATE row% + 2, fin.bouton% - 1
                PRINT CID$

                        IF i% = default% THEN
                                COLOR 14, 7
                                LOCATE row% + 1, col.depart% + 1
                                PRINT menuitem$(i%)
                        ELSE
                                COLOR 0, 7
                                LOCATE row% + 1, col.depart% + 1
                                PRINT menuitem$(i%)
                        END IF

                col.depart% = fin.bouton%
              
        NEXT
                C$ = INKEY$
                C$ = RIGHT$(C$, 1)

                        IF default% > UBOUND(menuitem$) THEN
                                default% = 1
                        END IF
                        IF C$ = CHR$(9) THEN
                                default% = default% + 1
                        END IF

                        IF C$ = CHR$(13) AND default% <> 0 THEN

                       
                                CALL Delai(.03)
                                haut.bouton$ = STRING$(LEN(menuitem$(default%)) + 1, "Ä")
                                bas.bouton$ = STRING$(LEN(menuitem$(default%)) + 1, "Ä")

                                LOCATE row%, colone%(default%)
                                COLOR 0, fond%
                                PRINT CSG$; haut.bouton$
                                LOCATE row% + 1, colone%(default%)
                                PRINT verticale$
                                LOCATE row% + 2, colone%(default%)
                                PRINT CIG$

                                fin.bouton% = colone%(default%) + LEN(menuitem$(default%)) + 1

                                COLOR 15, fond%
                                LOCATE row%, fin.bouton%
                                PRINT CSD$
                                LOCATE row% + 1, fin.bouton%
                                PRINT verticale$
                                LOCATE row% + 2, colone%(default%) + 1
                                PRINT bas.bouton$
                                LOCATE row% + 2, fin.bouton%
                                PRINT CID$

                                click
                                CALL Delai(.03)
                                answer% = 1
                        END IF
                        IF answer% <> 0 THEN
                                CALL Delai(.03)
                                oncontinu = faux
                        END IF

                      
      
WEND

menusystem! = default%
'PCOPY 1, 0

END FUNCTION

SUB messagebox (msg$)
'**************************************************
'* Print the message into a box and wait until a  *
'* key is pressed.                                *
'**************************************************

PCOPY 0, 1                      ' faire une copie de l'ecran precedante

'****************************************
'* Calcul des limites de longueurs      *
'****************************************

longueur.msg = LEN(msg$)        ' length of the message
depart.box% = (80 - longueur.msg) \ 2' column start
fin.box% = depart.box% + longueur.msg + 2'column end

'****************************************
'* Appel de la routine cadre            *
'****************************************

CALL cadre(depart.box%, fin.box%, 12, 13, 7, 1, 4, "Attention !")
LOCATE 13, depart.box% + 2       'Locate the box
COLOR 0, 7
PRINT msg$
'****************************
'* Boucle d'attente         *
'****************************
CALL appuietouche
PCOPY 1, 0                      'Restaurer l'ecran precedante



END SUB

FUNCTION yesnobox (msg$, default%)
'**************************************************
'* Print the message into a box and return the    *
'* answer!                                        *
'* msg$ = message to print                        *
'* default% = answer to be highlight              *
'*          1 = Yes                               *
'*          2 = No                                *
'* return:                                        *
'*          1 = Yes                               *
'*          2 = No                                *
'**************************************************

PCOPY 0, 1                                      ' faire une copie de l'ecran precedante
oui$ = "Yes"
non$ = "No "
answer% = 0
'****************************************
'* Calcul des limites de longueurs      *
'****************************************

longueur.msg = LEN(msg$)                        ' length of message
depart.box% = (80 - longueur.msg) \ 2           ' column start
fin.box% = depart.box% + longueur.msg + 2       ' column end
'****************************************
'* Appel de la routine cadre            *
'****************************************

CALL cadre(depart.box%, fin.box%, 10, 16, 7, 1, 2, "Decision")

LOCATE 12, depart.box% + 2                      'locate the box
COLOR 0, 7
PRINT msg$
oncontinu = vrai

WHILE oncontinu = vrai

C$ = INKEY$
C$ = RIGHT$(C$, 1)
'****************
'* bouton Yes   *
'****************
                COLOR 15, 7
                LOCATE 14, 31
                PRINT "ÚÄÄÄÄÄÄÄÄ"
                'COLOR 15, 7
                LOCATE 15, 31
                PRINT "³"
             
                LOCATE 16, 31
                PRINT "À"
                LOCATE 14, 40
                COLOR 0, 7
                PRINT "¿"
                LOCATE 15, 40
                PRINT "³"
                LOCATE 16, 43
                PRINT "ÄÄÄÄÄÄÄÄÙ"
'*************
'* Bouton no *
'*************

                COLOR 15, 7
                LOCATE 14, 42
                PRINT "ÚÄÄÄÄÄÄÄÄ"
                LOCATE 15, 42
                PRINT "³"
            
                LOCATE 16, 42
                PRINT "À"
                LOCATE 14, 51
                COLOR 0, 7
                PRINT "¿"
                LOCATE 15, 51
                PRINT "³"
                LOCATE 16, 32
                PRINT "ÄÄÄÄÄÄÄÄÙ"


        IF default% = 1 THEN
                COLOR 14
                LOCATE 15, 33
                PRINT oui$
                COLOR 0
                LOCATE 15, 45
                PRINT non$
        END IF
        IF default% = 2 THEN
                COLOR 0
                LOCATE 15, 33
                PRINT oui$
                COLOR 14
                LOCATE 15, 45
                PRINT non$
         END IF
         IF answer% <> 0 THEN
                LOCATE , , 0
                oncontinu = faux
         END IF

                            IF C$ = CHR$(13) AND default% = 1 THEN
                              
                                click
                                COLOR 0, 7
                                LOCATE 14, 31
                                PRINT "ÚÄÄÄÄÄÄÄÄ"
                                COLOR 0, 7
                                LOCATE 15, 31
                                PRINT "³"
                            
                                LOCATE 16, 31
                                PRINT "À"
                                COLOR 14, 7
                                 LOCATE 15, 33
                                PRINT oui$
                                LOCATE 14, 40
                                COLOR 15, 7
                                PRINT "¿"
                                LOCATE 15, 40
                                PRINT "³"
                                LOCATE 16, 32
                                PRINT "ÄÄÄÄÄÄÄÄÙ"
                                COLOR 0, 7
                                LOCATE 15, 45
                                PRINT non$
                                reponse% = 1
                              
                                Delai (.1)
                                answer% = 1
                               
                            ELSEIF C$ = CHR$(13) AND default% = 2 THEN
                                        click
                                        COLOR 0, 7
                                        LOCATE 14, 42
                                        PRINT "ÚÄÄÄÄÄÄÄÄ"
                                        COLOR 0, 7
                                        LOCATE 15, 42
                                        PRINT "³"
                                   
                                        LOCATE 16, 42
                                        PRINT "À"
                                        LOCATE 14, 51
                                        COLOR 15, 7
                                        PRINT "¿"
                                        LOCATE 15, 51
                                        PRINT "³"
                                        LOCATE 16, 43
                                        PRINT "ÄÄÄÄÄÄÄÄÙ"


                                        reponse% = 2
                                        CALL Delai(.01)
                                        answer% = 1
                                       
                            END IF
                           
                            IF C$ = CHR$(9) AND default% = 2 THEN
                                        default% = 1
                            ELSEIF C$ = CHR$(9) AND default% = 1 THEN
                                        default% = 2
                            END IF


                            
                        
WEND
        yesnobox = reponse%
        PCOPY 1, 0                                      'Restaurer l'ecran precedante
END FUNCTION