Power-Programmierung/CD1.mdf/pascal/library/dos/sampler/01/counter/counter3.pas

Pascal/Delphi Source File | 1988-09-09 | 25.3 KB | 974 lines

{
                       F i l e    I n f o r m a t i o n

* DESCRIPTION
Include source code file for COUNTER.PAS.

* ASSOCIATED FILES
COUNTER.PAS
COUNTER1.PAS
COUNTER2.PAS
COUNTER3.PAS
COUNTER.EXE

}


{-------------------------------------------------- procedure OpeningScreen }

{
purpose: to display the opening screen.
}

procedure OpeningScreen;

var
 ch:char;

begin {procedure OpeningScreen}

 clrscr;
 SetTextType(Rev);
 gotoxy(23,1);
 write(' COUNTER version 2.0 (2/15/1988) ');
 SetTextType(High);
 gotoxy(5,3);
 write('This program allows you to define up to 20 keys on your keyboard as');
 gotoxy(5,4);
 write('counters.');
 gotoxy(5,6);
 write('First, you will enter the keys you wish to define.  Note that upper-');
 gotoxy(5,7);
 write('case and lower-case letters are considered DIFFERENT characters.  It');
 gotoxy(5,8);
 write('is not possible to modify the defined keys once the program starts');
 gotoxy(5,9);
 write('running.  If no keys are defined the program terminates execution.');
 gotoxy(5,11);
 write('Second, you will enter a label for each key.  This label may be up');
 gotoxy(5,12);
 write('to 20 characters long.  Once the label(s) are entered they cannot be');
 gotoxy(5,13);
 write('edited.');
 gotoxy(5,15);
 write('Finally, COUNTER is ready to start counting the number of times you');
 gotoxy(5,16);
 write('hit the defined key(s).  You may choose between addition and sub-');
 gotoxy(5,17);
 write('traction mode.  The program is set to start all counters at zero');
 gotoxy(5,18);
 write('and to operate within the range of 0 to 32767.  However, you may');
 gotoxy(5,19);
 write('modify these parameters by setting the appropriate constant values');
 gotoxy(5,20);
 write('in the file ''COUNTER1.PAS'' and recompiling the program with Turbo');
 gotoxy(5,21);
 write('Pascal version 4.0 (or later).');
 gotoxy(5,23);
 write('Only the menu options in ');  SetTextType(Rev);
 write('reverse video');              SetTextType(High);
 write(' are available.  ');          SetTextType(HighUndBlink);
 write('Good Luck!!');
 SetTextType(Rev);
 gotoxy(18,25);
 write(' Hit any key to start COUNTER or <ESC> to quit. ');
 SetTextType(Norm);
 ch:=ReadKey;
 if ch=#27 then halt;

end; {procedure OpeningScreen}

{------------------------------------------------ procedure DefineKeys }

{
purpose: to get the keys that the user wishes to define as counters.
}

procedure DefineKeys;

var
 ok,InvalidChar:boolean;
 ch,cht:char;
 i,j:byte;


