'===========================================================================
' Subject: FINPUT FOR PBCC                   Date: 03-17-00 (16:37)       
' Author:  Don Schullian                     Code: PBCC                   
' Origin:  d83@DASoftVSS.com               Packet: PBCC.ABC
'===========================================================================
fInput% function for PowerBASIC Console Compiler
   coded by: Don Schullian  d83@DASoftVSS.com
   public domain

Welcome,

  This code is offered as an (better?) alternative to INPUT$. It
allows for cursoring around a field, deletion, insertion, overwrite,
scrolling, and bail out without saving the/any changes.

  Its use is demonstrated below using an array to allow for editing
a screen full of data in one loop. This code could, very easily be
placed into it's own function and called several times in a single
program.

  There are a series of CONSTANTS set that are used by the function
You may, of course, put their values into the function or, in some
cases, send the values to the function to allow for more control by
varied other functions.

  This offering is just a starting point for those of you who are
more adventurous. Over the years I've developed 10 different
variations of this function that control and guide the users' input.
One of them works only for numerical input and looks & feels like
a calculator; another allows input of only specific characters;
while others handle hexadecimal input, masked fields, multiple lines
and other varied field types. A bit of imagination goes a LONG way!

  fGetKey% is my basic keyboard input function and I never leave
home without it. There is a full discussion on how and why on
either of my web pages. www.basicguru.com/scullian or
www.DASoftVSS.com along with some other goodies.

  If you have any questions, give me a shout.

   ____    _    ____      ____  _____
  |  _ \  / \  / ___) __ | ___)(_   _) Don Schullian
  | |_)  / _ \ \____\/  \|  _)   | |    d83@DASoftVSS.com
  |____//_/ \_\(____/\__/|_|     |_|    www.DASoftVSS.com
  ___________________________________   www.basicguru.com
      Vertical Software Solutions


'----------------------------------------------------------------------
' fInput%(Datum$,Row&,Col&,VisCols&,MaxLen&,ExitKeys$)
'
' PURPOSE: Allow user input in an editable, friendly environment
'  PARAMS: Datum$     incoming the data already found in the field
'                     returning the edited data
'          Row&, Col& the left most screen position of the field
'          VisCols&   the number of visable characters on screen
'          MaxLen&    the maximum number of characters in the field
'          ExitKeys$  the MKI$(keyvalue%) of all the keys OTHER THAN
'                       <ESC> and <ENTER> that will return from the
'                       function
'    NOTE: If VisCols& =< MaxLen& then the value will be set to match
'          that of MaxLen&
'--------------------------------------------------------------------------

%Esc_key   = &h001B             ' key codes returned by fGetKey%
%Enter_key = &h000D
%BkSpc_key = &h0008
%Del_key   = &h5300
%Up_key    = &h4800
%Down_key  = &h5000
%Ins_key   = &h5200
%Left_key  = &h4B00
%Right_key = &h4D00
%Ctrl_Del  = &h9300
%F10_key   = &h4400
%Home_key  = &h4700
%End_key   = &h4F00

%Fgrnd    = 15                 ' editing foreground
%Bgrnd    =  1                 ' editing background

DECLARE FUNCTION fInput(SEG D AS STRING,BYVAL Row AS LONG,BYVAL Col AS
LONG,BYVAL VisLen AS LONG,BYVAL MaxLen AS LONG,BYVAL ExitKeys AS STRING) AS
INTEGER
DECLARE FUNCTION fGetKey() AS INTEGER

FUNCTION PBmain ()

  DIM C        AS LOCAL LONG
  DIM Col      AS LOCAL LONG
  DIM D(5)     AS LOCAL STRING
  DIM ExitKeys AS LOCAL STRING
  DIM F(2,5)   AS LOCAL LONG
  DIM Fld      AS LOCAL LONG
  DIM G        AS LOCAL INTEGER
  DIM Prompt   AS LOCAL STRING
  DIM X        AS LOCAL LONG

  COLOR 0, 15
  CLS
  D(0) = "Mary had a little lamb, its fleece was white as snow."
  G = fInput(D(0), 2, 10, 20, 70, "")
  LOCATE 2, 1: PRINT D(0);

  FOR X = 1 TO 5
    INCR C : Prompt = READ$(C)
    INCR C : D(X)   = READ$(C)
    INCR C : F(0,X) = VAL(READ$(C))
    INCR C : F(1,X) = VAL(READ$(C))
    INCR C : F(2,X) = VAL(READ$(C))
    Col = F(1,X) - LEN(Prompt) - 1
    COLOR 8, 15
    LOCATE F(0,X), Col
    PRINT Prompt;
    COLOR 1, 15
    LOCATE F(0,X), F(1,X)
    PRINT LEFT$(D(X), F(2,X))
  NEXT

  LOCATE 25, 1
  PRINT "Use Arrows to move - F-10 to save & exit - <ESC> to quit";

  ExitKeys = MKI$(%F10_key) + MKI$(%Up_Key) + MKI$(%Down_Key)

  Fld = 1
  DO
    IF Fld < 1 THEN
        Fld = 5
      ELSEIF Fld > 5 THEN
        Fld = 1
    END IF
    G = fInput( D(Fld), F(0,Fld), F(1,Fld), 0, F(2,Fld), ExitKeys)
    SELECT CASE G
      CASE %F10_key : EXIT LOOP
      CASE %Esc_Key : EXIT LOOP
      CASE %Up_Key  : DECR Fld
      CASE ELSE     : INCR Fld
    END SELECT
  LOOP
  FOR X = 1 TO 5
    LOCATE X + 10, 1
    PRINT D(X)
  NEXT
  WAITKEY$

  DATA "Last Name:", "Schullian"   , 6, 20, 17
  DATA "Frst Name:", "Don"         , 7, 20, 17
  DATA "Street:"   , "My Street 27", 8, 20, 30
  DATA "City:"     , "Hometown"    , 9, 20, 30
  DATA "Zip:"      , "12345-2433"  , 9, 56, 10

