home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / TURBOPAS / EBMENU.ZIP / EBMDEMO.PAS next >
Encoding:
Pascal/Delphi Source File  |  1985-05-28  |  7.9 KB  |  194 lines
  1. {Demonstration program for the EBMenu function. Just compile this and
  2.  run it to see some simple samples of how this function can be used.  }
  3.  
  4. { Author: Ed Bachmann                5/28/85
  5.           9421 Mellenbrook Rd.
  6.           Columbia,Md. , 21045
  7.           Please send comments and suggestions to me on one
  8.           of the following remote bulletin board systems:
  9.             Elkridge-All-Purpose    (301) 796-1223
  10.             Capital PC Stat SIG     (301) 596-3569
  11.             Forbin Project          (319) 266-8086
  12.                                                                           }
  13.  
  14. (*$IEBMENU.PAS*)      {this file must be on your Turbo current directory}
  15.  
  16. var
  17.   ActionCode1,ActionCode2,ActionCode3 : integer;
  18.   Fcolor,Bcolor,NewFcolor,NewBcolor   : Byte;
  19.   BlinkOn                             : Boolean;
  20.  
  21. begin
  22.   Textcolor(Black);
  23.   TextBackground(White);
  24.   BlinkOn:=False;
  25.   ClrScr;
  26.   GotoXY(1,6);
  27.   Write('    Hello, This Is a Demonstration of the EBMenu Turbo Pascal Function.');
  28.   GotoXY(1,10);
  29.   Write(' What type of monitor are you using? (Use the Cursor Keys to Change Selection.)');
  30.   ActionCode1:=0;
  31.   Repeat
  32.          { force user to select a field, use lines 12 and 14, start w/ No}
  33.     ActionCode1:=EBMenu(2,12,14,White,Black,0,2,
  34.         '  Are You Using A Color Monitor?        ',
  35.         'Yes       No',
  36.         '  Press the enter key to set up the demo for a Color Monitor.',
  37.         '  Press the enter key to set up the demo for a Monochrome or B/W Monitor.',
  38.         '3','4','5','6','7','8','9','10');
  39.   Until ActionCode1<>0;
  40.   Fcolor:=White;
  41.   Bcolor:=Black;
  42.   ClrScr;
  43.   if ActionCode1=1 then Bcolor:=Blue;
  44.   ActionCode1:=1;
  45.   while (ActionCode1<>5) do
  46.   begin
  47.     TextBackground(Black);
  48.     TextColor(White);
  49.     GotoXY(1,6);
  50.     TextBackground(Bcolor);
  51.     TextColor(Fcolor);
  52.     if BlinkOn then TextColor(Fcolor+Blink);
  53.     Write('          Demonstration of the EBMenu Turbo Pascal Function.');
  54.     ClrEol;
  55.              {escape not allowed, use line 1 & 2, start at last returned
  56.               menu item number }
  57.     ActionCode1:=EBMenu(2,1,2,Fcolor,Bcolor,ActionCode1,5,
  58.         '  Do You Want To:',
  59.         '   Change-Colors   Beep   Flash   Sound   End-Demo',
  60.         '  Change the forground and background colors.',
  61.         '  Make your PC sound the Beep Tone.',
  62.         '  Set Blinking of the line below on or off.',
  63.         '  Make your PC whine a little bit.',
  64.         '  Terminate the demo.','6','7','8','9','10');
  65.     Case ActionCode1 of
  66.         1 : begin
  67.               ActionCode2:=1;
  68.               NewFcolor:=Fcolor;
  69.               NewBcolor:=BColor;
  70.               while (ActionCode2>0) and (ActionCode2<3) do
  71.               begin
  72.                 GotoXY(1,20);
  73.                 Write('          Forground color: ',NewFcolor,' ');
  74.                 if NewFcolor>7 then Write('Bright ');
  75.                 case (NewFcolor mod 8) of
  76.                    0 : Write('Black');
  77.                    1 : Write('Blue');
  78.                    2 : Write('Green');
  79.                    3 : Write('Cyan');
  80.                    4 : Write('Red');
  81.                    5 : Write('Magenta');
  82.                    6 : Write('Brown');
  83.                    7 : Write('White');
  84.                 end;
  85.                 Write('; Background color: ',NewBcolor,' ');
  86.                 case NewBcolor of
  87.                    0 : Write('Black');
  88.                    1 : Write('Blue');
  89.                    2 : Write('Green');
  90.                    3 : Write('Cyan');
  91.                    4 : Write('Red');
  92.                    5 : Write('Magenta');
  93.                    6 : Write('Brown');
  94.                    7 : Write('White');
  95.                 end;
  96.                 ClrEol;
  97.                 {escape IS allowed, use lines 1 & 2, start at last code
  98.                  returned }
  99.                 ActionCode2:=EBMenu(1,1,2,Fcolor,Bcolor,ActionCode2,5,
  100.                 '  Color setting:',
  101.                 '  Forground  Background  MonoChrome  Abort  Set-Them-And-Exit',
  102.                 '  Change the forground colors.',
  103.                 '  Change the Background colors.',
  104.                 '  Change to Black on White.',
  105.                 '  Do not do any color changes - even if you have set new ones.',
  106.                 '  Do the color changes and exit from the color setting menu.',
  107.                 '6','7','8','9','10');
  108.                 case ActionCode2 of
  109.                 1 : begin
  110.                      {escape IS allowed, use line 3 (no explanation), start at
  111.                      last color set menu item number }
  112.                      ActionCode3:=EBMenu(3,3,0,Fcolor,Bcolor,(NewFcolor+1),8,
  113.                      ' Forground Color:',
  114.                      ' 0-Black 1-Blue 2-Green 3-Cyan 4-Red 5-Magenta 6-Brown 7-White',
  115.                      '1','2','3','4','5','6','7','8','9','10');
  116.                      if ActionCode3>58 then
  117.                        begin
  118.                          if ActionCode3=68 then ActionCode3:=58; {change F10}
  119.                          ActionCode3:=ActionCode3-57; {convert f1-f10 to 2-11}
  120.                          if (ActionCode3>8) then ActionCode3:=0;
  121.                        end;
  122.                      if (ActionCode3>0) then NewFcolor:=ActionCode3-1;
  123.                      {escape IS allowed, use lines 4 & 5,
  124.                      start at 1 always }
  125.                      ActionCode3:=EBMenu(1,4,5,Fcolor,Bcolor,1,2,
  126.                      '  Do You Want them bright?',
  127.                      '   Yes     No',
  128.                      '  Use Bright Colors.','Use Normal Intensity Colors',
  129.                      '3','4','5','6','7','8','9','10');
  130.                      case ActionCode3 of
  131.                        1 : NewFcolor:=(NewFcolor mod 8) + 8;
  132.                        2 : NewFcolor:=(NewFcolor mod 8);
  133.                      end;
  134.                     end;
  135.                 2 : begin
  136.                      {escape IS allowed & function keys also work,
  137.                      use line 5 (no explanation), start at
  138.                       last color set menu item number }
  139.                      ActionCode3:=EBMenu(3,5,0,Fcolor,Bcolor,(NewBcolor+1),8,
  140.                      ' Background Color:',
  141.                      ' 0-Black 1-Blue 2-Green 3-Cyan 4-Red 5-Magenta 6-Brown 7-White',
  142.                      '1','2','3','4','5','6','7','8','9','10');
  143.                      if ActionCode3>58 then
  144.                        begin
  145.                          if ActionCode3=68 then ActionCode3:=58; {change F10}
  146.                          ActionCode3:=ActionCode3-57; {convert f1-f10 to 2-11}
  147.                          if (ActionCode3>8) then ActionCode3:=0;
  148.                        end;
  149.                      if (ActionCode3>0) then NewBcolor:=ActionCode3-1;
  150.                     end;
  151.                 3 : begin
  152.                       Fcolor:=White;
  153.                       Bcolor:=Black;
  154.                     end;
  155.                 5 : begin
  156.                       If NewFcolor=NewBcolor then
  157.                         begin
  158.                           ActionCode3:=1;
  159.                           Write(^G);
  160.                         end
  161.                       else
  162.                         begin
  163.                           Fcolor:=NewFcolor;
  164.                           Bcolor:=NewBcolor
  165.                         end;
  166.                     end;
  167.                 end;
  168.                end
  169.             end;
  170.         2 : Write(^G);
  171.         3 : Begin
  172.               if BlinkOn then BlinkOn:=False
  173.               else BlinkOn:=True;
  174.             end;
  175.         4 : begin
  176.               for ActionCode3:=500 to 2000 do
  177.               begin
  178.                 Sound(ActionCode3);
  179.                 Delay(1);
  180.               end;
  181.               NoSound;
  182.             end;
  183.     end;  {end of case}
  184.   end;
  185.   GotoXY(1,21);
  186.   WriteLn('Thanks for trying EBMenu. Hope it can be of use. Do with it as you will.');
  187.   WriteLn(' Ed Bachmann 5/28/85');
  188. end.
  189. me for display}
  190.    while not ExitMenu do
  191.    begin
  192.      while Ch1=chr(222) do
  193.      begin
  194.        if keypressed then