begin {procedure DefineKeys}
 ok:=false;

 clrscr;
 SetTextType(Rev);
 gotoxy(8,3);
 write ('  Type the characters in sequence, with no spaces in between.   ');
 gotoxy(8,4);
 write (' Upper-case and lower-case are considered DIFFERENT characters. ');
 gotoxy(8,5);
 write ('            Terminate input by hitting <ENTER>.                 ');
 SetTextType(Norm);

 repeat
  {prompt the user for the keys to be defined}
  gotoxy(1,10); write (' Enter the keys to be used as counters ->');
  InvalidChar:=false;
  {get the string of characters}
  gotoxy(42,10); clreol;
  InputStr(S,20,42,10);
  DefinedKeys:=S;
  if (length(DefinedKeys)<1) then
  begin
   clrscr;
   SetTextType(Rev);
   gotoxy(1,18); write (' COUNTER cannot run without defined keys ');
   gotoxy(1,19); write (' Program execution terminated            ');
   gotoxy(1,20); write (' Strike any key to continue              ');
   ch:=ReadKey;
   SetTextType(Norm);
   CursorOn;
   clrscr;
   Halt;
  end; {if length(DefinedKeys)..}

  {check for invalid characters}
  for i:=1 to (length(DefinedKeys)) do
  begin
   ch:=DefinedKeys[i];
   if not (((ch) IN [#65..#90]) or ((ch) IN [#97..#122])
    or ((ch) IN [#48..#57])) then
    InvalidChar:=true;
   CharArray[i]:=ord(ch);
  end; {for i:=1 to...}

  {check for repeated characters}
  {sequentialy load the characters into a temporary variable and
   check the following characters for identity}

  for i:=1 to (length(DefinedKeys)) do
  begin
   cht:=DefinedKeys[i];
   for j:=i+1 to (length(DefinedKeys)) do
   begin
    ch:=DefinedKeys[j];
    if ch=cht then InvalidChar:=true;
   end; {for j:=i+1 to...}
  end; {for i:=1 to...}

  if InvalidChar then
  begin
   InvalidKey;
   SetTextType(RevBlink);
   gotoxy(1,20); write (' Invalid or duplicate characters. ');
   SetTextType(Rev);
   gotoxy(1,21); write (' Strike any key to try again.     ');
   SetTextType(Norm);
   ch:=ReadKey;
   EraseWarning;
  end; {if IvalidChar}

  if not InvalidChar then ok:=true;
 until ok;

 clrscr;
 ypos:=3;

 {get the labels for the defined keys}
 for i:=1 to (length(DefinedKeys)) do
 begin
  ch:=DefinedKeys[i];
  gotoxy(1,ypos); write ('Enter label for ',ch,' :');
  InputStr(S,20,21,ypos);
  LabelArray[i]:=S;
  ypos:=ypos+1;
 end; {for ...}

end; {procedure DefineKeys}

{------------------------------------------------ procedure ScreenDisplay }

{
purpose: to set up the screen display.
}

procedure ScreenDisplay;

const
 ScreenHeader='              LABEL        KEY   COUNT';

var
 i:byte;

begin {procedure ScreenDisplay}
 clrscr;

 {display the output path and the mode}
 gotoxy(1,1); write ('Active file : ');
 SetTextType(High); write (ActiveFile); SetTextType(Norm);
 gotoxy(1,2); write ('Active path : ');
 SetTextType(High); write (ActivePath); SetTextType(Norm);
 gotoxy(1,3); write ('Mode        : ');

 SetTextType(High);
 if Add then
 begin
  gotoxy(15,3); write ('ADDITION');
 end
 else
 begin
  gotoxy(15,3); write ('SUBTRACTION');
 end; {if Add}

 {display the headers}
 gotoxy(1,5); write (ScreenHeader);
 if (length(DefinedKeys))>10 then
 begin
  gotoxy(40,5); write (ScreenHeader);
 end; {if length...}

 ypos:=7;
 xpos:=1;

 {display the labels and the initial values}
 for i:=1 to (length(DefinedKeys)) do
 begin
  gotoxy(xpos,ypos);
  write (LabelArray[i]:20,'  :    ',chr(CharArray[i]):1,'    ',CharCounterArray[i]:5);
  ypos:=ypos+1;
  if ypos>16 then
  begin
   xpos:=40;
   ypos:=7;
  end; {if ypos}
 end; {for ... to (length(DefinedKeys))}
 SetTextType(Norm);

end; {procedure ScreenDisplay}

{------------------------------------------------ procedure UpDateMenu }

{
purpose: to keep the menu up to date.
}

procedure UpDateMenu;

var
 TempF1,TempF2,TempF3,TempF4,TempF5,TempF6,TempF7,TempF8,Tempf10:boolean;
 i:byte;

begin {procedure UpDateMenu}

 {check each of the status functions and update those that have changed}
 {F1 and F10 are always on}
 TempF1:=true;
 TempF10:=true;

 {F2 and F3 are on only if an element in CharCounterArray is different}
 {from StartCount}
 TempF2:=false;
 TempF3:=false;
 for i:=1 to (length(DefinedKeys)) do
 begin
  if CharCounterArray[i]<>StartCount then
  begin
   TempF2:=true;
   TempF3:=true;
  end; {if CharCounterArray}
 end; {for i:=1 to ...}

 {F4 is on if no active file is open}
 if OutPutFileOpen then TempF4:=false else TempF4:=true;

 {F5 and F6 are on if an active file is open}
 if OutPutFileOpen then
 begin
  TempF5:=true;
  TempF6:=true;
 end
 else
 begin
  TempF5:=false;
  TempF6:=false;
 end; {if OutPutFileOpen}

 {F7 is on if printer is on-line}
 if PrinterOK then TempF7:=true else TempF7:=false;

 {F8 is on if no active file is open}
 if OutPutFileOpen then TempF8:=false else TempF8:=true;


 {update the those whose status has changed}

 if TempF1<>F1_On then
 begin
  case TempF1 of
   true:begin {display in reverse video}
         SetTextType(Rev);
         gotoxy(1,24); write ('<F1> MODE;');
         SetTextType(Norm);
         F1_On:=TempF1;
        end;
   false:begin {display in normal video}
          gotoxy(1,24); write ('<F1> MODE;');
          F1_On:=TempF1;
         end;
  end; {case TempF1}
 end; {if TempF1}

 if TempF2<>F2_On then
 begin
  case TempF2 of
    true:begin {display in reverse video}
          SetTextType(Rev);
          gotoxy(13,24); write ('<F2> RESET ALL;');
          SetTextType(Norm);
          F2_On:=TempF2;
         end;
    false:begin {display in normal video}
           gotoxy(13,24); write ('<F2> RESET ALL;');
           F2_On:=TempF2;
          end;
  end; {case TempF2}
 end; {if TempF2}

 if TempF3<>F3_On then
 begin
  case TempF3 of
    true:begin {display in reverse video}
          SetTextType(Rev);
          gotoxy(30,24); write ('<F3> RESET ONE;');
          SetTextType(Norm);
          F3_On:=TempF3;
         end;
    false:begin {display in normal video}
           gotoxy(30,24); write ('<F3> RESET ONE;');
           F3_On:=TempF3;
          end;
  end; {case TempF3}
 end; {if TempF3}

 if TempF4<>F4_On then
 begin
  case TempF4 of
    true:begin {display in reverse video}
          SetTextType(Rev);
          gotoxy(47,24); write ('<F4> OPEN FILE;');
          SetTextType(Norm);
          F4_On:=TempF4;
         end;
    false:begin {display in normal video}
           gotoxy(47,24); write ('<F4> OPEN FILE;');
           F4_On:=TempF4;
          end;
  end; {case TempF4}
 end; {if TempF4}

 if TempF5<>F5_On then
 begin
  case TempF5 of
    true:begin {display in reverse video}
          SetTextType(Rev);
          gotoxy(64,24); write ('<F5> CLOSE FILE;');
          SetTextType(Norm);
          F5_On:=TempF5;
         end;
    false:begin {display in normal video}
           gotoxy(64,24); write ('<F5> CLOSE FILE;');
           F5_On:=TempF5;
          end;
  end; {case TempF5}
 end; {if TempF5}

 if TempF6<>F6_On then
 begin
  case TempF6 of
    true:begin {display in reverse video}
          SetTextType(Rev);
          gotoxy(1,25); write ('<F6> PRINT TO FILE;');
          SetTextType(Norm);
          F6_On:=TempF6;
         end;
    false:begin {display in normal video}
           gotoxy(1,25); write ('<F6> PRINT TO FILE;');
           F6_On:=TempF6;
          end;
  end; {case TempF6}
 end; {if TempF6}

 if TempF7<>F7_On then
 begin
  case TempF7 of
    true:begin {display in reverse video}
          SetTextType(Rev);
          gotoxy(22,25); write ('<F7> PRINT TO PRINTER;');
          SetTextType(Norm);
          F7_On:=TempF7;
         end;
    false:begin {display in normal video}
           gotoxy(22,25); write ('<F7> PRINT TO PRINTER;');
           F7_On:=TempF7;
          end;
  end; {case TempF7}
 end; {if TempF7}

 if TempF8<>F8_On then
 begin
  case TempF8 of
    true:begin {display in reverse video}
          SetTextType(Rev);
          gotoxy(45,25); write ('<F8> SET PATH;');
          SetTextType(Norm);
          F8_On:=TempF8;
         end;
    false:begin {display in normal video}
           gotoxy(45,25); write ('<F8> SET PATH;');
           F8_On:=TempF8;
          end;
  end; {case TempF8}
 end; {if TempF8}

 if TempF10<>F10_On then
 begin
  case TempF10 of
    true:begin {display in reverse video}
          SetTextType(Rev);
          gotoxy(61,25); write ('<F10> EXIT PROGRAM;');
          SetTextType(Norm);
          F10_On:=TempF10;
         end;
    false:begin {display in normal video}
           gotoxy(61,25); write ('<F10> EXIT PROGRAM;');
           F10_On:=TempF10;
          end;
  end; {case TempF10}
 end; {if TempF10}

end; {procedure UpDateMenu}

{---------------------------------------------- procedure UpDateStatusKeys }

{
purpose: to indicate whether the status keys are engaged or not.  This
         procedure is based on the Statkeys.pas program written by Don
         Taylor and published in TUG-Lines issue #22.
}

procedure UpDateStatusKeys;

var
 CapsLock,NumLock,ScrollLock:boolean;
 TheStatus:byte;
 StatusByte:byte absolute $0000:$0417;

begin {procedure UpDateStatusKeys}

 if TheStatus<>StatusByte shr 4 then
 begin
  TheStatus:=StatusByte shr 4;
 end;

 CapsLock:=(TheStatus and $04)<>0;
 NumLock:=(TheStatus and $02)<>0;
 ScrollLock:=(TheStatus and $01)<>0;

 if NumLock then
 begin
  SetTextType(Rev);
  gotoxy(53,1); write ('Num Lock');
 end
 else
 begin
  SetTextType(Norm);
  gotoxy(53,1); write ('        ');
 end;

 if ScrollLock then
 begin
  SetTextType(Rev);
  gotoxy(62,1); write ('Scroll Lock');
 end
 else
 begin
  SetTextType(Norm);
  gotoxy(62,1); write ('           ');
 end;

 if CapsLock then
 begin
  SetTextType(Rev);
  gotoxy(43,1); write ('Caps Lock');
 end
 else
 begin
  SetTextType(Norm);
  gotoxy(43,1); write ('         ');
 end;

 SetTextType(Norm);

end; {procedure UpDateStatusKeys}

{------------------------------------------------ procedure ProcessUserInput }

{
purpose: to process all input from the user via the keyboard.
}

procedure ProcessUserInput;

var
 Key1,Key2,ch:char;
 i:byte;
 BL:Str80;
 TempStr:Str5;
 TempHeader:Str12;
 TempLabel:Str20;

begin {procedure ProcessUserInput}

 {process user input}
   HitKey('',Key1,Key2);
   case Key1 of
       #0:begin
          case Key2 of
            #59:begin {F1}

                 if not F1_On then
                 begin
                  InvalidKey;
                  exit;
                 end; {if not F1_On}

                 SetTextType(High);
                 if add then
                 begin
                  add:=false;
                  gotoxy(15,3); clreol; write ('SUBTRACTION');
                 end
                 else
                 begin
                  add:=true;
                  gotoxy(15,3); clreol; write ('ADDITION');
                 end; {if add}
                 SetTextType(Norm);
                end;
            #60:begin {F2}

                 if not F2_On then
                 begin
                  InvalidKey;
                  exit;
                 end; {if not F2_On}

                 {make sure the user wants to reset all the counters}
                 SetTextType(Rev);
                 gotoxy(1,18); write (' Are you sure? (Y/N) ');
                 SetTextType(Norm);
                 ch:=ReadKey;
                 if ((ch) IN ['Y','y']) then
                 begin
                  {reset all the counters}
                  for i:=1 to length(DefinedKeys) do
                  begin
                   CharCounterArray[i]:=StartCount;
                   UpDateScreen(i);
                  end; {for i:=1 to}
                 end; {if ch}
                 EraseWarning;
                end;
            #61:begin {F3}

                 if not F3_On then
                 begin
                  InvalidKey;
                  exit;
                 end; {if not F3_On}

                 {prompt the user for the counter to reset}
                 SetTextType(Rev);
                 gotoxy(1,18); write (' Hit the key to reset or <ESC> ');
                 ch:=ReadKey;
                 SetTextType(Norm);
                 EraseWarning;
                 i:=Pos(ch,DefinedKeys);
                 if i=0 then InvalidKey
                 else
                 begin
                  CharCounterArray[i]:=StartCount;
                  UpDateScreen(i);
                 end; {if i=0}
                end;
            #62:begin {F4}

                 if not F4_On then
                 begin
                  InvalidKey;
                  exit;
                 end; {if not F4_On}

                 OpenOutPutFile;
                end;
            #63:begin {F5}

                 if not F5_On then
                 begin
                  InvalidKey;
                  exit;
                 end; {if not F5_On}

                 {close the file}
                 Close(OutPutFile);
                 CheckIOError;

                 {update the screen}
                 ActiveFile:='';
                 gotoxy(15,1);
                 write ('             ');
                 {update the global variable}
                 OutPutFileOpen:=false;
                end;
            #64:begin {F6}

                 if not F6_On then
                 begin
                  InvalidKey;
                  exit;
                 end; {if not F6_On}

                 BL:='';

                 {send message to the screen}
                 SetTextType(Rev);
                 gotoxy(1,18); write (' Printing to file...');
                 delay(300);
                 SetTextType(Norm);

                 {send output to file}
                 S:='COUNTER output on '+date+' at '+time;
                 writeln (OutPutFile,S);
                 writeln (OutPutFile,BL);

                 S:='LABEL                     KEY    COUNT';
                 writeln (OutPutFile,S);
                 writeln (OutPutFile,BL);

                 for i:=1 to length(DefinedKeys) do
                 begin
                  TempLabel:=LabelArray[i];
                  while (length(TempLabel)<20) do TempLabel:=TempLabel+' ';
                  S:=TempLabel+'  :    ';
                  ch:=DefinedKeys[i];
                  S:=S+ch+'    ';
                  Str(CharCounterArray[i]:5,TempStr);
                  S:=S+TempStr;
                  writeln (OutPutFile,S);
                 end; {for ... to length(DefinedKeys)}

                 for i:=1 to 2 do writeln (OutPutFile,BL);

                 EraseWarning;

                end;
            #65:begin {F7}

                 if not F7_On then
                 begin
                  InvalidKey;
                  exit;
                 end; {if not F7_On}

                 BL:='';
                 EjectPrinterPage:=true;

                 {send message to the screen}
                 SetTextType(Rev);
                 gotoxy(1,18); write (' Printing...');
                 SetTextType(Norm);

                 {send output to printer}
                 PrinterDump(BL);
                 S:='COUNTER output on '+date+' at '+time;
                 PrinterDump(S);
                 PrinterDump(BL);

                 S:='LABEL                     KEY    COUNT';
                 PrinterDump(S);
                 PrinterDump(BL);

                 for i:=1 to length(DefinedKeys) do
                 begin
                  TempLabel:=LabelArray[i];
                  while (length(TempLabel)<20) do TempLabel:=TempLabel+' ';
                  S:=TempLabel+'  :    ';
                  ch:=DefinedKeys[i];
                  S:=S+ch+'    ';
                  Str(CharCounterArray[i]:5,TempStr);
                  S:=S+TempStr;
                  PrinterDump(S);
                 end; {for ... to length(DefinedKeys)}

                 for i:=1 to 2 do PrinterDump(BL);

                 {wait for printer to finish printing}
                 repeat until PrinterOK;
                 EraseWarning;

                end;
            #66:begin {F8}

                 if not F8_On then
                 begin
                  InvalidKey;
                  exit;
                 end; {if not F8_On}

                 ChangePath(ActivePath);
                 EraseWarning;
                end;
            #68:begin {F10}

                 if not F10_On then
                 begin
                  InvalidKey;
                  exit;
                 end; {if not F10_On}

                 if OutPutFileOpen then
                 begin
                  {close the file}
                  Close(OutPutFile);
                  CheckIOError;

                  {update the screen}
                  ActiveFile:='';
                  gotoxy(1,1); clreol; write ('Active File : ',ActiveFile);
                  {update the global variable}
                  OutPutFileOpen:=false;
                 end; {if OutPutFileOpen}
                 quit:=true;
                end;
            else InvalidKey
          end; {case Key2}
         end;
     #48..#122:begin
                {check for defined keys}
                {if key is not defined InvalidKey else click and process}
                i:=Pos(Key1,DefinedKeys);
                if i=0 then InvalidKey else
                begin
                 {based on status of add, add or subtract one from the
                 corresponding value in the CharCounterArray}
                 if add then
                 begin
                  if CharCounterArray[i]<MaxCount then
                  begin
                   CharCounterArray[i]:=CharCounterArray[i]+1;
                   click;
                  end
                  else
                  begin
                   SetTextType(Rev);
                   gotoxy(1,18); write (' Out of range ');
                   sound(300); delay(50);
                   sound(600); delay(50);
                   sound(1500); delay(50);
                   NoSound; delay(50);
                   SetTextType(Norm);
                   EraseWarning;
                  end;
                 end
                 else
                 begin
                  if CharCounterArray[i]>MinCount then
                  begin
                   CharCounterArray[i]:=CharCounterArray[i]-1;
                   click;
                  end
                  else
                  begin
                   SetTextType(Rev);
                   gotoxy(1,18); write (' Out of range ');
                   sound(300); delay(50);
                   sound(600); delay(50);
                   sound(1500); delay(50);
                   NoSound; delay(50);
                   SetTextType(Norm);
                   EraseWarning;
                  end;
                 end; {if add}
                 UpDateScreen(i);
                end; {if i=0}
               end;
     else InvalidKey
   end; {case Key1}

end; {procedure ProcessUserInput}

{------------------------------------------------ procedure Initialize }

{
purpose: to install exit and critical error procedures, to initialize
         global variables, and to set up opening screens.
}

procedure Initialize;

var
 i:byte;
 ch:char;

begin {procedure Initialize}

 {install the termination procedure}
 ExitSave:=ExitProc;
 ExitProc:=@Terminate;

 {install the critical error handling prodecure}
 SetIntVec($24,@CEHandler);
 CriticalErrorOccurred:=false;
 CriticalErrorCode:=0;
 CriticalErrorDrive:=$FF;

 {turn the cursor off}
 CursorOff;

 {set the global status variables}
 Quit:=false;
 Add:=true;
 FileName:='';
 ActiveFile:='';
 OutPutFileOpen:=false;
 GetDir(0,OriginalPath);
 ActivePath:=OriginalPath;
 if length(ActivePath)>3 then ActivePath:=ActivePath+'\';
 DefinedKeys:='';
 F1_On:=false;
 F2_On:=true;
 F3_On:=true;
 F4_On:=false;
 F5_On:=true;
 F6_On:=true;
 if PrinterOK then F7_On:=false else F7_On:=true;
 F8_On:=false;
 F10_On:=false;
 PrinterLine:=1;
 EjectPrinterPage:=false;

 {initialize the arrays}
 for i:=1 to 20 do
 begin
  CharCounterArray[i]:=StartCount;
  CharArray[i]:=0;
  LabelArray[i]:='';
 end; {for ... to 20}

 {show the opening screen}
 OpeningScreen;

 {get key definitions and labels}
 DefineKeys;

 {set up display}
 ScreenDisplay;

end; {procedure Initialize}

{------------------------------------------------ procedure Execute }

{
purpose: to process user input or, if none, to update the clock and the
         menu.
}
procedure Execute;

begin {procedure Execute}

 repeat
   repeat
    UpDateClock;
    UpDateMenu;
    UpDateStatusKeys;
   until KeyPressed;
   ProcessUserInput;
 until quit;

end; {procedure Execute}

{-------------------------------------------------- procedure Terminate }

{
purpose: to shut down program execution and to report run time errors.
}

procedure Terminate;

var
 Msg:Str40;
 Segment,Offset:word;

begin {procedure Terminate}

 {close OutPutFile if open}
 if OutPutFileOpen then
 begin
  Close(OutPutFile);
  OutPutFileOpen:=false;
 end; {if OutPutFileOpen}

{if output was sent to the printer, eject the page}
 if EjectPrinterPage and PrinterOK then writeln (lst,#12);

 {clear the screen}
 clrscr;

 SetTextType(High);

 if ((ExitCode>=200) and (ExitCode<=255)) then
 begin
  if ErrorAddr<>nil then               {run-time error occurred}
  begin
   case ExitCode of
    200:Msg:=' Division by zero';
    201:Msg:=' Range check error';
    202:Msg:=' Stack overflow error';
    203:Msg:=' Heap overflow error';
    204:Msg:=' Invalid pointer operation';
    205:Msg:=' Floating point overflow';
    206:Msg:=' Floating point underflow';
    207:Msg:=' Invalid floating point operation';
   else Msg:=' Unknown error';
   end; {case ExitCode}
   Segment:=Seg(ErrorAddr);
   Offset:=Ofs(ErrorAddr);
   writeln (' Fatal run-time error # ',ExitCode,' at ',Segment:5,':',Offset:5);
   writeln (Msg);
   writeln (' Program execution aborted.');
   ErrorAddr:=nil;
  end
  else
  begin
   writeln (' Program execution halted.');
  end; {if ErrorAddr<>nil}
 end; {if ExitCode<>0}

 clrscr;
 SetTextType(Rev);
 gotoxy(17,11); write (' COUNTER is a ');
 SetTextType(RevBlink); write ('PUBLIC DOMAIN');
 SetTextType(Rev); write (' program created by:   ');
 gotoxy(29,13); write (' Rafael J Del Vecchio   ');
 gotoxy(29,14); write (' PO Box 1243            ');
 gotoxy(29,15); write (' Davis,  CA  95617-1243 ');
 gotoxy(29,16); write (' U.S.A.                 ');
 gotoxy(17,18); write (' You may copy and distribute this program freely. ');
 gotoxy(17,19); write ('      Send comments to the above address.         ');

 SetTextType(Norm);
 CursorOn;
 gotoxy(1,24);

 ChDir(OriginalPath);

 {restore Turbo's built-in exit procedure}
 ExitProc:=ExitSave;

end; {procedure Terminate}