[Back to ENTRY SWAG index] [Back to Main SWAG index] [Original]

    Unit InputUn;

    { This is a small unit with crash proof user input routines and some
      string formating functions. Compile the DemoInput program for more
      information on how to use these functions.

       Robert Mashlan [71160,3067]  3/11/89 }

    Interface

    Uses Crt;

    const
       DefaultSet = [' '..'}'];

    Var
       InverseOn    : boolean;
       UpcaseOn     : boolean;
       ValidCharSet : set of char;

    Procedure Inverse;
    Procedure UnderLine;
    Procedure Normal;
    Procedure Goback;
    Function ReadString( Prompt : string; Width : byte; var Escape : boolean ) : string;
    Function ReadNum( Prompt : real; Width : byte; var Escape : boolean ) : real;
    Function ReadInt( Prompt : longint; Width : byte; var Escape : boolean ) : longint;
    Function Left( AnyString : string; Width : byte ) : string;
    Function Center( AnyString : string; Width : byte ) : string;

    Implementation

    const
       esc = #27;

    Procedure Inverse;
    begin
       textbackground(white);
       textcolor(black);
    end;

    Procedure UnderLine;
    begin
       textbackground(white);
       textcolor(blue);
    end;

    Procedure Normal;
    begin
       textbackground(black);
       textcolor(white);
    end;

    Procedure Goback;
    begin
       GotoXY(WhereX,WhereY-1);
       ClrEol;
    end;

    Function Left( AnyString : string; Width : byte ) : string;
    var
       len  : byte absolute AnyString;
       loop : byte;
    begin
       while length( AnyString ) < Width do
          AnyString:=AnyString+' ';
       len:=Width;      { truncate AnyString if Needed }
       Left:=AnyString;
    end;

    Function Center( AnyString : string; Width : byte ) : string;
    begin
       repeat
          if length( AnyString ) < Width
             then AnyString:=AnyString+' ';
          if length( AnyString ) < Width
             then AnyString:=' '+AnyString;
       until length( AnyString ) >= Width;
       Center:=AnyString;
    end;

    Function ReadString( Prompt : string; Width : byte; var Escape : boolean ) : string;
    var
       NewString    : string;
       InKey,InKey2 : char;
       Start        : byte;
       index        : integer;
       InsertMode   : boolean;

       Procedure Display;
       begin
          GotoXY(Start,WhereY);
          if InverseOn
             then Inverse;
          write(left(NewString,Width));
          if InverseOn
             then Normal;
          GotoXY(Start+index,WhereY);
       end;

       Procedure StripSpaces( var AnyString : string );
       { decrease length of AnyString until a character until a char other than a space is found }
       begin
          while AnyString[ ord(AnyString[0]) ]=' ' do
             dec(AnyString[0]);
       end; { Procedure }

    begin
       InsertMode:=false;
       Start:=WhereX;
       index:=0;
       NewString:=Prompt;
       Display;
       index:=1;
       if UpCaseOn
          then Inkey:=UpCase(ReadKey)
          else InKey:=ReadKey;
       if InKey=#0
          then begin
             InKey2:=ReadKey;
             if InKey2 in [#77,#82]
                then NewString:=Prompt
                else NewString:='';
             if Inkey2=#82
                then begin
                   InsertMode:=true;
                   index:=0;
                end;
          end { then }
          else if InKey in ValidCharSet
             then NewString:=InKey
             else begin
                NewString:='';
                index:=0;
             end;
       if InKey=esc
          then begin
             ReadString:=Prompt;
             Escape:=true;
             ValidCharSet:=defaultSet;
             exit;
          end;
       if InKey=#13
          then begin
             Escape:=false;
             ReadString:=Prompt;
             ValidCharSet:=DefaultSet;
             exit;
          end;
       Display;
       repeat
         if UpCaseOn
            then Inkey:=Upcase(readkey)
            else InKey:=ReadKey;
         if (InKey in ValidCharSet)
           then begin
               if not InsertMode
                  then Delete(NewString,index+1,1);
               insert(InKey,NewString,index+1);
               if index<> Width then inc(index)
            end;
         if (length(NewString)<>0) and (InKey=#8)  { backspace }
            then begin
               Delete(NewString,index,1);
               if index<>0
                  then dec(index);
            end;
         if InKey=#0
            then begin
               InKey:=ReadKey;
               case InKey of
                  #77 : if (index<>length(NewString)) and (' ' in ValidCharSet)
                         then inc(index)
                         else if (index+1<>Width) and (' ' in ValidCharSet)
                            then begin
                               NewString:=NewString+' ';
                               inc(index);
                            end;
                  #75 : if index<>0
                           then if length(NewString)+1<>index
                              then dec(index)
                              else if NewString[index]=' '
                                 then begin
                                    NewString[0]:=succ(NewString[0]);
                                    dec(index);
                                 end
                                 else dec(index);
                  #83 : if length(NewString)>0 then Delete(NewString,index+1,1);
                  #82 : if InsertMode
                           then InsertMode:=false
                           else InsertMode:=true;
               end; { case }
            end; { then }
         if Length(NewString)>width then dec( NewString[0] );
         if index >= width then dec(index);
         Display;
       until (InKey=#13) or (InKey=esc);
       ValidCharSet:=DefaultSet;
       if not ( (InKey=esc) or (length(NewString)=0))
          then begin
             StripSpaces(NewString);
             ReadString:=NewString
          end
          else ReadString:=Prompt;
       if InKey=esc
          then Escape:=true
          else Escape:=false;

    end; { Procedure }

    Function ReadNum( Prompt : real; Width : byte; var Escape : boolean ) : real;
    var
       NewString : string;
       code      : integer;
       OldNum    : real;
       Start     : byte;
    begin
       OldNum:=Prompt;
       Start:=WhereX;
       repeat
          GotoXY(Start,WhereY);
          str( Prompt:0:2, NewString );
          ValidCharSet:=['0'..'9','.','-',' '];
          NewString:=ReadString( NewString, Width, Escape );
          val(NewString,Prompt,code);
       until Escape or (code=0);
       if Escape or (code<>0)
          then ReadNum:=OldNum
          else ReadNum:=Prompt;
    end;

    Function ReadInt( Prompt : longint; Width : byte; var Escape : boolean ) : longint;
    var
       NewString : string;
       code      : integer;
       OldNum    : longint;
       Start     : byte;
    begin
       OldNum:=Prompt;
       Start:=WhereX;
       repeat
          GotoXY(Start,WhereY);
          str( Prompt, NewString );
          ValidCharSet:=['0'..'9','-',' '];
          NewString:=ReadString( NewString, Width, Escape );
          val(NewString,Prompt,code);
       until Escape or (code=0);
       if Escape
          then ReadInt:=OldNum
          else ReadInt:=Prompt;
    end;

    begin
       InverseOn:=true;
       UpcaseOn:=false;
       ValidCharSet:=DefaultSet;
    end.

    { -----------------------------   DEMO PROGRAM ----------------------- }
    Program DemoInputUnit;

    Uses
       Crt, InputUn;

    var
       InKey     : char;
       AnyString : string;
       AnyInt    : longint;
       AnyNum    : real;
       Escape    : boolean;

    begin
       ClrScr;
       writeln;
       Inverse;
       writeln(' Text in Inverse mode ');
       writeln;
       Underline;
       writeln(' Text in Underline mode ( if using a monochrome monitor)');
       writeln;
       normal;
       writeln(' Back to normal ');
       writeln;
       writeln(' The GoBack procedure is used...(press any key)................ ');
       Inkey:=readkey;
       goback;
       writeln(' To erase a line and write a new one  (press any key) ');
       InKey:=readkey;
       ClrScr;
       writeln(' The ReadString function takes 3 parameters');
       writeln(' Function ReadString( Prompt : string; width : byte; var Escape : boolean )');
       writeln('                                                                    : string;');
       writeln(' Prompt is the string that is first put into the edit field.');
       writeln(' This is the string that the function returns if the function is exited with');
       writeln(' an Esc at any time, or a return while it is there.');
       writeln(' This prompt may be edited if the right arrow or the insert key is pressed');
       writeln(' on the first input, otherwise the prompt will disappear.  The return key ');
       writeln(' will input all the visible characters in the field and exit the function.');
       writeln(' The Del, left and right arrow keys work as does the backspace.');
       writeln(' The Ins key toggles the insert mode where new characters are inserted ');
       writeln(' instead of written over.  It is initially off.');
       writeln(' Esc will also exit the function, return the prompt as the result and set ');
       writeln(' the Escape parameter to true (otherwise set to false with a return');
       writeln(' the width parameter sets the maximum length of the string');
       writeln(' This field is highlighted in Inverse. It may be turned off by setting the');
       writeln(' InverseOn to true. Another Global varible that affects this function is');
       writeln(' ValidCharSet which is initially set to the set of all printable characters.');
       writeln(' You can change it before calling this function, and is reset to the ');
       writeln(' DefaultSet const after calling it.  The InverseOn varible will convert');
       writeln(' all letters to uppercase if set to true. It is initially set to false');
       writeln;
       repeat
          write('Input a string->');
          AnyString:=ReadString('This is your prompt',20,escape);
          writeln;
          goback;
          if escape
             then write(' Escape Exit  ');
          writeln('Your string is ''',AnyString,'''');
          inkey:=readkey;
          goback;
          write('Input an integer ( ReadInt )->');
          AnyInt:=ReadInt(123,5,Escape);
          writeln;
          goback;
          if escape
             then write(' Escape Exit  ');
          writeln('Your integer is ',AnyInt);
          if escape then exit;
          inkey:=readkey;
          goback;
          write('Input a real number ( ReadNum )->');
          AnyNum:=ReadNum(1.23,8,escape);
          writeln;
          goback;
          if escape
             then write(' Escape Exit  ');
          writeln('Your Number is ',AnyNum:0:5);
          if escape then exit;
          if not escape
             then begin
                Inkey:=readkey;
                goback;
             end;
       until escape;
    end.

[Back to ENTRY SWAG index] [Back to Main SWAG index] [Original]