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

    unit GS_KeyI;

    {      Written by  Richard F Griffin

           1 December 1988, (Released to the public domain)

           1110 Magnolia Circle
           Papillion, Nebraska  68128

           CIS 75206.231

       This unit allows you to set data entry routines quickly and simply.
       It also gives the programmer the capability to override the entry
       routine and use another procedure to handle function keys.

    }

    interface

    uses crt, dos;

    type
       GS_KeyI_str80 = string[80];

    var
       GS_KeyI_Chr : char;
       GS_KeyI_Fuc,
       GS_KeyI_Esc : boolean;
       GS_KeyI_Hlp : pointer;
       GS_KeyI_Psn : integer;

    Function GS_KeyI_Get : char;

    procedure GS_KeyI_Key(wait : boolean;Fldcnt,x,y : integer);

    function GS_KeyI_T(waitcr: boolean;Fl,X,Y,B:integer;CTitl,
                     CVal:GS_KeyI_str80) : GS_KeyI_str80;

    function GS_KeyI_I(waitcr:boolean;Fl,x,y,B:integer;
                    CTitl:GS_KeyI_str80;XVal,l,h:integer) : integer;

    function GS_KeyI_R(waitcr:boolean;Fl,x,y,B:integer;CTitl:GS_KeyI_str80;
                              XVal,l,h:real;d:integer) : real;

    implementation

    var
       Big_String : GS_KeyI_str80;

    {$F+}
    procedure GS_KeyI_Dum;
    begin
       write(#7);
    end;
    {$F-}

    {
       This procedure is an Inline far call.  The address is inserted by
       GS_KeyI_Call based on the address in GS_KeyI_Hlp.  This address is
       initially to GS_KeyI_Dum, but may be changed by the using program.

       ex:  GS_KeyI_Hlp := @MyProcedure

       The procedure will be called when a special function key (F1, F2,
       Home, RtArrow, etc.) is pressed during data entry.  The using procedure
       may then use GS_KeyI_Chr to find which key was pressed.  It is up to the
       using program to ensure the screen and window sizes are properly restored.
       The programmer must ensure that the $F+ option is used in the procedure
       to force a Far Return.

            -----------      DO NOT MODIFY THIS ROUTINE        ------------
    }

    procedure GS_KeyI_Jmp;
    begin
       InLine ($9A/$00/$00/$00/$00);       {CALLF [GS_KeyI_Hlp]}
    end;

    {
       Inserts a Far Call address for GS_KeyI_Jmp.
       Works in TP 4 and 5.
    }

    procedure GS_KeyI_Call;
    begin
       MemW[seg(GS_KeyI_Jmp):ofs(GS_KeyI_Jmp)+11] := ofs(GS_KeyI_Hlp^);
       MemW[seg(GS_KeyI_Jmp):ofs(GS_KeyI_Jmp)+13] := seg(GS_KeyI_Hlp^);
       GS_KeyI_Jmp;
    end;

    Function GS_KeyI_Get : char;
    var ch: char;
    begin
      Ch := ReadKey;
      If (Ch = #0) then  { it must be a function key }
      begin
        Ch := ReadKey;
        GS_KeyI_Fuc := true;
      end
      else GS_KeyI_Fuc := false;
      GS_KeyI_Get := Ch;
    end;

    procedure GS_KeyI_Key(wait : boolean;Fldcnt,x,y : integer);
    Var
       Big_S : GS_KeyI_str80;
       i : integer;
    begin
       Big_s := '';
       GS_KeyI_Psn := 0;
       gotoxy(x,y);
       Repeat
          GS_KeyI_Chr := GS_KeyI_Get;
          GS_KeyI_Esc := false;
          if not GS_KeyI_Fuc then
          begin
             case GS_KeyI_Chr of
                #08        : begin
                                If GS_KeyI_Psn > 0 then
                                begin
                                   GS_KeyI_Psn := GS_KeyI_Psn - 1;
                                   gotoxy(x+GS_KeyI_Psn,y);
                                   write('_');
                                   gotoxy(x+GS_KeyI_Psn,y);
                                   delete(Big_S,length(Big_S),1);
                                end else
                                begin
                                   write('_');
                                   gotoxy(x+GS_KeyI_Psn,y);
                                end;
                             end;
                ' '..'}'   : begin
                                if (GS_KeyI_Psn = Fldcnt) and (wait) then
                                    write(#7)
                                else begin
                                   if GS_KeyI_Psn = 0 then
                                   begin
                                      for i := 1 to Fldcnt do write('_');
                                      gotoxy(x,y);
                                   end;
                                   GS_KeyI_Psn := GS_KeyI_Psn + 1;
                                   write(GS_KeyI_Chr);
                                   Big_S := Big_S + GS_KeyI_Chr;
                                end;
                             end;
                #27        : begin
                                Big_S := ' ';
                                GS_KeyI_Esc := true;
                             end;
             end;
          end else
          begin
             GS_KeyI_Call;
             gotoxy(x+GS_KeyI_Psn,y);
          end;
       until (GS_KeyI_Chr in [#13,#27]) or ((GS_KeyI_Psn = Fldcnt) and (not wait));
       Big_String := Big_S;
    end;

    { The GS_KeyI_T function will process an input from the keyboard and display
      it on the screen in a specified location.  The length of the input field is
      given, as well as a default entry.  The default entry is optionally shown
      on the screen.

      Parameter descriptions are:

            1  Boolean flag to determine whether to wait for a carriage return
               once the field is full.

            2  Length of input field.

            3  Horizontal location to start.

            4  Vertical position to start.

            5  Vertical line to place default value.  Should be 0 to inhibit
               display of default.  Will usually be the same as (4).

            6  The prompt to place on the screen prior to the data entry field.
               Should be '' if no prompt.

            7  Default value.

    }

    function GS_KeyI_T(waitcr: boolean;Fl,X,Y,B:integer;CTitl,
                       CVal:GS_KeyI_str80) : GS_KeyI_str80;
    var
       i : integer;
    begin
      GS_KeyI_T := '';
      gotoxy(x,y);
      write(CTitl);
      for i := 1 to Fl do write('_');
      if B <> 0 then
      begin
         gotoxy(x+length(CTitl),B);
         write(CVal);
      end;
      GS_KeyI_Key(waitcr,FL,x+length(CTitl),y);
      if Big_String = '' then Big_String := CVal;
      if GS_KeyI_Esc then Big_String := ' ';
      gotoxy(x+length(CTitl),y);
      write(Big_String,'':Fl-length(Big_String));
      if (B <> 0) and (B <> Y) then
      begin
         gotoxy(x+length(CTitl),B);
         write('':length(CVal));
      end;
      GS_KeyI_T := Big_String;
    end;

    { The GS_KeyI_I function will accept an integer from the keyboard and display
      it on the screen in a specified location.  The length of the input field is
      given, as well as a default entry.  The default entry is optionally shown
      on the screen.  A range of acceptable values is also specified.

      Parameter descriptions are:

            1  Boolean flag to determine whether to wait for a carriage return
               once the field is full.

            2  Length of input field.

            3  Horizontal location to start.

            4  Vertical position to start.

            5  Vertical line to place default value.  Should be 0 to inhibit
               display of default.  Will usually be the same as (4).

            6  The prompt to place on the screen prior to the data entry field.
               Should be '' if no prompt.

            7  Default value.

            8  Lowest value acceptable.

            9  Highest value acceptable.

    }

    function GS_KeyI_I(waitcr:boolean;Fl,x,y,B:integer;
                    CTitl:GS_KeyI_str80;XVal,l,h:integer) : integer;
    Var
       Cod, q, i : integer;
       CVal : GS_KeyI_str80;

    begin
       str(XVal:Fl,CVal);
       Cod := 1;
       while Cod <> 0 do
       begin
          Big_String := GS_KeyI_T(waitcr,Fl,X,Y,B,CTitl,CVal);
          if GS_KeyI_Esc then
          begin
             GS_KeyI_I := XVal;
             Exit;
          end;
          if Big_String[length(Big_String)] = ' ' then
             Big_String := 'z';
          for i := 1 to length(Big_String) do
             if Big_String[i] = ' ' then Big_String[i] := '0';
          val(Big_String,q,Cod);
          if Cod <> 0 then
          begin
             write(chr(7));
          end else
          begin
             if (q < l) or (q > h) then
             begin
                Cod := 1;
                write(chr(7));
             end;
          end;
       end;
       GS_KeyI_I := q;
    end;

    { The GS_KeyI_R function will accept a real number from the keyboard and
      display it on the screen in a specified location.  The length of the
      input field is given, as well as a default entry.  The default entry
      is optionally shown on the screen.  A range of acceptable values is
      also specified.

      Parameter descriptions are:

            1  Boolean flag to determine whether to wait for a carriage return
               once the field is full.

            2  Length of input field.

            3  Horizontal location to start.

            4  Vertical position to start.

            5  Vertical line to place default value.  Should be 0 to inhibit
               display of default.  Will usually be the same as (4).

            6  The prompt to place on the screen prior to the data entry field.
               Should be '' if no prompt.

            7  Default value.

            8  Lowest value acceptable.

            9  Highest value acceptable.

           10  Number of decimal places.

    }

    function GS_KeyI_R(waitcr:boolean;Fl,x,y,B:integer;CTitl:GS_KeyI_str80;
                              XVal,l,h:real;d:integer) : real;
    Var
       Cod, i : integer;
       CVal : GS_KeyI_str80;
       r : real;

    begin
       str(XVal:Fl:d,CVal);
       Cod := 1;
       while Cod <> 0 do
       begin
          Big_String := GS_KeyI_T(waitcr,Fl,X,Y,B,CTitl,CVal);
          if GS_KeyI_Esc then
          begin
             GS_KeyI_R := XVal;
             Exit;
          end;
          if Big_String[length(Big_String)] = ' ' then
             Big_String := 'z';
          for i := 1 to length(Big_String) do
             if Big_String[i] = ' ' then Big_String[i] := '0';
          val(Big_String,r,Cod);
          if Cod <> 0 then
          begin
             write(chr(7));
          end else
          begin
             if (r < l) or (r > h) then
             begin
                Cod := 1;
                write(chr(7));
             end;
          end;
       end;
       gotoxy(x+length(CTitl),y);
       str(r:Fl:d,Big_String);
       write(Big_String,'':Fl-length(Big_String));
       GS_KeyI_R := r;
    end;

    begin
       GS_KeyI_Hlp := @GS_KeyI_Dum;
    end.

    {----------------   DEMO PROGRAM ------------------------ }

    program KeyIDemo;

    uses crt, dos, GS_KeyI;

    var
       lin  : string[80];
       numi : integer;
       numr : real;

    {$F+}
    procedure tst;
    begin
       window(1,20,80,24);
       ClrScr;
       gotoxy(20,1);
       case GS_KeyI_Chr of
          #59 : write('Function Key F1 Pressed');
          #60 : write('Function Key F2 Pressed');
          #61 : write('Function Key F3 Pressed');
          #62 : write('Function Key F4 Pressed');
          #71 : write('The Home Key was Pressed');
          #79 : write('The End Key was Pressed');
       else
          write(#7);
       end;
       window(1,1,80,25);
    end;
    {$F-}

    begin
       clrscr;
       GS_KeyI_Hlp := @tst;
       lin := GS_KeyI_T(true, 8,10,1,1,'Enter Text Field: ','empty');
       numi := GS_KeyI_I(true, 2,10,2,2,'Enter Integer Field (0-50): ',0,0,50);
       numr:= GS_KeyI_R(true, 6,10,3,3,'Enter Real Field (0-99.99): ',0,0,99.99,2);
    end.

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