[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]