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

{ General STRING input routine with Color prompt and input }

USES DOS,Crt;

TYPE
    CharSet = Set OF Char;

VAR
    Name : STRING;

procedure QWrite( Column, Line , Color : byte; S : STRING );

var
   VMode  : BYTE ABSOLUTE $0040 : $0049; { Video mode: Mono=7, Color=0-3 }
   NumCol : WORD ABSOLUTE $0040 : $004A; { Number of CRT columns (1-based) }
   VSeg   : WORD;
   OfsPos : integer;  { offset position of the character in video RAM }
   vPos   : integer;
   sLen   : Byte ABSOLUTE S;

Begin
  If VMode in [0,2,7] THEN VSeg := $B000 ELSE VSeg := $B800;
  OfsPos   := (((pred(Line) * NumCol) + pred(Column)) * 2);
  FOR vPos := 0 to pred(sLen) do
      MemW[VSeg : (OfsPos + (vPos * 2))] :=
                     (Color shl 8) + byte(S[succ(vPos)])
End;

Function GetString(cx,cy,cc,pc : Byte; Default,Prompt : String; MaxLen : Integer;OKSet :
charset):string;

{ cx = Input Column }
{ cy = Input Row    }
{ cc = Input Color  }
{ pc = Prompt Color }

const
  BS                 = ^H;
  CR                 = ^M;
  iPutChar           = #249;
  ConSet             : CharSet = [BS,CR];
var
  TStr               : string;
  TLen,X,i           : Integer;
  Ch                 : Char;
begin
  {$I-} { turn off I/O checking }
  TStr := '';
  TLen := 0;
  Qwrite(cx,cy,pc,Prompt);
  X := cx + Length(Prompt);
  For i := x to (x + Maxlen - 1) do
    Qwrite(i,cy,cc,iputChar);
  Qwrite(x,cy,cc,Default);
  OKSet := OKSet + ConSet;
  repeat
    Gotoxy(x,cy);
    repeat
      ch := readkey
    until Ch in OKSet;
    if Ch = BS then begin
      if TLen > 0 then begin
        TLen := TLen - 1;
        X := X - 1;
        QWrite(x,cy,cc,iPutChar);
      end
    end
    else if (Ch <> CR) and (TLen < MaxLen) then begin
      QWrite(x,cy,cc,Ch);
      TLen := TLen + 1;
      TStr[TLen] := Ch;
      X := X + 1;
    end
  until Ch = CR;
  If Tlen > 0
    Then Begin
           TStr[0] := chr(Tlen);
           Getstring := TStr
         End
    Else Getstring := Default;
  {$I+}
end;


BEGIN
   ClrScr;
   Name := Getstring(16,5,79,31,'GOOD OLE BOY','Enter Name : ',25,['a'..'z','A'..'Z',' ']);
   GOTOXY(16,7);
   WriteLn('Name : ',Name);
   Readkey;
END.

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