home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / MBUG / MBUG094.ARC / USERMENU.PAS < prev   
Pascal/Delphi Source File  |  1979-12-31  |  3KB  |  100 lines
  1. {This program gives a user menu }
  2. {To tailor this program for your own needs you only need to
  3.       1. Pick the correct value for ComBuffAddr
  4.       2. Type in your heading (line  )
  5.       3. Change the contents of the constant DISPLAY
  6.           A) Type in the key for highlighting as the selection
  7.           B) Type in the comment to be displayed beside this letter
  8.           C) Type in the the command to be performed in response to
  9.                the key pressed
  10.       4. Compile to disk.
  11.  
  12.   This will now give you a menu that will run the appropriate commands
  13.   }
  14. {$U+}
  15. var
  16.    ComBuffAddr:integer absolute $E860 { Hard Disk 128K use $E65C,
  17.                                         workstations use $D682
  18.                                         Floppy 5.25 128K use $E860 };
  19.    x:integer;
  20.    Command: string[100];
  21.    charval,maxcount,count :integer;
  22.    Ch:Char;
  23.  
  24.  
  25. Procedure Wellcome;
  26.  
  27. vAR x:integer;
  28.     Name:string[20];
  29.  
  30. begin
  31.      ClrScr;
  32.      Write('Please type in your name then press the RETURN key ');
  33.      Readln(Name);
  34.      for x:=1 to 5 do
  35.          begin
  36.               ClrScr;
  37.               Delay(200);
  38.               Writeln(^G^G^G'               W E L L C O M E '#10#10);
  39.               LowVideo;
  40.               Writeln(name:20,#10#10);
  41.               NormVideo;
  42.               Writeln('T o  D O N V A L E  C H R I S T I A N  S C H O O L');
  43.               Delay(500)
  44.          END
  45. END;
  46.  
  47. Procedure CompSciMenu;
  48. Var
  49.    Ch:Char;
  50.    GoodResponses:string[10];
  51.    Posn:integer;
  52. Type
  53.    Selection=record
  54.                Key:string[1];
  55.                Comment:string[40];
  56.                CommandS:string[50];
  57.              end;
  58.    Menu=array[1..10] of selection;
  59. Const
  60.    Display:Menu=
  61.                 ((Key:'S';Comment:'Student Database';CommandS:'SDATA'),
  62.                  (Key:'M';Comment:'Matchmaker';CommandS:'MATCH'),
  63.                  (Key:'L';Comment:'Low Level Programming';CommandS:'LOWLEV'),
  64.                  (Key:#0;Comment:'Animal';CommandS:'E:;ANIMAL'),
  65.                  (Key:#0;Comment:'End of Menu';CommandS:'None'),
  66.                  (Key:'';Comment:'';CommandS:''),
  67.                  (Key:'';Comment:'';CommandS:''),
  68.                  (Key:'';Comment:'';CommandS:''),
  69.                  (Key:'';Comment:'';CommandS:''),
  70.                  (Key:'';Comment:'';CommandS:''));
  71. Begin  {Menu}
  72.   ClrScr;
  73.   WriteLn('Computer Science Menu'#10#10#10);   {Heading}
  74.   Count:=1;
  75.   GoodResponses:='';
  76.   repeat
  77.     LowVideo;Write(Display[count].Key);HighVideo;
  78.     Writeln(' - ',Display[count].Comment,#10,#13);
  79.     GoodResponses:=GoodResponses+Display[count].Key;
  80.     Count:=Count+1
  81.   until Display[Count].Key=#0;
  82.   Writeln(#10#10#13'Press the letter of your Choice');
  83.   Repeat
  84.     Read(Kbd,Ch);
  85.     Posn:=Pos(UpCase(Ch),GoodResponses);
  86.   until Posn<>0;
  87.   Command:=Display[Posn].CommandS;
  88.   LowVideo;writeln('PLEASE WAIT');HighVideo;
  89. end; {Menu}
  90.  
  91.  
  92. Begin
  93.     Wellcome;
  94.     CompSciMenu;
  95.     If Command<>'' then begin
  96.       Command:=';'+Command+chr(0);
  97.       for x:=1 to length(command) do mem[ComBuffAddr+x-1]:=ord(Command[x]);
  98.     end;
  99. end.
  100.