home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / TURBOPAS / TPGET.ZIP / GETINPUT.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1984-12-07  |  1.8 KB  |  76 lines
  1. Program DemoOfGetInput;
  2. { KeyBoard routines by Kevin Bales }
  3.  
  4. Type
  5.  MaxString = String[255];
  6.  
  7. Var
  8.  Ch:         Char;
  9.  Extended:   Boolean;
  10.  Xtra:       MaxString;
  11.  AllUpCase:  Boolean;
  12.  
  13. Procedure GetChar(VAR Ch: Char; VAR Extended: Boolean);
  14.  Begin
  15.   Extended:=False;
  16.   Repeat Read(Kbd,Ch) Until Ch<>#0;
  17.   If Ch=#27 Then
  18.    Begin
  19.    Extended:=True;
  20.    Repeat Read(Kbd,Ch) Until Ch<>#0;
  21.    End;
  22.  End;
  23.  
  24. Function GetInput(AllUpCase: Boolean): MaxString;
  25.  Const
  26.   AcceptedChars = ' ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz1234567890!@#$%^&*()_+-=|\,./;''`[]<>?:"~{}';
  27.  Var
  28.   Ch:           Char;
  29.   Extended:     Boolean;
  30.   Xtra:         String[255];
  31.   AcceptedChar: Integer;
  32.   Ok:           Boolean;
  33.   BackSpace:    String[3];
  34.  Begin
  35.   BackSpace:=#8+' '+#8;
  36.   Xtra:='';
  37.   Ok:=False;
  38.   Repeat
  39.    GetChar(Ch,Extended);
  40.    If Extended Then
  41.     {This routine prints the extended}
  42.     {codes in highlighted print. You }
  43.     {Do anything with them you want. }
  44.     Begin
  45.      NormVideo; Write(Ch); LowVideo;
  46.     End;
  47.    If Not Extended Then
  48.    Begin
  49.     If Ch=#13 Then Ok:=True;
  50.     If (Ch=#8) And (Length(Xtra)>0) Then
  51.      Begin
  52.      Write(BackSpace);
  53.      Delete(Xtra,Length(Xtra),1);
  54.      End;
  55.     AcceptedChar := Pos(Ch,AcceptedChars);
  56.     If AcceptedChar>0 then
  57.      Begin
  58.      If AllUpCase Then Ch:=UpCase(Ch);
  59.      Write(Ch);
  60.      Xtra:=Xtra+Ch;
  61.      End;
  62.    End;
  63.   Until Ok;
  64.   GetInput:=Xtra;
  65.   End;
  66.  
  67. Begin
  68.  ClrScr;
  69.  LowVideo;
  70.  Write('Input Something:');
  71.  Xtra:=''; AllUpCase:=True;
  72.  Xtra:=GetInput(AllUpCase);
  73.  WriteLn(''); WriteLn('You Typed: ',Xtra);
  74. End.
  75. put Something:');
  76.  X