CP/M/CPM_CDROM.iso/mbug/mbug174.arc/FILECARD.LBR/MENU.PYS/MENU.PYS

Text File | 1979-12-31 | 4KB | 152 lines

Program MENU;
{This menu is written for the File Card Database.}

Var
   Disk:       File;
   Inkey:      Char;
   A, B, X, Y: Integer;
   Line:       String[80];
   Flag:       Boolean;

Procedure IOError;
Var
   Num:   Integer;
   IOErr: Boolean;
   Key:   Char;

Begin
   Num := 0;
   IOErr := false;
   Num := IOresult;
   IOErr := (Num <> 0);
   If IOErr then
   Begin
      Write(chr(7));
      Clrscr;
      Gotoxy(20,12);
      Case Num of
         $01:  Write('File does not exist');
         $02:  Write('File not open for input');
         $03:  Write('File not open for output');
         $04:  Write('File not open');
         $05:  Write('Can''t read from this file');
         $06:  Write('Can''t write to this file');
         $10:  Write('Error in numeric format');
         $20:  Write('Operation not allowed on a logical device');
         $21:  Write('Not allowed in the direct mode');
         $22:  Write('Assign to standard files not allowed');
         $90:  Write('Record length mismatch');
         $91:  Write('Seek beyond end of file');
         $99:  Write('Unexpected end of file');
         $F0:  Write('Disk write error');
         $F1:  Write('Directory is full');
         $F2:  Write('File size overflow');
         $FF:  Write('File dissappeared!');
         Else  Write('Unknown I/O Error: ',Num:3);
      End;
      Gotoxy(20,14);
      Write('Type any key to continue... ');
      Read(Kbd,Key);
      Assign(Disk,'MENU.COM');
      Execute(Disk);
   End;
End;

Procedure CenterText;
Begin
   A := length(Line);
   B := 80 - A;
   X := B div 2;
   Gotoxy(X,Y);
   Write(Line);
End;

Procedure DrawMenu;
Begin
   Clrscr;
   Y := 2; Line := ('FILE CARD DATABASE'); CenterText;
   Y := 4; Line := ('(c) 1984 by'); CenterText;
   Y := 6; Line := ('Thomas R. Mierau'); CenterText;
   Y := 8; Line := ('( Compiled with Turbo Pascal for the Microbee )'); CenterText;
   Writeln;
   For A := 1 to 80 do
   Begin
      Write('-');
   End;
   Y := 12; Line := ('<A>  Create a new database'); CenterText;
   Y := 14; Gotoxy(X,Y); Write('<B>  Add records to database');
   Y := 16; Gotoxy(X,Y); Write('<C>  Access existing records');
   Y := 18; Gotoxy(X,Y); Write('<D>  Display key words');
   Y := 20; Gotoxy(X,Y); Write('<ESC>  Quit');
   Gotoxy(60,22); Write('Please select: ');
End;

Procedure Choice;
Begin
   Flag := false;
   Repeat
      Gotoxy(75,22);
      Read(Kbd,Inkey);
      Inkey := upcase(Inkey);

      If Inkey = chr(27) then Flag := true;

      If Inkey = 'A' then
      Begin
         Clrscr;
         Writeln('WARNING: This subprogram erases all existing data from the database.');
         Writeln('use only if you wish to start a new database.');
         Writeln;
         Writeln;
         Write('Type "*" to continue...any other key to abort: ');
         Read(Kbd,Inkey);
         If Inkey = '*' then
         Begin
            {$I-}
            Assign(Disk,'NEWFILE.CHN');
            Chain(Disk);
            IOError;
            {$I+}
         End;
         Inkey := chr(0);
         DrawMenu;
      End;

      If Inkey = 'B' then
      Begin
         Clrscr;
         {$I-}
         Assign(Disk,'MAINBODY.CHN');
         Chain(Disk);
         IOError;
         {$I+}
      End;

      If Inkey = 'C' then
      Begin
         Clrscr;
         {$I-}
         Assign(Disk,'RETRIEVE.CHN');
         Chain(Disk);
         IOError;
         {$I+}
      End;

      If Inkey = 'D' then
      Begin
         Clrscr;
         {$I-}
         Assign(Disk,'SORTFILE.CHN');
         Chain(Disk);
         IOError;
         {$I+}
      End;

   Until Flag;
   Clrscr;
End;

Begin
   Drawmenu;
   Choice;
End.