Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/RDKYBD.ZIP/RDKYBD.PAS

Pascal/Delphi Source File | 1993-01-04 | 18.9 KB | 478 lines

{$R-,S-,T-,V-}
{ Turbo Pascal 4.0 unit of keyboard routines to read and validate byte/
  integer/real number/string/password entry with cursor key editing.
  The enter key does not advance the cursor to the next line.  Use GotoXY
  before call to display entry at a specific screen position.  Use Writeln
  after the call to advance the cursor to the next line when using a scrolling
  display.  Set background and text colors with TextBackground and TextColor.}

{ John Haluska, CIS 74000,1106 }

unit Rdkybd;

interface

uses Crt;

var
  ErrorToneEnb : boolean;       {Enables (true) or disables (false) ErrorTone }

procedure  ErrorTone;
procedure  Password(var P : string);
procedure  ReadByte(var N : byte);
procedure  ReadIntgr(var N : integer);
procedure  ReadLongInt(var N : longint);
procedure  ReadByteMinMax(Min,Max : byte; var N : byte);
procedure  ReadIntgrMinMax(Min,Max : integer; var N : integer);
procedure  ReadLongIntMinMax(Min,Max : longint; var N : longint);
procedure  ReadReal(var N : real);
procedure  ReadRealMinMax(Min,Max : real; var N : real);
procedure  ReadString (var S : string);

implementation

{-----------------------------------------------------------------------------}
{ ErrorTone generates a 120 Hz tone for .1 second if unit global variable
  ErrorToneEnb is true (default).  The caller can set ErrorToneEnb := False
  to disable ErrorTone. }

procedure ErrorTone;
          {Requires unit global variable ErrorToneEnb}
  begin
    if ErrorToneEnb then
      begin
        Sound(120);  Delay(100);  NoSound;
      end;
  end; {ErrorTone}
{-----------------------------------------------------------------------------}
{ Password reads a string of characters and echos the entered characters as
  asterisks to the display.  The Bksp and Esc keys edit the input.  The Enter
  key terminates the input and does not advance the cursor to the next line. }

