Code:
' FILE : EDIT$U.BAS
' PURPOSE : Make A "Unit" out of SUB Editstring
' COPYRIGHT: Placed in the public domain by the author, Michael Mattias.
' USAGE:
' Place cursor on correct ROW
' CALL EditString (Text$, LeftCol%, MaxSize%, KeyCode%, Upper)
' Text% = string to be edited (default value)
' LeftCol% = column where string starts
' MaxSize% = maximum length permitted. (Beeps if attemt to execeed)
' KeyCode% = Value of key used to exit edit routine (see equates)
' Upper% = Convert all letters to uppercase if non-zero
' HISTORY ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' 01.21.92 Coded as unit PB 2.1
' 03.13.93 brought into PB3
' 01.20.94 eliminated EXTERNAL ESColorScreen
' 09.09.94 problem with cursor was that I had the BIOS int h&10 reporting
' color when it should be mono. Fixed. Then I changed the cursor
' to make the insert cursor the small line, and the overwrite
' cursor the block.
'12.27.95 Move to PB 3.2
'11.01.98 Move to PB/DOS 3.5
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' Valid values for $STACK are 1536 thru 32766 (decimal)
$LIB COM-, IPRINT+, GRAPH-, CGA-, LPT-, FULLFLOAT-
$ERROR ALL OFF
'$LIB options include:
' COM - Serial communications support
' LPT - line printer support
' GRAPH - all graphics If a certain graphics is enabled,
' CGA all subordinate graphics are also
' EGA enabled. Priority is CGA,EGA,VGA;
' VGA HERC is independent. GRAPH- and CGA- do
' HERC permit the use of COLOR statements
'FULLFLOAT - full floating point emulation
' ALL - all the above
'$FLOAT PROCEDURE
' $FLOAT options are:
' PROCEDURE - larger but faster than EMULATE; runs on any CPU
' EMULATE - smaller but slower than EMULATE
' NPX - runs only on 80x87, 80386 and 80486 processors
$OPTION AUTODIM-, CNTLBREAK+
$COMPILE UNIT
DEFINT A - Z ' Variables are Integer unless overridden
'======= End Standard Materials ==========================================
ProgramConstants:
'======== Named Program Constants ============
%FALSE = 0 : %TRUE = NOT %FALSE
%Home = -71 ' Cursor Movement Keys
%EndKey = -79 ' used in SUB
%LeftArrow = -75
%RightArrow = -77
%UpArrow = -72
%DownArrow = -80
%Escape = 27
%PageUp = -73
%PageDown = -81
%Insert = -82
%Delete = -83
%F5Key = -63
%F9Key = -67
%F10Key = -68
%CR = 13 ' Carriage return
%LF = 10 ' Line feed
%DBSpace = 8 ' destructive backspace
'====== End Named Program Constants ==========
SharedDataNames:
' ========= SHARED Data Names ====================
'EXTERNAL ESColorScreen 'eliminated 1/20/94
' ======== End SHARED Data Names =================
'ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
'º SUB TO EDIT Text Strings SUB EditString º
'ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
SUB EditString (Text$, LeftCol%, MaxSize%, KeyCode%, Upper) PUBLIC
' NOTE : Modified 8.29.91 to pass "Upper". If Upper = NOT 0, THEN
' all letters will be capitalized
LOCAL Edit$,TextPos%, Ky$ , RightCol%, TopScan%, BottomScan%, Xin%, HoldY
LOCAL AL
STATIC Inserting%, CursorSize%, BeenHere%
' Use BIOS interrupt 10h service 3 to get/ save incoming cursor shape
' INPUT : BH = Page number AH = 3
' OUTPUT : DH,DL = Current Row, Column; CH,CL = cursor top,bottom
'
REG 1, &h0300 ' set AH
REG 2, &h0000 ' set BH to page 0 ( default)
CAll Interrupt &h10
TopScan% = Reg(3) \ &hFF ' high byte (CH)
BottomScan% = Reg(3) AND &h00FF ' low byte (CL)
Xin% = POS(0) ' save cursor X at entry
RightCol% = LeftCol% + MaxSize% - 1 ' set up text area
IF BeenHere% = %FALSE THEN ' preserve insert/cursor size
BeenHere% = %TRUE ' relationship from last time
REG 1, &h0F00 ' use BIOS to get color/mono
CALL INTERRUPT &h10 ' on first use only
AL = REG(1) AND &hFF
IF AL = 7 THEN ' MONO monitor (fixed 9/9/94)
CursorSize% = 12 ' Monochrome uses 13 scan lines
ELSE ' (numbered 0 to 12)
CursorSize% = 7 ' Color uses 8 (0 to 7)
END IF
Inserting% = %TRUE ' my preferred default
END IF
Edit$ = LEFT$(Text$ + SPACE$(Maxsize%), MaxSize%) 'space pad the text to
'the max field size
' TextPos% = POS(0) - LeftCol% + 1 'Get the cursor's location to
' IF TextPos% < 1 THEN TextPos% = 1 'see where to begin editing
' IF TextPos% > LEN(Edit$) THEN TextPos% = LEN(Edit$)
LOCATE , LeftCol% ' go to beg of field
HoldY = CSRLIN ' save this to check for linewrap
PRINT Edit$; ' and put up the string
LOCATE HoldY, LeftCol% ' restore cursor to beg of line
' done for linewrap situation
IF Inserting% THEN ' present correct cursor
LOCATE ,,,CursorSize% -1, CursorSize% ' single line cursor for insert mode
ELSE
LOCATE ,,, CursorSize% \ 2, CursorSize% ' block for overwrite
END IF
' Insert this para to have editing start at other than start of field.
' requires NoHome% be EXTERNAL or added to call parameters
' If NoHome% THEN
' TextPos% = Xin% ' set by calling sub
' ELSE ' not coming from editscreen
' TextPos% = 1
' END IF
'----- Main loop for handling key presses
DO
LOCATE , LeftCol% + TextPos% - 1, 1 'Locate the cursor, turn it on
DO 'Wait for a key press
Ky$ = INKEY$
LOOP UNTIL LEN(Ky$)
Upper1:
IF Upper THEN Ky$ = UCASE$(Ky$)
IF LEN(Ky$) = 1 THEN 'Make a key code from Ky$
KeyCode% = ASC(Ky$) 'Single character key
ELSE
KeyCode% = -ASC(RIGHT$(Ky$, 1)) 'Extended keys are negative
END IF
'----- Branch according to the key pressed
SELECT CASE KeyCode%
CASE %DBSpace 'Destructive BS
IF LeftCol% + TextPos% -1 > 1 THEN ' if left col is at 1
TextPos% = TextPos% - 1 'Back up the text pointer
LOCATE , LeftCol% + TextPos% - 1, 0 'Locate 1 to the left
IF TextPos% > 0 THEN 'Still within the field?
IF Inserting% THEN 'Truncate the string
MID$(Edit$, TextPos%) = MID$(Edit$, TextPos% + 1) + " "
ELSE 'Blank the letter
MID$(Edit$, TextPos%) = " "
END IF
HoldY = CSRLIN 'for linewrap
PRINT MID$(Edit$, TextPos%); 'Print new part of text
LOCATE HoldY ' restore if Line Wrap
ELSE ' we're at start of field
INCR TextPos% ' reset
Beep
END IF
ELSE ' trying DBSpace at 1
BEEP
END IF
CASE %CR,%Escape,%UpArrow, %DownArrow
EXIT LOOP ' Bail out
CASE 32 TO 254 ' printable characters
LOCATE , , 0 ' Turn the cursor off
HoldY = CSRLIN ' for linewrap!
IF Inserting% THEN ' Expand the text string
MID$(Edit$, TextPos%) = Ky$ + MID$(Edit$, TextPos%)
PRINT MID$(Edit$, TextPos%); ' Print the expanded part
ELSE
MID$(Edit$, TextPos%) = Ky$ 'Put the new letter in string
PRINT Ky$; 'Print the letter
END IF
LOCATE HoldY ' fix if linewrap
IF TextPos% <> LEN(Edit$) THEN
INCR TextPos% 'Increment the text pointer
END IF ' if not at end
CASE %LeftArrow
IF TextPos% = 1 THEN
BEEP
ELSE
DECR TextPos% 'Decrement text pointer
END IF
CASE %RightArrow
IF Textpos% = LEN(Edit$) THEN
BEEP
ELSE
INCR TextPos% 'Increment text pointer
END IF
CASE %Home
TextPos% = 1 'Move text pointer to 1
CASE %EndKey
FOR N% = LEN(Edit$) TO 1 STEP -1 'Look backwards for non-blank
IF MID$(Edit$, N%, 1) <> " " THEN EXIT FOR
NEXT N%
TextPos% = N% + 1 'Set pointer to last char +1
IF TextPos% > LEN(Edit$) THEN TextPos% = LEN(Edit$)
CASE %Insert
Inserting% = NOT Inserting% 'Toggle the Insert state
IF Inserting% THEN 'Adjust the cursor size
LOCATE , , , CursorSize% - 1, CursorSize%
ELSE
LOCATE , , , CursorSize% \ 2, CursorSize%
END IF
CASE %Delete 'Truncate the text
MID$(Edit$, TextPos%) = MID$(Edit$, TextPos% + 1) + " "
LOCATE , , 0 'Print the truncated part
HoldY = CSRLIN
PRINT MID$(Edit$, TextPos%);
LOCATE HoldY
CASE ELSE 'All other keys,
EXIT LOOP ' bail out
END SELECT
LOOP
' In here, we could strip trailing blanks. That way you always pass the data,
' and get back the data. Also, we should restore the incoming cursor shape.
Text$ = Edit$ ' set the text to new value
' Restore the incoming cursor ....
LOCATE ,,,TopScan%, BottomScan%
END SUB