home *** CD-ROM | disk | FTP | other *** search
/ Netware Super Library / Netware Super Library.iso / menu_pgm / mcmenu / textmenu.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-08-22  |  9.0 KB  |  332 lines
  1. UNIT TextMenu;
  2.  
  3. { Oct 9 1991 Tony Bigras }
  4. {
  5.  made wide max and better centering on large menus and 20 items nov 20
  6.  wider still with error traping of to wide  feb 4 92
  7.  raised menu a little higher with more than 10 items
  8.  
  9.  added alpha keying   feb 8 92
  10.  1.001 bug fix in alpha keying feb 25 92
  11.  1.010 added 1 space white space on right side of menu txt
  12. }
  13.  
  14. {$D-,S-}
  15.  
  16. INTERFACE
  17.  
  18. USES Crt,SysSup,Win;
  19.  
  20. CONST
  21.   mxmenustrlen=74;
  22.   mxmenuwidth=mxmenustrlen+7;
  23.   mxonmenu=21;
  24. TYPE
  25.   txtctrltype = (normal,
  26.          reverse,
  27.          flashing);
  28.  
  29.   menuctrltype= RECORD
  30.                   sort: BOOLEAN;
  31.                   wrap: BOOLEAN;
  32.                   escape: BOOLEAN;
  33.                   alphakey: BOOLEAN;
  34.                 END;
  35.   keysettype = SET OF CHAR;
  36.  
  37.   menustr = STRING[mxmenuwidth-4];
  38.   txtmenux = 0..76;
  39.   txtmenuy = 0..22;
  40.   txtmenunum = 0..mxonmenu; { 0 = esc }
  41.   modetype = (wipe,replace);
  42.  
  43.   winrec = record
  44.     state: winstate;
  45.     buffer: POINTER;
  46.   END;
  47.  
  48.   winrecptr = ^winrec;
  49.   menutype = RECORD
  50.            title: menustr;
  51.             item: ARRAY[1..mxonmenu] OF menustr;
  52.            numitem: txtmenunum;
  53.            x: txtmenux;
  54.            y: txtmenuy;
  55.             w: 1..mxmenuwidth;
  56.            oldselect: txtmenunum;
  57.            mode: modetype;
  58.             wn: winrecptr;
  59.             titlehelp:helpstr;
  60.             itemhelp: ARRAY[1..mxonmenu] OF helpstr;
  61.             ctrl: menuctrltype;
  62.          END;
  63.  
  64.   frametype = (single,double);
  65.  
  66. VAR
  67.   txtmode: txtctrltype;
  68.   txtcur: txtctrltype;
  69.   menuactive: BOOLEAN;  { set by caller to FALSE and set bye menu to TRUE
  70.                           as soon as user starts moving on menu.
  71.                           Intended to be read by concurent processes }
  72.  
  73.   PROCEDURE getxy(VAR x,y: INTEGER);
  74.   PROCEDURE txtwr(x,y: INTEGER; str: STRING);
  75.   PROCEDURE txtmenuinit( VAR menu: menutype;
  76.               x: txtmenux;         { if 0 centre }
  77.              y: txtmenuy);        { if 0 centre }
  78.   PROCEDURE txtmenukill(VAR menu: menutype);
  79.   PROCEDURE openwindow(X1, Y1, X2, Y2: Byte;VAR w: winrecptr);
  80.   PROCEDURE closewindow(VAR w: winrecptr);
  81.   FUNCTION  txtmenu( VAR menu: menutype): INTEGER;
  82.             { 0 = escaped  else selection }
  83.  
  84. IMPLEMENTATION
  85.  
  86.   VAR
  87.     background,foreground: INTEGER;
  88.  
  89.     txtupdownetc,updownetc,arrowetc: keysettype;
  90.   PROCEDURE getxy(VAR x,y: INTEGER);
  91.   BEGIN { getxy }
  92.     X:= wherex;
  93.     y:= wherey;
  94.   END; { getxy }
  95.  
  96.   PROCEDURE txtwr(x,y: INTEGER; str: STRING);
  97.   BEGIN { txtwr }
  98.     gotoxy(x,y);
  99.     write(str);
  100.     gotoxy(x,y);
  101.   END; { txtwr }
  102.  
  103.   PROCEDURE openwindow(x1, y1, x2, y2: BYTE;VAR w: winrecptr);
  104.   BEGIN
  105.     NEW(w);
  106.     WITH w^ DO
  107.     BEGIN
  108.       savewin(state);
  109.       window(x1, y1, x2, y2);
  110.       GETMEM(buffer, winsize);
  111.       readwin(buffer^);
  112.     END;
  113.   END;
  114.  
  115.   PROCEDURE closewindow(VAR w: winrecptr);
  116.   BEGIN
  117.     WITH w^ DO
  118.     BEGIN
  119.       writewin(buffer^);
  120.       FREEMEM(buffer, winsize);
  121.       restorewin(state);
  122.     END;
  123.     DISPOSE(w);
  124.   END;
  125.  
  126.   PROCEDURE showone(num: INTEGER; menuitem: STRING; reverse: BOOLEAN);
  127.   BEGIN { showone }
  128.     IF reverse= TRUE THEN
  129.     BEGIN
  130.       IF lastmode=mono THEN
  131.       BEGIN
  132.        background:=lightgray;
  133.         foreground:=black;
  134.       END
  135.       ELSE
  136.       BEGIN
  137.         background:=lightgray;
  138.         foreground:=blue;
  139.       END;
  140.     END
  141.     ELSE
  142.     BEGIN
  143.       IF lastmode=mono THEN
  144.       BEGIN
  145.        background:=black;
  146.        foreground:=white;
  147.       END
  148.       ELSE
  149.       BEGIN
  150.         background:=blue;
  151.         foreground:=white;
  152.       END;
  153.     END;
  154.     writestr(1,num+2,menuitem,foreground +background * 16);
  155.   END; { showone }
  156.  
  157.   FUNCTION  txtmenu( VAR menu: menutype): INTEGER;
  158.  
  159.   VAR
  160.     i:  INTEGER;
  161.  
  162.     FUNCTION  select: INTEGER;
  163.     VAR
  164.       key: CHAR;
  165.       tmenu: menutype;
  166.       i,j,cnt: INTEGER;
  167.       alpha: STRING[80];
  168.       nonalpha,matched: BOOLEAN;
  169.     BEGIN { select }
  170.       IF menu.ctrl.alphakey THEN
  171.       BEGIN
  172.         nonalpha:= TRUE;
  173.         tmenu:= menu;
  174.         FOR i:= 1 TO tmenu.numitem DO
  175.         BEGIN
  176.           FOR j:= 1 to LENGTH(tmenu.item[i]) DO
  177.             tmenu.item[i][j]:= upcase(tmenu.item[i][j]);
  178.           tmenu.item[i]:=COPY(tmenu.item[i],4,LENGTH(tmenu.item[i])-3);
  179.           { strip pretty bar from front of item }
  180.         END;
  181.       END; { alphakey }
  182.       showone(menu.oldselect,menu.item[menu.oldselect],TRUE);
  183.       REPEAT
  184.         key:= allowkey(txtupdownetc,-1);
  185.         menuactive:= TRUE; { somebody is moving around on menu }
  186.         CASE key OF
  187.           CHR(up):
  188.           BEGIN
  189.             nonalpha:= TRUE;
  190.             showone(menu.oldselect,menu.item[menu.oldselect],FALSE);
  191.             IF (menu.oldselect = 1) AND menu.ctrl.wrap THEN
  192.                menu.oldselect:= menu.numitem
  193.             ELSE
  194.               menu.oldselect:= max(1,menu.oldselect-1);
  195.            showone(menu.oldselect,menu.item[menu.oldselect],TRUE);
  196.          END; { up }
  197.  
  198.          CHR(down):
  199.          BEGIN
  200.            nonalpha:= TRUE;
  201.            showone(menu.oldselect,menu.item[menu.oldselect],FALSE);
  202.            IF (menu.oldselect = menu.numitem) AND menu.ctrl.wrap THEN
  203.              menu.oldselect:= 1
  204.            ELSE
  205.              menu.oldselect:= min(menu.numitem,menu.oldselect+1);
  206.            showone(menu.oldselect,menu.item[menu.oldselect],TRUE);
  207.           END; { down }
  208.  
  209.           CHR(32)..CHR(127):
  210.           BEGIN
  211.             showone(menu.oldselect,menu.item[menu.oldselect],FALSE);
  212.             IF nonalpha THEN
  213.             BEGIN
  214.               nonalpha:= FALSE;
  215.               alpha:= '';
  216.             END; { start alpha keying again as it was interupted }
  217.             alpha:= CONCAT(alpha,upcase(key));
  218.             matched:= FALSE;
  219.             cnt:= 0;
  220.             REPEAT
  221.              cnt:= cnt+1;
  222.              { 1.001 matched from <>0 to =1   }
  223.              matched:= POS(alpha,COPY(tmenu.item[cnt],1,LENGTH(alpha)+1))=1;
  224.             UNTIL (matched OR (cnt > menu.numitem));
  225.  
  226.             IF NOT matched THEN
  227.             BEGIN
  228.               nonalpha:= TRUE;
  229.               sound(300);
  230.               delay(100);
  231.               nosound;
  232.             END; { NOT matched }
  233.             IF matched THEN
  234.               menu.oldselect:=cnt;
  235.             showone(menu.oldselect,menu.item[menu.oldselect],TRUE);
  236.           END; { alpha }
  237.  
  238.         END; { CASE key }
  239.         IF menu.itemhelp[menu.oldselect]<>'' THEN
  240.           curhelp:=menu.itemhelp[menu.oldselect]
  241.         ELSE
  242.           curhelp:=menu.titlehelp;
  243.       UNTIL key IN [CHR(esc),CHR(return)];
  244.       IF key = CHR(esc) THEN
  245.         select:= 0
  246.       ELSE
  247.       select:= menu.oldselect
  248.     END; { select }
  249.  
  250.   BEGIN { txtmenu }
  251.     { 0 = escaped  ELSE 1..x = selection }
  252.     txtmenu:= select;
  253.   END; { txtmenu }
  254.  
  255.   PROCEDURE txtmenuinit( VAR menu: menutype;
  256.               x: txtmenux;
  257.              y: txtmenuy);
  258.   VAR
  259.     maxstrlen,i: INTEGER;
  260.  
  261.     PROCEDURE showall;
  262.     VAR
  263.       i: INTEGER;
  264.     BEGIN { showall }
  265.       IF lastmode=mono THEN
  266.       BEGIN
  267.         splitbox(doubleframe,white + black * 16,3);
  268.         writestr(1,1,menu.title,white + black * 16);
  269.       END
  270.       ELSE
  271.       BEGIN
  272.         splitbox(doubleframe,yellow + blue * 16,3);
  273.         writestr(1,1,menu.title,white + blue * 16);
  274.       END;
  275.       FOR i:= 1 to menu.numitem DO
  276.         showone(i,menu.item[i],FALSE);
  277.     END; { showall }
  278.  
  279.   BEGIN { txtmenuinit }
  280.      txtupdownetc:=updownetc;
  281.      IF menu.ctrl.escape THEN
  282.        txtupdownetc:=txtupdownetc+[CHR(esc)];     IF menu.ctrl.alphakey THEN
  283.        txtupdownetc:=txtupdownetc+[CHR(32)..CHR(127)];      FOR i:= 1 to menu.numitem DO
  284.        IF LENGTH(menu.item[i])>mxmenustrlen THEN
  285.          menu.item[i][0]:=CHR(mxmenustrlen);
  286.      IF LENGTH(menu.title)>mxmenustrlen THEN
  287.        menu.title[0]:=CHR(mxmenustrlen);
  288.      menu.w:=1;
  289.      { 1.010 added space to menu items length }
  290.      FOR i:= 1 TO menu.numitem DO
  291.        menu.w:=max(LENGTH(menu.item[i])+1,menu.w);
  292.      IF (LENGTH(menu.title) MOD 2)=0 THEN
  293.        menu.title:= CONCAT(' ',menu.title);
  294.      menu.w:=max(LENGTH(menu.title),menu.w);
  295.      FOR i:= 1 TO menu.numitem DO
  296.        menu.item[i]:=
  297.        CONCAT(' │ ',menu.item[i],COPY(blanks,1,menu.w-LENGTH(menu.item[i])));
  298.      menu.title:=
  299.      CONCAT(COPY(blanks,1,((menu.w-LENGTH(menu.title)) DIV 2)+1),menu.title);
  300.      menu.w:= menu.w+4;
  301.      IF x<>0 THEN
  302.        menu.x:= x
  303.      ELSE
  304.        menu.x:=((80-menu.w) DIV 2) + 1;
  305.      IF y<>0 THEN
  306.        menu.y:= y
  307.      ELSE
  308.        menu.y:=max(1,(25-(menu.numitem+4)) DIV 2);
  309.      openwindow(menu.x,menu.y,menu.x+menu.w,menu.y+menu.numitem+3,menu.wn);
  310.      IF lastmode=mono THEN
  311.        fillwin(#32,lightgray+black*16)
  312.      ELSE
  313.        fillwin(#32,cyan + blue * 16);
  314.      showall;
  315.   END; { txtmenuinit }
  316.  
  317.   PROCEDURE txtmenukill(VAR menu: menutype);
  318.   BEGIN
  319.     unframewin;
  320.     closewindow(menu.wn);
  321.   END;
  322.  
  323. BEGIN { TextMenu }
  324.   arrowetc:=
  325.     [CHR(esc),CHR(return),CHR(space),CHR(up),CHR(down),CHR(left),CHR(right)];
  326.   updownetc:=
  327.     [CHR(return),CHR(up),CHR(down)];
  328.   menuactive:= FALSE;
  329. END. { TextMenu }
  330.  
  331.  
  332.