FB_input routine 
Author Message
 FB_input routine

fInput% function for FirstBASIC

  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

  |____//_/ \_\(____/\__/|_|     |_|    www.DASoftVSS.com
  ___________________________________   www.basicguru.com
      Vertical Software Solutions

'----------------------------------------------------------------------
' fGetKey%(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%
'--------------------------------------------------------------------------

%EscKey   = &h001B             ' key codes returned by fGetKey%
%EnterKey = &h000D
%BkSpcKey = &h0008
%DelKey   = &h5300
%UpKey    = &h4800
%DownKey  = &h5000
%InsKey   = &h5200
%LeftKey  = &h4B00
%RightKey = &h4D00
%CtrlDel  = &h9300
%F10key   = &h4400
%HomeKey  = &h4700
%EndKey   = &h4F00

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

'---------------------------------------------------------------
'-------------------- start of test code
'---------------------------------------------------------------
COLOR 0, 7
CLS
' ================================================
' ======= this demonstrates the use for one field
' ================================================
D$ = "Mary had a little lamb, its fleece was white as snow."
G% = fInput%(D$, 2, 10, 20, 70, "")
LOCATE 2, 1: PRINT D$;
' ==================================================
' ====== the following uses an array for 5 fields
' ==================================================
DIM D$(5)
DIM F%(2,5)

RESTORE TestData
FOR X% = 1 TO 5
  READ Prompt$
  READ D$(X%), F%(0,X%), F%(1,X%), F%(2,X%)
  Col% = F%(1,X%) - LEN(Prompt$) - 1
  COLOR 8, 7
  LOCATE F%(0,X%), Col%
  PRINT Prompt$;
  COLOR 1, 7
  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$(%F10key) + MKI$(%UpKey) + MKI$(%DownKey)

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 %F10key : EXIT LOOP
    CASE %EscKey : EXIT LOOP
    CASE %UpKey  : DECR Fld%
    CASE ELSE    : INCR Fld%
  END SELECT
LOOP
FOR X% = 1 TO 5
  LOCATE X% + 10, 1
  PRINT D$(X%)
NEXT

TestData:
  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

FUNCTION fGetKey%

  LOCAL G$
  LOCAL L%

  DO
    G$ = INKEY$
    L% = LEN(G$)
  LOOP UNTIL L% > 0

  IF L% = 1 THEN
      fGetKey% = ASC(G$)
    ELSE
      fGetKey% = CVI(G$)
  END IF

END FUNCTION
'
'-------------------------------------------------------------------
'
FUNCTION fInput% ( Datum$, Row%, Col%, VisLen%, MaxLen%, ExitKeys$ )

  LOCAL Bgrnd%                ' original background color
  LOCAL Cpos%                 ' current cursor position within string
  LOCAL E%                    ' temp variable
  LOCAL Exet$                 ' string vals of all exit keys
  LOCAL Fgrnd%                ' original foreground color
  LOCAL Inzert%               ' insert state
  LOCAL KeyVal%               ' incoming key-press value
  LOCAL MaxOff%               ' maximum offset position
  LOCAL Offset%               ' 1st character shown in field
  LOCAL Temp$$                ' working data string

  MAP Temp$$ * MaxLen%

  Temp$$  = LTRIM$(Datum$)
  Inzert% = 31
  Exet$   = MKI$(%EscKey) + MKI$(%EnterKey) + ExitKeys$
  Bgrnd%  = SCREEN(Row%, Col%, 1)
  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
  LOCATE , , , Inzert%, 31

  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% = (Cpos% - VisLen% + 1)
        IF Offset% > MaxOff% THEN Offset% = MaxOff%
    END IF
    GOSUB fInputPrint
    LOCATE Row%, (Col% + Cpos% - Offset%), 1
    KeyVal% = fGetKey%
    E% = INSTR(Exet$, MKI$(KeyVal%))
    IF (E% AND 1) = 1 THEN EXIT LOOP
    SELECT CASE KeyVal%
      CASE 32 TO 255 : IF (Inzert% = 0) OR (Cpos% = MaxLen%) THEN
                           MID$(Temp$$, Cpos%, 1) = CHR$(KeyVal%)
                         ELSE
                           Temp$$ = LEFT$(Temp$$, Cpos% - 1) + _
                                     CHR$(KeyVal%)           + _
                                     MID$(Temp$$, Cpos%)
                       END IF
                       INCR Cpos%
      CASE %BkSpcKey : IF Cpos% > 1 THEN
                         DECR Cpos%
                         GOSUB fInputStrip
                       END IF
      CASE %DelKey   : GOSUB fInputStrip
      CASE %HomeKey  : Cpos% = 1
      CASE %EndKey   : GOSUB fInputEOL
      CASE %LeftKey  : DECR Cpos%
      CASE %RightKey : INCR Cpos%
      CASE %InsKey   : Inzert% = ( Inzert% XOR 31 )
                       LOCATE , , , Inzert%, 31
    END SELECT
  LOOP

  Offset% = 1
  IF KeyVal% <> %EscKey THEN
      Temp$$ = LTRIM$(Temp$$)
      Datum$ = RTRIM$(Temp$$)
    ELSE
      Temp$$ = Datum$
  END IF
  COLOR Fgrnd%, Bgrnd%
  GOSUB fInputPrint

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

END FUNCTION



Mon, 02 Sep 2002 03:00:00 GMT  
 
 [ 1 post ] 

 Relevant Pages 

1. One routine-global variables, no globals lots of routines

2. Routine call in Routine

3. Double Word Rectangle Routine and Circle Routine

4. graphics routines, keyboard routines,e tc.

5. Utility to extract all routines under a routine?

6. Interfacing C routine with CVF routine called from VB

7. A J routine for astronomical precession.

8. z/OS system routines and save areas

9. DYNALLOC Assembler Routine Extended to Handle HFS Path Name

10. Assembler Exit Routines

11. Invoking ACS routines

12. assembler routine implementing CRC16

 

 
Powered by phpBB® Forum Software