[Back to MENU SWAG index] [Back to Main SWAG index] [Original]

    { NOTE :  DEMO at the bottom of this unit
              also UMOUSE needed here is in MOUSE.SWG }

    {
      AUTHOR             : Christophe.AVONTURE@is.belgacom.be

      AIM                : Makes the creation of menu very, very easy.

      WRITTEN DATE       : Tuesday   March 12 1996
      LAST MODIFICATION  : Wednesday March 14 MARS 1996

      !!!  NEVER MODIFY THIS UNIT.  !!!

      -CONTACT ME IF YOU WANT TRANSLATION INTO ENGLISH-
    }

    Unit Menu;

    INTERFACE

    TYPE

       { D‚finition d'un type procedure }

       TProcedure     = Procedure;

       { RŠglemente la longueur d'une option d'un menu. }

       TMenuOption    = String[25];

       { Les menus d‚roulants sont pr‚vus pour fonctionner en mode texte 80*25 ou
         en mode graphique 640*480 }

       cgVideoMode = (cgTextMod, cgGraphMod);

    CONST

       { C'est cette variable qui d‚terminera la fin du menu.  Le meilleur
         emploi est dans un menu File; option Exit }

       bEXIT : Boolean = FALSE;

       { D‚clare au programme que le menu doit se faire en mode texte 80*25 }

       cgMode : cgVideoMode = cgTextMod;

       { Attribut couleur du menu principal }

       cgMainMenuAttr  : Byte = 112;

       { Attribut couleur du menu principal : Lettre surbrillance}

       cgMainMenuAttrS : Byte = 116;

       { Attribut couleur des sous-menus lorsqu'ils sont s‚lectionn‚s }

       cgSubMenuAttr   : Byte = 33;

       { Attribut couleur des sous-menus lorsqu'ils sont s‚lectionn‚s :
         Lettre surbrillance }

       cgSubMenuAttrS  : Byte = 44;

    VAR

       { Cette variable servira … stocker le nom du sous-menu qui est
         actuellement d‚pli‚ afin de ne pas le d‚plier … nouveau lorsqu'on
         s‚lectionne une autre option dans ce mˆme sous-menu. }

       cgActualSubMenu   : TMenuOption;

       { Cette variable servira … stocker le nom de l'option qui est
         actuellement s‚lectionn‚e afin de remettre son attribut couleur en
         cgSubMenuAttr. }

       cgActualOption    : Byte;

       { Tableau global: contient le nom de toutes les options du menu g‚n‚ral,
         c'est-…-dire qu'il contient tous les lib‚ll‚s des diff‚rents sous-menus
         pr‚sents. }

       cgMenu            : Array[1..11,0..25] of TMenuOption;

       { Pr‚sentation sous forme de tableau du menu principal. Ce tableau sera
         compl‚t‚ dynamiquement lors du RUNTIME par le contenu de la constante
         cgMainMenu o— les diff‚rents sous-menus sont s‚par‚s par des blancs. }

       cgSubMenu         : Array[1..11] OF TMenuOption;

       { Message qui viendra s'‚crire dans la ligne de statut pour chacune des
         options ou chacun des sous-menus. }

       cgMessage         : Array[1..11,0..25] OF ^String;

       { Nombre de sous-menu apparraissant dans le menu principal.  Cette valeur
         est automatiquement calcul‚ par le programme. }

       cgSubMenuNumber  : Byte;

       { Tableau global: contient toutes les proc‚dures pour tous les sous-menus
         du menu g‚n‚ral.  C'est via ce tableau que l'on pourra acc‚der aux
         handler des diff‚rentes options pr‚sentes dans le menu g‚n‚ral. }

       cgMenuProc        : Array[1..11,1..25] of TProcedure;

       { Contiendra, pour un sous-menu donn‚, la liste de toutes les proc‚dures
         qui sont associ‚s aux options de ce sous-menu. }

       cgSubMenuProc     : Array[1..11] OF TProcedure;

    PROCEDURE ShowSubMenu (cgSubMenu, cgOption : TMenuOption; cgMessage : Pointer);
    PROCEDURE MainMenuHandle;
    PROCEDURE WriteBarMenu;
    PROCEDURE CopyPage (Source, Cible : Byte);
    PROCEDURE Cursor_Hide;
    PROCEDURE Cursor_Show;
    PROCEDURE Run_Menu;

    FUNCTION  GetOrderSubMenu (cgSubMenu : TMenuOption) : Byte;

    IMPLEMENTATION

    USES Crt, uMouse;  { FOUND IN MOUSE.SWG}

    CONST

       { Sauvegarde du nombre de handler nouvellement ajout‚ afin de pouvoir les
         retirer lorsque l'on passera … un autre sous-menu. }

       OldNumberHandler : Byte = 0;

    VAR

       { Menu principal.  Obligatoirement inf‚rieur ou ‚gal … 100 caractŠres.
         Th‚oriquement, cette taille devrait ˆtre de 80 caractŠres mais comme
         il se peut que l'on utilise des '&' pour pr‚fixer certaines lettres,
         on devra alors tenir compte d'une taille plus grande que 80. }

       cgMainMenu        : String[100];
       cgMainMenu2       : String[100];

       { Cette variable servira … stocker le nom du sous-menu qui est
         actuellement d‚pli‚ afin de ne pas le d‚plier … nouveau lorsqu'on
         s‚lectionne une autre option dans ce mˆme sous-menu. }

       cgOldSubMenu      : TMenuOption;

       { Cette variable servira … stocker le nom de l'option qui est
         actuellement s‚lectionn‚e afin de remettre son attribut couleur en
         cgSubMenuAttr. }

       cgOldOption       : TMenuOption;

    { ************************************************************************ }
    { * Sauvegarde la page ‚cran source dans la page ‚cran destination.      * }
    { ************************************************************************ }

    PROCEDURE CopyPage (Source, Cible : Byte);

    BEGIN

        Move (Mem[$B800:Source Shl 12], Mem[$B800:Cible Shl 12], 4096);

    END;

    { ************************************************************************ }
    { * Lorsque le clic de la souris se fait dans une surface non d‚limit‚e, * }
    { * on peut associer une proc‚dure qui sera charg‚e de rafraŒchir l'‚cran* }
    { * ou tout autre chose.  Dans ce cas, le sous-menu sera repli‚.         * }
    { ************************************************************************ }

    PROCEDURE OtherArea;

    BEGIN

    {   CopyPage (1, 0);}

    END;

    { ************************************************************************ }
    { * Ote les blancs se trouvant devant et derriŠre un mot                 * }
    { ************************************************************************ }

    FUNCTION AllTrim (s : String) : String;

    BEGIN

        WHILE s[1] = ' ' DO
           Delete (s, 1, 1);

        WHILE s[Length(s)] = ' ' DO
           Delete (s, Length(s), 1);

        AllTrim := s;

    END;

    { ************************************************************************ }
    { * Proc‚dure bidon: assign‚e par d‚faut … toutes les nouvelles options  * }
    { * cr‚‚es ou … tous nouveaux sous-menus.                                * }
    { ************************************************************************ }

    PROCEDURE hNULL;  FAR; BEGIN END;

    { ************************************************************************ }
    { * Affiche le texte fournit comme paramŠtre … la position courante du   * }
    { * curseur en prenant soin de retirer tous les "&".                     * }
    { ************************************************************************ }

    PROCEDURE ShowText (S : String);

    VAR
       OldAttr : Byte;

    BEGIN

        { Sauvegarde l'attribut de couleur actuel }

        OldAttr := TextAttr;

        { Masque le curseur de la souris afin de ne pas ‚crire dessus. }

        Mouse_Hide;

        IF NOT (Pos('&', S) = 0) THEN
           BEGIN

              { Il faut traiter les diff‚rents '&' pr‚sents dans le texte. }

              REPEAT

                    { Ecriture de la partie de texte se situant avant le '&' }

                    TextAttr := OldAttr;
                    Write (Copy (S, 1, Pos('&', S)-1));

                    { Ecriture de la lettre pr‚fix‚e par le '&' dans une autre
                      couleur. }

                    IF OldAttr = cgMainMenuAttr THEN
                       TextAttr := cgMainMenuAttrS
                    ELSE
                       TextAttr := cgSubMenuAttrS;

                    Delete (S, 1, Pos('&', S));
                    Write (S[1]);

                    { Effacement du '&' }

                    Delete (S, 1, 1);

              UNTIL Pos('&', S) = 0;

              TextAttr := OldAttr;
              Write (S);

           END
        ELSE
           Write (S);

        { R‚affiche le curseur de la souris. }

        Mouse_Show;

    END;

    { ************************************************************************ }
    { * Retourne une chaŒne de caractŠres sans les  "&".                     * }
    { ************************************************************************ }

    FUNCTION Remove_Ampersand (s : String) : String;

    BEGIN

       WHILE Pos ('&', s) > 0 DO
         Delete (s, (Pos('&', s)), 1);

       Remove_Ampersand := s;

    END;

    { ************************************************************************ }
    { * Affiche le menu principal.                                           * }
    { ************************************************************************ }

    PROCEDURE WriteBarMenu;

    VAR
       S : String;
       I : Byte;

    BEGIN

        S := cgMainMenu;
        GotoXy (1,1);
        TextAttr := cgMainMenuAttr;
        Mouse_Hide;
        ClrEol;
        Mouse_Show;

        ShowText (cgMainMenu);

        { Affiche la barre d'‚tat }

        GotoXy (1,25);
        Mouse_Hide;
        ClrEol;
        Mouse_Show;

    END;

    { ************************************************************************ }
    { * Cette fonction retourne la position du sous-menu dans la chaŒne      * }
    { * cgMainMenu. Elle sera utile uniquement pour d‚terminer la colonne o— * }
    { * d‚bute le sous-menu … l'‚cran.                                       * }
    { ************************************************************************ }

    FUNCTION GetPosSubMenu (cgSubMenu : TMenuOption) : Byte;

    VAR
       I : Byte;

    BEGIN

       GetPosSubMenu := Pos (Remove_Ampersand(cgSubMenu), cgMainMenu2);

    END;

    { ************************************************************************ }
    { * Cette fonction va retourner 1 si c'est le tout premier sous-menu de  * }
    { * la barre de menus, 2 si c'est le second, ... ind‚pendamment du X     * }
    { * (colonne) dans cette mˆme barre.                                     * }
    { ************************************************************************ }

    FUNCTION GetOrderSubMenu (cgSubMenu : TMenuOption) : Byte;

    VAR
       I, J : Byte;
       s    : String;
       s2   : String;
       bFin : Boolean;

    BEGIN

       s    := cgMainMenu;
       I    := 0;
       bFin := False;

       REPEAT

          Inc (I);

          WHILE s[1] = ' ' DO
             Delete (s, 1, 1);

          J  := 0;
          s2 := '';

          REPEAT
             Inc (J);
             s2 := s2 + s[J];
          UNTIL (s[J] = ' ') OR (J = Length(s));

          Delete (s2, Length(s2), 1);

          IF s2 = cgSubMenu THEN
             bFin := True
          ELSE
             IF I = cgSubMenuNumber THEN
                bFin := True
             ELSE
                Delete (s, 1, Length(s2));

       UNTIL bFin;

       GetOrderSubMenu := I;

    END;

    { ************************************************************************ }
    { * Cette fonction va retourner 1 si c'est la toute premiŠre option du   * }
    { * sous-menu, 2 si c'est la seconde, ... ind‚pendamment du X (colonne). * }
    { ************************************************************************ }

    FUNCTION GetOrderOptionMenu (cgSubMenu, cgOption : TMenuOption) : Byte;

    VAR
       I   : Byte;
       J   : Integer;
       Err : Integer;

    BEGIN

       Val (cgMenu[GetOrderSubMenu(cgSubMenu),Low (cgMenu[GetOrderSubMenu (cgSubMenu)])],
            J, err);

       FOR I := (Low (cgMenu[GetOrderSubMenu (cgSubMenu)]) + 1) TO J DO
          IF cgMenu[GetOrderSubMenu (cgSubMenu),I] = cgOption THEN
             Break;

       GetOrderOptionMenu := I + 2;

    END;

    PROCEDURE hAllOption;   FAR;
    BEGIN

       { Mise en surbrillance de l'option. }

       cgActualOption := (cgMouse_Y-1) Shr 3;
       ShowSubMenu (cgSubMenu[GetOrderSubMenu(cgActualSubMenu)],
                    cgMenu[GetOrderSubMenu(cgSubMenu[GetOrderSubMenu(cgActualSubMenu)]),cgActualOption],
                    cgMessage[GetOrderSubMenu(cgActualSubMenu),cgActualOption]);

       { Il ne faudra ex‚cuter le code que si l'utilisateur a relƒch‚ le bouton
         gauche de la souris et pas autrement. }

       IF NOT Mouse_ReleaseButton (cgMouse_Left) THEN
          cgMenuProc[GetOrderSubMenu(cgActualSubMenu),cgActualOption];
    END;

    { ************************************************************************ }
    { * D‚plie un sous-menu.  Si le paramŠtre cgOption est sp‚cifi‚ (diff‚-  * }
    { * rent de ''), alors le sous-menu est d‚pli‚ et l'option donn‚e est    * }
    { * s‚lectionn‚e.                                                        * }
    { ************************************************************************ }

    PROCEDURE ShowSubMenu (cgSubMenu, cgOption : TMenuOption; cgMessage : Pointer);

    VAR
       I       : Byte;
       J       : Word;
       Max     : Byte;
       S       : String;
       Nbr     : Integer;
       Err     : Integer;
       Message : ^String;
       SubMenu : ^String;

    BEGIN

       { On va faire un rafraichissement de l'‚cran uniquement s'il y a lieu d'en
         faire un. }

       IF NOT ((cgSubMenu = cgOldSubMenu) AND (cgOption = cgOldOption)) THEN
          BEGIN

             IF NOT (cgSubMenu = cgOldSubMenu) THEN
                BEGIN

                   CopyPage (1, 0);

                   { Retire les anciens handler d'un autre sous-menu }

                   IF NOT (oldNumberHandler = 0) THEN
                      FOR I := 1 TO oldNumberHandler DO
                         Mouse_RemoveHandler;

                   WriteBarMenu;

                   { Mise en surbrillance du sous-menu }

                   TextAttr := cgSubMenuAttr;

                   J := GetPosSubMenu(Remove_Ampersand(cgSubMenu));

                   IF (J > 1) AND (J < 79) THEN
                      BEGIN
                         GotoXy (J-1, 1);
                         ShowText (' '+cgSubMenu+' ');
                      END
                   ELSE
                      IF (J > 1) THEN
                         BEGIN
                            GotoXy (J-1, 1);
                            ShowText (' '+cgSubMenu)
                         END
                      ELSE
                         BEGIN
                            GotoXy (J, 1);
                            ShowText (cgSubMenu+' ');
                         END;

                   { Lecture du nombre d'options dans ce sous-menu }

                   Val (cgMenu[GetOrderSubMenu(cgSubMenu),Low (cgMenu[GetOrderSubMenu (cgSubMenu)])],
                        Nbr, err);

                   IF NOT (Nbr = 0) THEN
                      BEGIN

                         { Affichage des diff‚rentes options }

                         TextAttr := cgMainMenuAttr;

                         Max := 0;

                         FOR I := Low (cgMenu[GetOrderSubMenu (cgSubMenu)]) TO High (cgMenu[GetOrderSubMenu (cgSubMenu)]) DO
                            IF Max < Length (Remove_Ampersand(cgMenu[GetOrderSubMenu (cgSubMenu),I])) THEN
                               Max := Length (remove_ampersand(cgMenu[GetOrderSubMenu (cgSubMenu),I]));

                         { Se positionne correctement pour l'affichage }

                         IF (GetPosSubMenu (cgSubMenu) + Max + 4 > 80) THEN
                            GotoXy (80 - Max - 4 + 1, 2)
                         ELSE
                            IF (GetPosSubMenu (cgSubMenu) - 1 > 0) THEN
                               GotoXy (GetPosSubMenu (cgSubMenu) - 1, 2)
                            ELSE
                               GotoXy (GetPosSubMenu (cgSubMenu), 2);

                         FillChar(s, Max+4, 'Ä');
                         s[0] := Chr(Max+4);
                         s[1] :=  'Ú';
                         s[Length(s)] := '¿';
                         Mouse_Hide;
                         Write (S);
                         Mouse_Show;

                         FOR I := Low (cgMenu[GetOrderSubMenu (cgSubMenu)])+1 TO Nbr DO
                            BEGIN

                               { Se positionne correctement pour l'affichage }

                               IF (GetPosSubMenu (cgSubMenu) + Max + 4 > 80) THEN
                                  GotoXy (80 - Max - 4 + 1, I+2)
                               ELSE
                                  IF (GetPosSubMenu (cgSubMenu) - 1 > 0) THEN
                                     GotoXy (GetPosSubMenu (cgSubMenu) - 1, I+2)
                                  ELSE
                                     GotoXy (GetPosSubMenu (cgSubMenu), I+2);

                               IF NOT (cgMenu[GetOrderSubMenu (cgSubMenu),I] = 'Ä') THEN
                                  BEGIN

                                     IF Pos('&', cgMenu[GetOrderSubMenu (cgSubMenu),I]) > 0 THEN
                                        FillChar(s, Max+5, ' ')
                                     ELSE
                                        FillChar(s, Max+4, ' ');

                                     s := '³ '+cgMenu[GetOrderSubMenu (cgSubMenu),I];

                                     IF Pos('&', cgMenu[GetOrderSubMenu (cgSubMenu),I]) > 0 THEN
                                        s[0] := Chr(Max+5)
                                     ELSE
                                        s[0] := Chr(Max+4);

                                     s[Length(s)] := '³';

                                     IF (GetPosSubMenu (cgSubMenu) + Max > 80) THEN
                                        Mouse_AddHandler (80 - (Max + 2), 80, I+1, I+1, hAllOption)
                                     ELSE
                                        Mouse_AddHandler (GetPosSubMenu (cgSubMenu)-1,
                                           GetPosSubMenu (cgSubMenu)-1+Max,
                                           I+1, I+1, hAllOption);
                                  END
                               ELSE
                                  BEGIN
                                     FillChar(s, Max+4, 'Ä');
                                     s := 'Ã'+cgMenu[GetOrderSubMenu (cgSubMenu),I];
                                     s[0] := Chr(Max+4);
                                     s[Length(s)] := '´';
                                 END;
                               ShowText (s);
                            END;

                         FillChar(s, Max+4, 'Ä');
                         s[0] := Chr(Max+4);
                         s[1] :=  'À';
                         s[Length(s)] := 'Ù';

                         { Se positionne correctement pour l'affichage }

                         IF (GetPosSubMenu (cgSubMenu) + Max + 4 > 80) THEN
                            GotoXy (80 - Max - 4 + 1, Nbr + 3)
                         ELSE
                            IF (GetPosSubMenu (cgSubMenu) - 1 > 0) THEN
                               GotoXy (GetPosSubMenu (cgSubMenu) - 1, Nbr+3)
                            ELSE
                               GotoXy (GetPosSubMenu (cgSubMenu), Nbr+3);

                         Mouse_Hide;
                         Write (S);
                         Mouse_Show;

                         cgOldOption := '';

                         OldNumberHandler := Nbr;

                      END;

                END

             ELSE

                IF NOT (cgoldOption = '') THEN
                   BEGIN

                      Max := 0;

                      FOR I := Low (cgMenu[GetOrderSubMenu (cgSubMenu)]) TO High (cgMenu[GetOrderSubMenu (cgSubMenu)]) DO
                         IF Max < Length (cgMenu[GetOrderSubMenu (cgSubMenu),I]) THEN
                            Max := Length (cgMenu[GetOrderSubMenu (cgSubMenu),I]);

                      { R‚tablit l'attribut de l'option anciennement
                        s‚lectionn‚e }

                      TextAttr := cgMainMenuAttr;

                      { Se positionne correctement pour l'affichage }

                      IF (GetPosSubMenu (cgSubMenu) + Max > 80) THEN
                         GotoXy (80 - Max, GetOrderOptionMenu (cgSubMenu,cgOldOption))
                      ELSE
                         IF NOT (GetPosSubMenu (cgSubMenu) - 1 > 1) THEN
                            GotoXy (GetPosSubMenu (cgSubMenu) + 2, GetOrderOptionMenu (cgSubMenu,cgOldOption))
                         ELSE
                            GotoXy (GetPosSubMenu (cgSubMenu) + 1, GetOrderOptionMenu (cgSubMenu,cgOldOption));

                      ShowText (cgoldOption);

                      { Surligne la ligne jusqu'au cadre }

                      S := '';

                      FOR I := Length(cgoldOption)+1 TO Max DO
                          S := S + ' ';

                      Mouse_Hide;
                      Write (s);
                      Mouse_Show;

                    END;

             cgOldSubMenu  := cgSubMenu;

             IF NOT (cgOption = '') THEN
                BEGIN

                   { Surligne l'option }

                   TextAttr := cgSubMenuAttr;

                   Max := 0;

                   FOR I := Low (cgMenu[GetOrderSubMenu (cgSubMenu)]) TO High (cgMenu[GetOrderSubMenu (cgSubMenu)]) DO
                      IF Max < Length (cgMenu[GetOrderSubMenu (cgSubMenu),I]) THEN
                         Max := Length (cgMenu[GetOrderSubMenu (cgSubMenu),I]);

                   { Se positionne correctement pour l'affichage }

                   IF (GetPosSubMenu (cgSubMenu) + Max > 80) THEN
                      GotoXy (80 - Max, GetOrderOptionMenu (cgSubMenu,cgOption))
                   ELSE
                      IF NOT (GetPosSubMenu (cgSubMenu) - 1 > 1) THEN
                         GotoXy (GetPosSubMenu (cgSubMenu) + 2, GetOrderOptionMenu (cgSubMenu,cgOption))
                      ELSE
                         GotoXy (GetPosSubMenu (cgSubMenu) + 1, GetOrderOptionMenu (cgSubMenu,cgOption));

                   ShowText (cgOption);

                   { Surligne la ligne jusqu'au cadre }

                   Max := 0;

                   FOR I := Low (cgMenu[GetOrderSubMenu (cgSubMenu)]) TO High (cgMenu[GetOrderSubMenu (cgSubMenu)]) DO
                      IF Max < Length (cgMenu[GetOrderSubMenu (cgSubMenu),I]) THEN
                         Max := Length (cgMenu[GetOrderSubMenu (cgSubMenu),I]);

                   S := '';

                   FOR I := Length(cgOption)+1 TO Max DO
                       S := S + ' ';

                   Mouse_Hide;
                   Write (s);
                   Mouse_Show;

                   cgOldOption := cgOption;

                END;

             TextAttr := cgMainMenuAttr;
             GotoXy (2, 25);
             ClrEol;

             IF NOT (cgMessage = NIL) THEN
                BEGIN

                    Message := cgMessage;
                    TextAttr := cgMainMenuAttr;
                    GotoXy (2, 25);
                    Mouse_Hide;
                    Write (Message^);
                    Mouse_SHow;

                END;
          END;

    END;

    { ************************************************************************ }
    { * Appel la proc‚dure correspondant au sous-menu s‚lectionn‚.           * }
    { ************************************************************************ }

    PROCEDURE HighLigthMainMenu (st : TMenuOption);

    BEGIN

        IF NOT (st = cgActualSubMenu) THEN
           BEGIN
              TextAttr := cgMainMenuAttr;
              GotoXy (1,1);
              WriteBarMenu;
              TextAttr := cgSubMenuAttr;
           END;

        IF NOT (GetPosSubMenu (st) = 0) AND
           NOT (GetOrderSubMenu (st) > cgSubMenuNumber) THEN
           BEGIN

              { D‚plie le sous-menu }

              cgActualSubMenu := cgSubMenu[GetOrderSubMenu (st)];

              ShowSubMenu (cgSubMenu[GetOrderSubMenu(cgActualSubMenu)],
                           '',cgMessage[GetOrderSubMenu(cgActualSubMenu),0]);

              { Appel au code qui se trouve sous le sous-menu uniquement si
                l'utilisateur a relƒch‚ le bouton de gauche de la souris }

              IF NOT Mouse_ReleaseButton (cgMouse_Left) THEN
                 cgSubMenuProc[GetOrderSubMenu (st)];

            END;

    END;

    { ************************************************************************ }
    { * Fournit le nom du sous-menu suivant (dans l'ordre de position) du    * }
    { * sous-menu dont le nom est fournit comme paramŠtre.                   * }
    { ************************************************************************ }

    FUNCTION GetNextSubMenu (OldSubMenu : TMenuOption) : TMenuOption;

    VAR
       s     : String;
       s1    : TMenuOption;
       I     : Byte;

    BEGIN

       s := cgMainMenu;

       Delete (s, 1, Pos(OldSubMenu,cgMainMenu)+Length(OldSubMenu));

       WHILE S[1] = ' ' DO
          Delete (s, 1, 1);

       I := 1;

       s1 := '';

       WHILE NOT (s[I] = ' ') DO
          BEGIN
             IF NOT (I > Length (s)) THEN
                s1 := s1 + s[I];
             Inc (I);
          END;

       GetNextSubMenu := s1;

    END;

    { ************************************************************************ }
    { * Fournit le nombre de sous-menu pr‚sent dans le menu principal.       * }
    { ************************************************************************ }

    FUNCTION GetSubMenuNumber : Byte;

    VAR
       s : String;
       I : Byte;

    BEGIN

       I := 0;
       s := cgMainMenu;

       REPEAT
          Inc (I);

          WHILE s[1] = ' ' DO
             Delete (s, 1, 1);

          REPEAT
             Delete (s, 1, 1);
          UNTIL (s[1] = ' ') OR (Length(s) = 0);

       UNTIL Length(s) = 0;

       GetSubMenuNumber := I;

    END;

    { ************************************************************************ }
    { * Cette proc‚dure va se charger de lire le fichier MENU.INC afin de    * }
    { * compl‚ter ses tableaux.                                              * }
    { ************************************************************************ }

    PROCEDURE InitAllSubMenu;

    VAR
       fMenu : Text;
       S     : String;
       SS    : TMenuOption;
       I     : Byte;

    BEGIN

       Assign (fMenu, 'MENU.INC');
       FileMode := 0;
       Reset (fMenu);

       I := 0;

       REPEAT

          ReadLn (fMenu, s);

          IF (Copy (s,1, 2) = '  ') THEN

             { Il s'agit d'une option d'un sous-menu. }

             BEGIN

                { Ajoute l'option dans le sous-menu. }

                Inc (I);
                S := Alltrim(s);
                cgMenu[cgSubMenuNumber,I] := S;

                { Par d‚faut, lorsque l'utilisateur cliquera sur cette option,
                  la proc‚dure hNULL -c…d qui ne fait absolument rien- sera
                  appel‚e. }

                cgMenuProc[cgSubMenuNumber,I] := hNULL;

             END
          ELSE
             IF (Copy (s, 1, 2) = ' -') THEN

                { Il s'agit de la ligne d'aide du sous-menu ou de l'option qu'on
                  vient tout juste de traiter }

                BEGIN

                   { Retire le trait d'union. }

                   Delete (s, 2, 1);

                   { Ajoute la ligne d'aide. }

                   S := Alltrim(s);
                   GetMem (cgMessage[cgSubMenuNumber,I], Length(s)+1);
                   cgMessage[cgSubMenuNumber,I]^:= S;

                END
          ELSE

             { Il s'agit d'un nouveau sous-menu. }

             BEGIN

                { Sauvegarde le nombre d'options appartenant … ce sous-menu en
                  position 0. }

                IF NOT (cgSubMenuNumber = 0) THEN
                   Str (I, cgMenu[cgSubMenuNumber,0]);

                { Ajoute le nouveau sous-menu. }

                Inc (cgSubMenuNumber);
                S := Alltrim(s);
                cgSubMenu[cgSubMenuNumber] := S;

                { Associe par d‚faut le clic sur ce sous-menu … la proc‚dure
                  hNULL }

                cgSubMenuProc[cgSubMenuNumber] := hNULL;

                I := 0;

             END;

       UNTIL Eof (fMenu);

       { Sauvegarde le nombre d'options appartenant … ce sous-menu en
         position 0. }

       IF NOT (cgSubMenuNumber = 0) THEN
          Str (I, cgMenu[cgSubMenuNumber,0]);

       Close (fMenu);

       { Cr‚e la ligne de sous-menu. }

       cgMainMenu := '';

       FOR I := 1 TO cgSubMenuNumber DO
          cgMainMenu := cgMainMenu + cgSubMenu[I] + '  ';

       { Cr‚e la ligne de sous-menus en prenant soin de retirer tous les '&'. }

       cgMainMenu2 := cgMainMenu;

       WHILE Pos ('&', cgMainMenu2) > 0 DO
          Delete (cgMainMenu2, Pos('&', cgMainMenu2), 1);;

    END;

    { ************************************************************************ }
    { * Proc‚dure de gestion du menu d‚roulant.  C'est elle qui sera appel‚e * }
    { * lorsque le clic de la souris se fera sur la toute premiŠre ligne de  * }
    { * l'‚cran.                                                             * }
    { ************************************************************************ }

    PROCEDURE MainMenuHandle;

    VAR
       Old : TMenuOption;
       I   : Byte;

    BEGIN

       Old := '';

       FOR I := 1 TO cgSubMenuNumber DO
          BEGIN

             Old := GetNextSubMenu(Old);
             IF Mouse_InArea (GetPosSubMenu (Old) - 1,
                  GetPosSubMenu (Old)+Length (Old), 0, 15) THEN
                BEGIN
                   HighLigthMainMenu (Old);
                   Break;
                END;
          END;

    END;

    { ************************************************************************ }
    { * Masque le curseur en mode texte.                                     * }
    { ************************************************************************ }

    PROCEDURE Cursor_Hide;  ASSEMBLER;

    ASM

        Mov  Ah, 01h
        Mov  Ch, 20
        Int  10h

    END;

    { ************************************************************************ }
    { * R‚tablit le curseur en mode texte.                                   * }
    { ************************************************************************ }

    PROCEDURE Cursor_Show;  ASSEMBLER;

    ASM

        Mov  Ah, 01h
        Mov  Cl, 7
        Mov  Ch, 6
        Int  10h

    END;

    { ************************************************************************ }
    { * Run_Menu va se faire fort de simplifier au MAXIMUM l'‚criture d'un   * }
    { * menu puisqu'il suffira d'associer dans le programme une association  * }
    { * entre l'option et la proc‚dure ad'hoc.  Une fois que les liens ont   * }
    { * ‚t‚ ‚tabli, il suffit d'appeler cette proc‚dure.                     * }
    { ************************************************************************ }

    PROCEDURE Run_Menu;

    VAR
       Ch : Char;

    BEGIN

       TextAttr := 31;
       ClrScr;

       Cursor_Hide;

       { Signale que nous allons travailler avec des donn‚es de type caractŠre }

       cgCoordonnees := cgCharacter;

       { Ajoute un handler … celui de la souris.  La r‚gion d‚limit‚e est celle
         de la barre de menus. }

       Mouse_AddHandler (0, 79, 0, 0, MainMenuHandle);

       { Affiche la barre de menu }

       TextAttr := cgMainMenuAttr;
       WriteBarMenu;

       CopyPage (0, 1);

       IF bMouse_Exist THEN
          BEGIN

             Mouse_Show;

             Repeat

                IF Mouse_Pressed = cgMouse_Left THEN
                   Mouse_Handle
                ELSE
                   IF Mouse_Pressed = cgMouse_Right THEN
                        bEXIT := TRUE
                   ELSE IF KeyPressed THEN
                      BEGIN

                         Ch := ReadKey; IF Ch = #0 THEN Ch := Readkey;

                         CASE Ch OF
                           #72 : ; {UpArrow}
                           #80 : ; {DownArrow}
                           #75 : ; {LeftArrow}
                           #77 : ; {RightArrow}
                         END;

                      END;

             Until bEXIT;

             Delay (250);

             Mouse_Hide;
             Mouse_Flush;

          END;

       Cursor_Show;

       TextAttr := 7;
       ClrScr;

    END;

    VAR
       I   : Word;
       Old : String;

    BEGIN

       IF bMouse_Exist THEN
          BEGIN
             Old := '';
             FOR I := 1 TO cgSubMenuNumber DO
                BEGIN
                   Old := GetNextSubMenu(Old);
                   cgSubMenu[I] := Old;
                END;

             InitAllSubMenu;

             hClicNotInArea := @OtherArea;
          END
       ELSE
          BEGIN
             Writeln  ('');
             Writeln  ('');
             Writeln  ('');
             Writeln  ('Sorry, but a mouse driver is absolutly needed to run this program.');
             Writeln  ('So, please load a driver such as MOUSE.COM');
             Writeln  ('');
             Writeln  ('');
             Halt (0);
          END;

    END.

    { -------------------   DEMO  ---------------------- }
    {   This program also needs MENU.INC which is below !! }

    { $A+,B-,D+,E+,F-,G-,I+,L+,N-,O-,P-,Q-,R-,S+,T-,V+,X+}
    {$M 8384,0,655360}

    USES Crt, uMouse, Menu;  {uMOUSE is found in MOUSE.SWG }

    { ************************************************************************ }
    { * This procedure set the bExit variable to TRUE : this tell to the menu* }
    { * engine to stop the process.                                          * }
    { ************************************************************************ }

    PROCEDURE hFileExit; FAR; BEGIN bEXIT := True; END;

    { ************************************************************************ }
    { * This procedure is the "About the author" code                        * }
    { ************************************************************************ }

    PROCEDURE hAboutMe; FAR;
    VAR
       wOldAttr : Byte;
    BEGIN

       { Hide the mouse pointer }

       Mouse_Hide;

       { Save the screen }

       CopyPage (0, 3);

       { Show a little About text. }

       wOldAttr := TextAttr;
       TextAttr := 18;
       GotoXy (25,5);
       Write ('ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»');
       GotoXy (25,6);
       Write ('º                            º°');
       GotoXy (25,7);
       Write ('º    AVONTURE CHRISTOPHE     º°');
       GotoXy (25,8);
       Write ('º        AVC  SOFTWARE       º°');
       GotoXy (25,9);
       Write ('º   BD EDMOND MACHTENS 157   º°');
       GotoXy (25,10);
       Write ('º       BOITE 53             º°');
       GotoXy (25,11);
       Write ('º      B-1080 BRUXELLES      º°');
       GotoXy (25,12);
       Write ('º         BELGIQUE           º°');
       GotoXy (25,13);
       Write ('º                            º°');
       GotoXy (25,14);
       Write ('ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ¼°');
       GotoXy (25,15);
       Write ('°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°');
       GotoXy (20,18);
       Write ('This program has been written by AVONTURE Christophe.');
       GotoXy (20,19);
       Write ('   And I distribute it *FREELY* *WITH ALL SOURCES*');
       GotoXy (20,21);
       Write (' Please email me if you use it or anything else:');
       GotoXy (25,22);
       Write ('Christophe.AVONTURE@is.belgacom.be');

       { Restore the text color attribute }

       TextAttr := wOldAttr;

       { Wait until the user pressed a mouse button }

       REPEAT
       UNTIL NOT (Mouse_Pressed = cgMouse_None);

       { And clear the mouse buffer }

       Mouse_Flush;

       { Restore the screen }

       CopyPage (3,0);

       { And reshow the mouse pointer }

       Mouse_Show;

    END;

    { ************************************************************************ }
    { *                                                                      * }
    { *                              MAIN PROGRAM                            * }
    { *                                                                      * }
    { ************************************************************************ }

    BEGIN

       ClrScr;

       TextAttr := 15;

       Writeln ('Christophe.AVONTURE@is.belgacom.be');
       Writeln ('');
       Writeln (' Try the ''þ'' menu and ''About the author'' option.');
       Writeln ('');
       Writeln (' You can quit this program by File|Exit or right clic.');
       Writeln ('');
       Writeln ('');
       Writeln ('');
       Writeln (' Sorry but the keyboard isn''t handle: only mouse events are');
       Writeln (' accepted.');
       Writeln ('');
       Writeln ('');
       Writeln (' The menu is coded into MENU.INC file and all modifications of');
       Writeln (' this file implies that you need to recompile the unit and your');
       Writeln (' program.');
       Writeln ('');
       Writeln ('');

       REPEAT
       UNTIL KeyPressed;
       ReadKey;

       {
         The cgMenuProc array will contains all procedure references to your
         code.

         You must always respect the following call :

            cgMenuProc[GetOrderSubMenu (cgSubMenu[x]),xx] := xxx;

         The cgSubMenu[x] will return the indice of the menu option and the
         xx returns the submenu option.  The xxx is the name of the procedure.

         So, if you tried this examples, the first menu option is 'þ' and the
         second is 'File'.

         In the 'þ' menu, there are two submenu option : 'About' and 'About the
         author'.  So If I want access to the first submenu option of the 'þ'
         menu option, I only need to call the
            cgMenuProc[GetOrderSubMenu (cgSubMenu[1]),1]

         The cgSubMenu[1] indentifies the 'þ' menu option and the last 1
         identifies the submenu option.

         OK, if you have understand, the following assignation
            cgMenuProc[GetOrderSubMenu (cgSubMenu[1]),2] := hAboutMe;
         tells to the menu engine that you assign to the 'þ' "About the author"
         the procedure hAboutMe.

       }

       cgMenuProc[GetOrderSubMenu (cgSubMenu[2]),11] := hFileExit;
       cgMenuProc[GetOrderSubMenu (cgSubMenu[1]),2]  := hAboutMe;

       {
         Once the cgMenuProc array fill in, you can call the Run_Menu engine.
       }

       Run_Menu;

       {
         You can only arrived here if the bExist boolean value is set to TRUE.
         See the hFileExit procedure.
       }

    END.

    { -------------------   CUT  ---------------------- }
    { -------  SAVE AS MENU.INC -------- }
    &þ
     -System box
      &About
     -Show general informations about this program
      A&bout the author
     -Show general informations about author of this program
    &File
     -File utilities
      &New
     -Create a new file
      &Open...
     -Open an existing file
      &Save
     -Save the file
      Save &as...
     -Save the current file under a different name
      Save a&ll
     -Save all modified files
      Ä
      &Change dir...
     -Choose a new default directory
      &Print
     -Print the contents of the active window
      P&rint setup...
     -Choose printer filter to use for printing
      &Dos shell
     -Temporarily exit to DOS
      E&xit
     -Exit Turbo Pascal
    &Edit
     -Edit utilities
      &Undo
     -Undo the previous editor operation
      &Redo
     -Redo the previous editor operation
      Ä
      Cu&t
     -Remove the selected text and put in into the clipboard
      &Copy
     -Copy the selected text into the clipboard
      &Paste
     -Insert selected text from the clipboard at the cursor position
      C&lear
     -Delete the selected text
      Ä
      &Show clipboard
     -Open the clipboard window
    &Search
     -Search utilities
      &Find...
     -Search for text
      &Replace...
     -Search for text and replace it with new text
      &Search again
     -Repeat the last Find or Replace command
      Ä
      &Go to line number...
     -Move the cursor to a specified line number
      S&how last compile error
     -Move the cursor to the position of the last compile error
      Find &error...
     -Move the cursor to the position of a runtime error
      Find &procedure...
     -Search for a procedure or function declaration while debugging
    &Run
     -Run utilities
      &Run
     -Run the current program
      &Step over
     -Execute next statement, skipping over the current procedure
      &Trace into
     -Execute next statement, stopping within the current procedure
      &Go to cursor
     -Run program from the run bar to the cursor position
      &Program reset
     -Halt debugging session and release memory
      P&arameters...
     -Set command line parameters to be passed to the program
    &Compile
     -Compile utilities
      &Compile
     -Compile source file
      &Make
     -Rebuild source file and all other files that have been modified
      &Build
     -Rebuild source file and all other files
      Ä
      &Destination Memory
     -Specify wheter source file is compiled to memory or disk
      &Primary file...
     -Define the file that is the focus of Make or Build
      C&lear primary file
     -Clear the file previously set with Primary file
      Ä
      &Information...
     -Show status information
    &Debug
     -Debug utilities
      &BreakPoints...
     -Set conditionnal breakpoints
      &Call stack
     -Show the procedures the program called to reach this point
      &Register
     -Open the register window
      &Watch
     -Open the Watch window
      &Output
     -Open the Output window
      &User screen
     -Swithc to the full-screen user output
      Ä
      &Evaluate/Modify...
     -Evaluate a variable or expression and display or modify the value
      &Add watch...
     -Insert a watch expression into the Watch window
      Add break&points...
     -Add a breakpoint expression
    &Tools
     -Tools utilities
      &Messages
     -Open the message window
      &Go to next
     -Go to the next source position
      &Go to previous
     -Go to the previous source position
      Ä
      &Grep
     -User installed tool
    &Options
     -Options utilities
      &Compiler...
     -Set default compiler directives
      &Memory sizes...
     -Set default stack and heap sizes for generated programs
      &Linker...
     -Set linker options (link buffer; .MAP file options)
      De&bugger...
     -Set debugger options (standalone, integrated, display swapping)
      &Directories...
     -Set path for units, inlude files, OBJs, and generated files
      &Tools...
     -Create or change tools
      Ä
      &Environment
     -Specify environment settings
      Ä
      &Open...
     -Load options previously create with Save Options
      &Save
     -Save all the settings you've made in the Options Menu
      Save &as...
     -Save all the settings in the Options Menu to another file
    &Window
     -Window utilities
      &Tile
     -Arrange windows on desktop by tiling
      C&ascade
     -Arrange windows on desktop by cascading
      Cl&ose all
     -Close all windows on desktop
      &Refresh display
     -Redraw the screen
      Ä
      &Size/Move
     -Change the size or position of the active window
      &Zoom
     -Enlarge or restore the size of the active window
      &Next
     -Make the next window active
      &Previous
     -Make the previous window active
      &Close
     -Close the active window
      Ä
      &List...
     -Show a list of all open windows
    &Help
     -Help utilities
      &Contents
     -Show table of contents for online help
      &Index
     -Show index for online help
      Ä
      &Topic search
     -Display help on the word at the cursor
      &Previous topic
     -Redisplay the last-viewed online Help screen
      Using &help
     -How to use online help
      &Files...
     -Add or delete installated help files
      Ä
      Compiler &directives
     -Display help above the compiler directives
      &Reserved word
     -Display Turbo Pascal's reserved words
      Standard &units
     -Display help about standard Turbo Pascal units
      Turbo Pascal &Language
     -Display help about Turbo Pascal language
      &Error messages
     -Display help about the error messages
      Ä
      &About...
     -Show version and copyright information

[Back to MENU SWAG index] [Back to Main SWAG index] [Original]