END FUNCTION
'
'-------------------------------------------------------------------------------
'
FUNCTION fGetKey () EXPORT AS INTEGER

  DIM G AS LOCAL STRING

  G = WAITKEY$

  IF LEN(G) = 1 THEN
      FUNCTION = ASC(G)
    ELSE
      FUNCTION = CVI(G)
  END IF

END FUNCTION
'
'-------------------------------------------------------------------------------
'
FUNCTION fInput (  SEG Datum    AS STRING, _
                 BYVAL Row      AS LONG  , _
                 BYVAL Col      AS LONG  , _
                 BYVAL VisLen   AS LONG  , _
                 BYVAL MaxLen   AS LONG  , _
                 BYVAL ExitKeys AS STRING  ) EXPORT AS INTEGER

  DIM Bgrnd  AS LOCAL LONG          ' original background color
  DIM Cpos   AS LOCAL LONG          ' current cursor position within string
  DIM E      AS LOCAL LONG          ' temp variable
  DIM Fgrnd  AS LOCAL LONG          ' original foreground color
  DIM Inzert AS LOCAL LONG          ' insert state
  DIM KeyVal AS LOCAL LONG          ' incoming key-press value
  DIM MaxOff AS LOCAL LONG          ' maximum offset position
  DIM Offset AS LOCAL LONG          ' 1st character shown in field
  DIM Temp   AS LOCAL STRING * 256  ' working data string

  Temp     = LTRIM$(Datum)
  Inzert   = 10
  ExitKeys = MKI$(%ESC_key) & MKI$(%Enter_Key) & ExitKeys$
  Bgrnd    = SCREENATTR(Row, Col)
  Fgrnd    = (Bgrnd AND 15)
  Bgrnd    = (Bgrnd  \  16)
  Offset   = 1

  IF ( VisLen = 0      )   OR _
     ( VisLen > MaxLen ) THEN VisLen = MaxLen
  MaxOff = (MaxLen - VisLen + 1)

  GOSUB fInputEOL
  COLOR %Fgrnd, %Bgrnd
  CURSOR ON, Inzert

  DO
    IF Cpos < 1 THEN
        Cpos = 1
      ELSEIF Cpos > MaxLen THEN
        Cpos = MaxLen
    END IF
    IF Cpos < Offset THEN
        Offset = Cpos
      ELSEIF (Cpos - Offset + 2) > VisLen THEN
        Offset = MIN(MaxOff,(Cpos - VisLen + 1))
    END IF
    GOSUB fInputPrint
    LOCATE Row, (Col + Cpos - Offset)
    KeyVal = fGetKey
    E = INSTR(ExitKeys, MKI$(KeyVal))
    IF (E AND 1) = 1 THEN EXIT LOOP
    SELECT CASE KeyVal
      CASE 32 TO 255   : IF (Inzert > 10) OR (Cpos = MaxLen) THEN
                             ASC(Temp,Cpos) = KeyVal
                           ELSE
                             Temp = STRINSERT$(Temp,CHR$(KeyVal),Cpos)
                         END IF
                         INCR Cpos
      CASE %BkSpc_Key  : IF Cpos > 1 THEN
                          DECR Cpos
                          Temp = STRDELETE$(Temp,Cpos,1)
                         END IF
      CASE %Del_Key    : Temp = STRDELETE$(Temp,Cpos,1)
      CASE %Home_Key   : Cpos = 1
      CASE %End_Key    : GOSUB fInputEOL
      CASE %Left_Key   : DECR Cpos
      CASE %Right_Key  : INCR Cpos
      CASE %Ins_Key    : IF Inzert = 10 THEN Inzert = 50 ELSE Inzert = 10
                         CURSOR ON, Inzert
    END SELECT
  LOOP

  Offset = 1
  IF KeyVal <> %Esc_Key THEN Datum = TRIM$(Temp)
  Temp = Datum
  COLOR Fgrnd, Bgrnd
  GOSUB fInputPrint

  FUNCTION = KeyVal
  EXIT FUNCTION
  '-----------------------------------------------------------------
  '------------- local routines
  '-----------------------------------------------------------------
  fInputPrint:
    LOCATE Row, Col
    PRINT MID$(Temp, Offset, VisLen);
  RETURN
  '-----------------------------------------------------------------
  fInputEOL:
    FOR Cpos = MaxLen TO 1 STEP -1
      IF ASC(Temp, Cpos) <> 32 THEN EXIT FOR
    NEXT
    INCR Cpos
  RETURN

END FUNCTION