procedure Password(var P : string);
         { Requires procedure ErrorTone }
  var
    C     : char;
    I,X,Y : byte;
  begin
    P[0] := #0;
    X := WhereX; Y := WhereY;
    repeat
      C := ReadKey;
      case C of
        #32..#127  : begin
                       P := P + C;
                       Write('*');
                     end;
        #8         : begin                        {Backspace}
                       if Length(P) > 0 then
                         begin
                           Delete(P,Length(P),1);
                           Write(#8,' ',#8);
                         end
                       else ErrorTone;
                     end;
        #27        : begin                         {Escape}
                       GotoXY(X,Y);
                       for I := 1 to Length(P) do Write(' ');
                       GotoXY(X,Y);
                       P[0] := #0;
                     end;
        #13        : ;                             {CR}
        #0         : begin                      {Extended Key}
                       C := ReadKey;  ErrorTone;
                     end;
        else ErrorTone;
      end;
    until C = #13;                                 {CR}
  end {Password};
{-----------------------------------------------------------------------------}
{ ReadByte, ReadIntgr, and ReadLongInt are similar to the corresponding MinMax
  procedures except these procedures will accept any valid corresponding byte,
  integer, or longinteger.  Example: ReadIntgr(N) will erase the input if
  35000 is entered. }

procedure ReadByte(var N : byte);
         { Requires procedure ReadLongIntMinMax }
  var  M : longint;
  begin
    ReadLongIntMinMax(0,255,M);
    N := M;
  end; {ReadByte}

procedure ReadIntgr(var N : integer);
         { Requires procedure ReadLongIntMinMax }
  var  M : longint;
  begin
    ReadLongIntMinMax(-32768,32767,M);
    N := M;
  end; {ReadIntgr}

procedure ReadLongInt(var N : longint);
         { Requires procedure ReadLongIntMinMax }
  begin
    ReadLongIntMinMax(-2147483647,2147483647,N);
  end; {ReadLongInt}
{-----------------------------------------------------------------------------}
{ ReadByteMinMax, ReadIntgMinMax, and ReadLongIntMinMax read and display the
  keyboard entry at the current cursor location until valid data (characters
  (-,0-9,.,), range min to max) is entered.  If the data is not valid, the
  entry is erased, warning sounded, and the cursor is positioned to the start
  of the field.  Min and max are assumed to be valid corresponding bytes,
  integers or longintegers.  If max is less than min, max and min are
  swapped.  The Backspace, Delete, Left/Right Arrow, Home, End, and Esc keys
  can be used to edit the data entry.  Enter terminates the data entry and does
  not advance the cursor to the next line.  Example:  ReadIntgrMinMax(-5,5,N )
  will return a valid integer number N in the range -5 to 5 from the keyboard.}

procedure ReadByteMinMax(Min,Max : byte; var N : byte);
         { Requires procedure ReadLongIntMinMax }
  var M : longint;
  begin
    ReadLongIntMinMax(Min,Max,M);
    N := M;
  end; {ReadByteMinMax}

procedure ReadIntgrMinMax(Min,Max : integer; var N : integer);
         { Requires procedure ReadLongIntMinMax }
  var M : longint;
  begin
    ReadLongIntMinMax(Min,Max,M);
    N := M;
  end; {ReadIntgrMinMax}

procedure ReadLongIntMinMax(Min,Max : longint; var N : longint);
         { Requires procedure ErrorTone }
  var
    S             : string;
    C             : char;
    Error         : integer;
    Temp          : longint;
    I,X,Y         : byte;
    OK            : boolean;
  begin
    X := WhereX; Y := WhereY;
    if Min > Max then      {if min greater than max, swap min and max}
      begin
        Temp := Min;  Min := Max;  Max := Temp;
      end;
    repeat
      S := '';  I := 0;
      repeat
        C := ReadKey;
        case C of
          '-','0'..'9': begin                      {-,0..9}
                          if (X + I) < 80 then
                            begin
                              Inc(I);
                              Insert(C,S,I);
                              GotoXY(X+I-1,Y);
                              Write(Copy(S,I,Length(S)-I+1));
                              GotoXY(X+I,Y);
                            end
                          else ErrorTone; {Entry field cannot go beyond col 79}
                        end;
             #8       : begin                       {Backspace}
                          Delete(S,I,1);
                          if I > 0 then
                            begin
                              Dec(I);
                              GotoXY(X,Y);
                              Write(S,' ');
                              GotoXY(X+I,Y);
                            end
                          else ErrorTone;
                        end;
            #13      : ;                            {CR}
            #27      : begin                        {Escape}
                         GotoXY(X,Y);
                         for I := 1 to Length(S) do Write(' ');
                         GotoXY(X,Y);
                         S := ''; I := 0;
                       end;
            #0       : begin                      {Extended key}
                         C := ReadKey;
                         case C of
                           #83 : begin                        {Delete}
                                   if I <> Length(S) then
                                     begin
                                       Inc(I);
                                       Delete(S,I,1);
                                       GotoXY(X,Y);
                                       Dec(I);
                                       Write(S,' ');
                                       GotoXY(X+I,Y);
                                     end
                                   else ErrorTone;
                                 end;
                           #75 : begin                        {Left Arrow}
                                   if (X+I) > X then
                                     begin
                                       Dec(I);  GotoXY(X+I,Y);
                                     end;
                                 end;
                           #77 : begin                        {Right Arrow}
                                   if I < Length(S) then
                                     begin
                                     Inc(I);  GotoXY(X+I,Y);
                                   end;
                                 end;
                           #71 : begin                        {Home}
                                   GotoXY(X,Y);  I := 0;
                                 end;
                           #79 : begin                        {End}
                                   GotoXY(X + Length(S),Y);
                                   I := Length(S);
                                 end;
                         else ErrorTone;
                       end;
                     end;
            else ErrorTone;
        end;
      until C = #13;                      {CR ends entry}
      GotoXY(X,Y);
      for I := 1 to Length(S) do Write(' ');
      GotoXY(X,Y);
      Val(S,N,Error);
      if (Error = 0) and (N >= Min) and (N <= Max) then OK := True
        else
          begin
            OK := False;
            ErrorTone;
          end;
    until OK;
    Write(N);
  end {ReadLongIntMinMax};
{-----------------------------------------------------------------------------}
{ ReadReal is similar to ReadRealMinMax except ReadReal accepts any valid
  real number.  Example:  ReadReal(Num) will return only a valid real number. }

procedure ReadReal(var N : real);
         { Requires procedure ReadRealMinMax }
  begin
    ReadRealMinMax(-9.999E37,9.999E37,N);
  end; {ReadReal}
{-----------------------------------------------------------------------------}
{ ReadRealMinMax reads and displays at the current location the keyboard entry
  until a valid real number (characters (-,0-9,.,E,e), range min to max, up to
  up to 11 digits in mantisa) is entered. Invalid keystrokes are ignored. If
  the data is not valid, the entry is erased, warning sounded, and the cursor
  is positioned to the start of the field.  Max must be greater than min. If
  min is greater than max, then max and min are swapped.  The Backspace,
  Delete, Left/Right Arrow, Home, End, and Esc keys can be used to edit the
  data entry.  Enter terminates the data entry and does not advance the cursor
  to the next line.  Example: ReadRealMinMax(10.0,15.0,Num) will return a valid
  real number Num in the range 10 to 15 }

procedure ReadRealMinMax(Min,Max : real; var N : real);
         { Requires procedure ErrorTone }
  var
    S              : string[80];
    C              : char;
    Error,Indx     : integer;
    Temp           : real;
    I,X,Y          : byte;
    OK             : boolean;
  begin
    X := WhereX; Y := WhereY;
    if Min > Max then      {if min greater than max, swap min and max}
      begin
        Temp := Min;  Min := Max;  Max := Temp;
      end;
    repeat
    S := '';  I := 0;
      repeat
        C := ReadKey;
        case C of
          '-','.',
          '0'..'9',
          'E','e' : begin                      {-,.,0..9,E,e}
                      if (X + I) < 80 then
                        begin
                          Inc(I);
                          Insert(Upcase(C),S,I);
                          GotoXY(X+I-1,Y);
                          Write(Copy(S,I,Length(S)-I+1));
                          GotoXY(X+I,Y);
                        end
                      else ErrorTone; {Entry field cannot go beyond col 79}
                    end;
           #8     : begin                       {Backspace}
                      Delete(S,I,1);
                      if I > 0 then
                        begin
                          Dec(I);
                          GotoXY(X,Y);
                          Write(S,' ');
                          GotoXY(X+I,Y);
                        end
                      else ErrorTone;
                    end;
          #13     : ;                            {CR}
          #27     : begin                        {Escape}
                      GotoXY(X,Y);
                      for I := 1 to Length(S) do Write(' ');
                      GotoXY(X,Y);
                      S := '';  I := 0;
                    end;
           #0     : begin                   {Extended key}
                      C := ReadKey;
                      case C of
                        #83 : begin              {Delete}
                                if I <> Length(S) then
                                  begin
                                    Inc(I);
                                    Delete(S,I,1);
                                    GotoXY(X,Y);
                                    Dec(I);
                                    Write(S,' ');
                                    GotoXY(X+I,Y);
                                  end
                                else ErrorTone;
                              end;
                        #75 : begin                        {Left Arrow}
                                if (X+I) > X then
                                  begin
                                    Dec(I);  GotoXY(X+I,Y);
                                  end;
                              end;
                        #77 : begin                        {Right Arrow}
                                if I < Length(S) then
                                  begin
                                    Inc(I);  GotoXY(X+I,Y);
                                  end;
                              end;
                        #71 : begin                        {Home}
                                GotoXY(X,Y);  I := 0;
                              end;
                        #79 : begin                        {End}
                                GotoXY(X + Length(S),Y);
                                I := Length(S);
                              end;
                        else ErrorTone;
                      end;
                     end;
                  else ErrorTone;
                end;
      until C = #13;                      {CR ends entry}
      if Pos('.',S)=1 then S:='0'+S;  {if only digits to right of DP entered}
      GotoXY(X,Y);
      for I := 1 to Length(S) do Write(' ');
      GotoXY(X,Y);
      Val(S,N,Error);
      if (Error = 0) and (N >= Min) and (N <= Max) then OK := True
        else
          begin
            OK := False;  ErrorTone;
          end;
    until OK;
    Indx := Pos('E',S);                        {exponential notation}
    if Indx > 0 then
      begin
        if N > 0 then Inc(Indx);                  {exponent positive}
        Write(N:Indx+3);
      end
    else
      begin
        Indx := Pos('.',S);
        if Indx > 0 then                       {fixed point notation}
          Write(N:Length(S):Length(S)-Indx)  {fixed with dec pt}
        else Write(N:Length(S):0);            {fixed, no dec pt}
      end;
  end {ReadRealMinMax};
{-----------------------------------------------------------------------------}
{ ReadString reads a string of characters and echos the entered characters to
  the display.  The Bksp, Del, Left/Right Arrow, Home, End, and Esc keys can
  be used to edit the data entry.  Enter terminates the data entry and does
  not advance the cursor to the next line.  The entered string must be on one
  80 column line. Example: ReadString(Str) returns the keyboard entry for
  string Str.  }

procedure ReadString(var S : string);
         { Requires procedure ErrorTone }
  var
    C     : char;
    I,X,Y : byte;
  begin
    S := '';  I := 0;
    X := WhereX; Y := WhereY;
    repeat
      C := ReadKey;
      case C of
        #32..#127 : begin
                      if (X + I) < 80 then
                        begin
                          Inc(I);
                          Insert(C,S,I);
                          GotoXY(X+I-1,Y);
                          Write(Copy(S,I,Length(S)-I+1));
                          GotoXY(X+I,Y);
                        end
                      else ErrorTone;     {Entry field cannot go beyond col 79}
                    end;
        #8        : begin                       {Backspace}
                      Delete(S,I,1);
                      if I > 0 then
                        begin
                          Dec(I);
                          GotoXY(X,Y);
                          Write(S,' ');
                          GotoXY(X+I,Y);
                        end
                      else ErrorTone;
                    end;
        #13      : ;                            {CR}
        #27      : begin                        {Escape}
                     GotoXY(X,Y);
                     for I := 1 to Length(S) do Write(' ');
                     GotoXY(X,Y);
                     S := '';  I := 0;
                   end;
         #0      : begin
                     C := Readkey;
                     case C of
                       #83 : begin                        {Delete}
                               if I <> Length(S) then
                                 begin
                                   Inc(I);
                                   Delete(S,I,1);
                                   GotoXY(X,Y);
                                   Dec(I);
                                   Write(S,' ');
                                   GotoXY(X+I,Y);
                                 end
                               else ErrorTone;
                             end;
                       #75 : begin                      {Left Arrow}
                               if (X+I) > X then
                                 begin
                                   Dec(I);  GotoXY(X+I,Y);
                                 end;
                             end;
                       #77 : begin                      {Right Arrow}
                               if I < Length(S) then
                               begin
                                 Inc(I);  GotoXY(X+I,Y);
                               end;
                             end;
                       #71 : begin                         {Home}
                               GotoXY(X,Y);  I := 0;
                             end;
                       #79 : begin                         {End}
                               GotoXY(X + Length(S),Y);
                               I := Length(S);
                             end;
                        else ErrorTone;
                     end;
                  end;
         else ErrorTone;
      end;
    until C = #13;
  end {ReadString};
{-----------------------------------------------------------------------------}

begin
  ErrorToneEnb := True;                             { Enable ErrorTone }
end.