And now to something completly different.
Olav
Here is some source code I wrote way back. The plan was to write something
where the user could enter numbers from the right to the left, and
automatically insert thousand separators. This routine does *not* do this,
but it should be fairly easy to make the necessary changes in the code to
accomplish this.
The code is written in PB35 for DOS.
I believe part of the code(the WriteChar and the Getkey routine) is
copyright Powerbasic.
--
'--------------------------------------------------------Here we
go------------
%FALSE = 0
%TRUE = NOT %FALSE
$STRING 1
$DIM ALL
'------------------------------------------------------------------------------
CLS
DEFINT A-Z
DIM LegalChars AS STRING
DIM Lngth AS INTEGER ' Length of inputfield
DIM Row AS BYTE
DIM CursorPos AS BYTE
DIM Attr AS BYTE
DIM StartFld AS BYTE ' StartPos of inputfield.
DIM ScrnPage AS BYTE
DIM s AS STRING
'------------------------------------------------------------------------------
DIM ScrnSeg AS INTEGER
IF (pbvScrnCard AND 1) = 0 THEN
ScrnSeg = &HB800 ' color monitor
ELSE
ScrnSeg = &HB000 ' mono monitor
END IF
'------------------------------------------------------------------------------
DECLARE FUNCTION GetUserInput(BYVAL Row AS BYTE,BYVAL StrLength AS INTEGER,_
LegalChars AS STRING,BYVAL ScrnSeg AS
INTEGER,_
BYVAL Attr AS BYTE,BYVAL ScrnPage AS BYTE) AS
STRING
DECLARE SUB SetCursorSize(BYVAL Startline?,BYVAL EndLine?)
DECLARE FUNCTION GetInsKeyStatus() AS INTEGER
'------------------------------------------------------------------------------
Row = 8 ' Row where inputfield is located
CursorPos= 5 ' Column where inputfield starts.
Lngth = 5 ' Length of inputfield
Attr = 114 ' Color attribute of inputfield
'------------------------------------------------------------------------------
COLOR 1,7
LOCATE Row,CursorPos,1
PRINT SPACE$(Lngth)
LOCATE Row,CursorPos
'------------------------------------------------------------------------------
LegalChars$="0123456789,"
ScrnPage = 0
s$ = GetUserInput (Row,Lngth,LegalChars$,ScrnSeg,Attr,ScrnPage)
LOCATE 15,1
PRINT "Returned input from user is: " + s$
END
'------------------------------------------------------------------------------
SUB GetKey(ScanCode AS BYTE, AsciiCode AS BYTE)
! push DS ; save DS for PowerBASIC
! mov AX, &H1000 ; is a key in the buffer?
! int &H16 ; call keyboard BIOS
! les DI, AsciiCode ; point ES:DI to AsciiCode variable
! mov Byte Ptr ES:[DI], AL ; store ASCII Code in variable
! les DI, ScanCode ; point ES:DI to ScanCode variable
! mov Byte Ptr ES:[DI], AH ; store Scan Code in variable
! pop DS ; restore DS for PowerBASIC
END SUB
'------------------------------------------------------------------------------
SUB WriteChar(BYVAL AsciiCode AS BYTE,BYVAL Row AS BYTE, _
BYVAL CursorPos AS BYTE,BYVAL Attr AS BYTE, _
BYVAL ScrnSeg AS INTEGER)
! push DS ; save DS for PowerBASIC
! mov AX, ScrnSeg ; put screen segment in AX
! mov ES, AX ; and in ES
! mov AX, Row ; put row in AX
! dec AX ; minus one
! mov CX, 160 ; AX =
! mul CX ; AX * 160
! mov DI, AX ; put it in DI
! mov AX, CursorPos ; put column in AX
! dec AX ; minus one
! shl AX, 1 ; times 2
! add DI, AX ; add to DI
! mov AH, Attr ; put attribute in AH
! mov AL, Asciicode ; put top left char in AL
! stosb ; write it to the screen
! pop ds
END SUB
'------------------------------------------------------------------------------
FUNCTION GetChar(BYVAL page AS BYTE) AS BYTE
'The value of 'char' is returned in AL
! push ds
! mov ah,&H08
! mov bh,page ; 1st page = 0, 2nd page = 1 etc
! int &H10
! mov FUNCTION,al
! pop ds
END FUNCTION
'------------------------------------------------------------------------------
SUB SetCursorSize(BYVAL Startline AS BYTE,BYVAL EndLine AS BYTE)
! push ds
! mov ah,&H01
! mov ch,Startline?
! mov cl,Endline?
! int &H10
! pop ds
END SUB
'----------------------------------------------------------------------------
SUB SetCursorPos(BYVAL Row AS BYTE,BYVAL CursorPos AS BYTE,_
BYVAL Page AS BYTE)
! push ds
! mov dh,Row
! dec dh ; Row must be zero based
! mov dl,CursorPos
! dec dl ; CursorPos have to be zero based.
! mov bh,page ; 0 = the first screen page
! mov ah,&H02
! int &H10
! pop ds
END SUB
'------------------------------------------------------------------------------
FUNCTION GetCursorPos(BYVAL page AS BYTE) AS BYTE
' Returns DH = Row. DL = CursorPos. Both values is zero based
! push ds
! mov ah,&H03
! mov bh,page
! int &h10
! inc dl ; Return the 1-based CursorPos
! mov FUNCTION,dl
! pop ds
END FUNCTION
'------------------------------------------------------------------------------
FUNCTION MoveCharRight(BYVAL Row AS BYTE,BYVAL LastPos AS BYTE,_
BYVAL Attr AS BYTE,BYVAL ScrnSeg AS INTEGER,_
BYVAL EndFld AS BYTE,BYVAL ScrnPage AS BYTE)
' This routine is called when the user has enter a character in the
' input field, in a position left to the rightmost character and
' override mode is off
DIM AsciiCode AS LOCAL BYTE
DIM Count AS LOCAL BYTE
DIM CursorPos AS LOCAL BYTE
DIM OldCursorPos AS LOCAL BYTE
IF LastPos >= EndFld THEN
EXIT FUNCTION ' Input field is full
END IF
CursorPos = GetCursorPos(ScrnPage)
IF CursorPos - LastPos = 1 THEN
' no characters to the right of the cursor position
EXIT FUNCTION
END IF
MoveCharInit:
OldCursorPos = CursorPos
Count = LastPos + 1 - CursorPos ' Number of times to repeat the loop
! push ds
! mov cx, Count
MoveChars:
! push cx ; must preserve cx register.It counts down by one for each loop
CALL SetCursorPos(Row,LastPos,ScrnPage)
AsciiCode = GetChar(ScrnPage)
WriteChar AsciiCode,Row,LastPos+1,Attr,ScrnSeg
! pop cx
DECR LastPos
! loop MoveChars
! pop ds
CALL SetCursorPos(Row,OldCursorPos,ScrnPage) ' Position the cursor to
where we started
FUNCTION = %TRUE
END FUNCTION
'-------------------------------------------------------------------------
FUNCTION MoveCharLeft(BYVAL Row AS BYTE,BYVAL LastPos AS BYTE,_
BYVAL Attr AS BYTE,BYVAL ScrnSeg AS INTEGER,_
BYVAL ScrnPage AS BYTE)
' This routine is called when the user has pressed the delete key
DIM AsciiCode AS LOCAL BYTE
DIM Count AS LOCAL BYTE
DIM CursorPos AS LOCAL BYTE
CursorPos = GetCursorPos(ScrnPage)
IF LastPos - CursorPos >= 0 THEN
Count = LastPos - CursorPos 'Number of times to repeat the loop
IF Count = 0 THEN Count = 1
ELSE
EXIT FUNCTION
END IF
! push ds
! mov cx, Count
MoveCharsLeft:
! push cx ; Preserve cx register.It counts down by one for each loop
CALL SetCursorPos(Row,CursorPos+1,ScrnPage)
AsciiCode = GetChar(ScrnPage)
WriteChar AsciiCode,Row,CursorPos,Attr,ScrnSeg
! pop cx
INCR CursorPos
! loop MoveCharsLeft
! pop ds
WriteChar 32,Row,LastPos,Attr,ScrnSeg ' Remove last char in the field
FUNCTION = %TRUE
END FUNCTION
'-------------------------------------------------------------------------
FUNCTION MoveCharLeftBS(BYVAL Row AS BYTE,BYVAL LastPos AS BYTE,_
BYVAL Attr AS BYTE,BYVAL ScrnSeg AS INTEGER,_
BYVAL ScrnPage AS BYTE)
' This routine is called when the user has pressed the backspace key
DIM AsciiCode AS LOCAL BYTE
DIM Count AS LOCAL BYTE
DIM CursorPos AS LOCAL BYTE
CursorPos = GetCursorPos(ScrnPage)
IF LastPos + 1 - CursorPos >= 0 THEN
Count = LastPos - CursorPos + 1 ' Number of times to repeat the loop
IF Count = 0 THEN Count = 1
ELSE
EXIT FUNCTION
END IF
! push ds
! mov cx, Count
MoveCharsBS:
! push cx ; Preserve the cx register.It counts down by one for each loop
CALL SetCursorPos(Row,CursorPos,ScrnPage)
AsciiCode = GetChar(ScrnPage)
WriteChar AsciiCode,Row,CursorPos-1,Attr,ScrnSeg
! pop cx
INCR CursorPos ' reads next char that is to be moved to the left
! Loop MoveCharsBS
! pop ds
WriteChar 32,Row,LastPos,Attr,ScrnSeg ' Remove last char in the field
FUNCTION = %TRUE
END FUNCTION
'-------------------------------------------------------------------------
FUNCTION GetInsKeyStatus() AS INTEGER
' Returns the staus of the insert key which will be either
' on(true) or off(false)
DIM g AS LOCAL BYTE
! push ds
! mov AX,&H1200
! int &H16
! mov g,AL
IF BIT(g,7) THEN
SetCursorSize 7,7 ' Ins is on.Set a small cursor
GetInsKeyStatus = %TRUE
ELSE
SetCursorSize 5,7 ' Ins is off.Show a cursor slightly larger
GetInsKeyStatus = %FALSE
END IF
! pop ds
END FUNCTION
'------------------------------------------------------------------------
FUNCTION GetUserInput(BYVAL Row AS BYTE,BYVAL StrLength AS INTEGER,_
LegalChars AS STRING,BYVAL ScrnSeg AS INTEGER,_
BYVAL Attr AS BYTE,BYVAL ScrnPage AS BYTE) AS STRING
DIM LastPos AS LOCAL BYTE
DIM StartFld AS LOCAL BYTE
DIM AsciiCode AS LOCAL BYTE
DIM ScanCode AS LOCAL BYTE
DIM EndFld AS LOCAL BYTE
DIM InsKeyOn AS LOCAL INTEGER
DIM OldCursorPos AS LOCAL BYTE
DIM CursorPos AS LOCAL BYTE
DIM s AS LOCAL STRING
DIM Retv AS LOCAL INTEGER
CursorPos = GetCursorPos(ScrnPage) ' Returns a one-based cursor position
EndFld = CursorPos + StrLength-1 ' Last input position in the input
field.
StartFld = CursorPos
LastPos = CursorPos - 1 ' Rightmost position where a digit is
currently located
InsKeyOn = GetInsKeyStatus()
DO
Retv = 0
GetKey ScanCode?, AsciiCode?
IF AsciiCode? = 0 THEN
IF ScanCode? = 15 THEN ' Shift+tab
EXIT LOOP
END IF
ELSEIF AsciiCode? = 224 THEN ' Extended keys
GOTO ExtendedKeys
ELSEIF AsciiCode? = 8 THEN ' Backspace key
GOTO BackspaceKey
ELSEIF AsciiCode? = 9 THEN ' Right Tab
'Leave the input field
EXIT LOOP
ELSEIF AsciiCode? = 27 THEN ' EcsKey
GOTO Esckey
ELSEIF AsciiCode? = 32 THEN ' Spacebar
GOTO Spacebar
END IF
'---------------------------------------------------------------------------
IF INSTR(LegalChars$,CHR$(AsciiCode?)) THEN ' A valid key was pressed
IF InsKeyOn THEN
Retv = MoveCharRight(Row,LastPos,Attr,ScrnSeg,EndFld,ScrnPage)
GOSUB InsModeOn
ELSE
GOSUB InsModeOff
END IF
ELSE ' illegal character
BEEP
END IF
ITERATE LOOP
'------------------------------------------------------------------------------
InsModeOff:
' Writes a character in the input field when override mode is off
IF CursorPos <= EndFld THEN
WriteChar AsciiCode?,Row,CursorPos,Attr,ScrnSeg
IF CursorPos < EndFld THEN
INCR CursorPos
CALL SetCursorPos (Row,CursorPos,ScrnPage)
END IF
IF CursorPos > LastPos THEN ' override left to the last char pos does
not increase lastpos
INCR LastPos
END IF
END IF
RETURN
'------------------------------------------------------------------------------
InsModeOn:
' Writes a character in the input field when override mode is on
IF LastPos < EndFld THEN
WriteChar AsciiCode?,Row,CursorPos,Attr,ScrnSeg
INCR LastPos
IF CursorPos < EndFld THEN
INCR CursorPos
CALL SetCursorPos (Row,CursorPos,ScrnPage)
END IF
END IF
RETURN
'------------------------------------------------------------------------------
ExtendedKeys:
IF ScanCode? = 71 THEN ' HomeKey
GOTO HomeKey
ELSEIF ScanCode? = 75 THEN ' LeftArrow
GOTO LeftArrow
ELSEIF ScanCode? = 77 THEN ' RightArrow
GOTO RightArrow
ELSEIF ScanCode? = 79 THEN ' EndKey
GOTO EndKey
ELSEIF ScanCode? = 82 THEN ' InsertKey
' change the cursor's size
InsKeyOn = GetInsKeyStatus()
ITERATE LOOP
ELSEIF ScanCode? = 83 THEN ' DeleteKey
GOTO Delkey
ELSE
ITERATE LOOP
END IF
'------------------------------------------------------------------------------
RightArrow:
IF CursorPos < LastPos + 1 THEN
INCR CursorPos
CALL SetCursorPos (Row ,CursorPos,ScrnPage)
END IF
ITERATE LOOP
'------------------------------------------------------------------------------
LeftArrow:
IF CursorPos > StartFld THEN
DECR CursorPos
CALL SetCursorPos (Row ,CursorPos,ScrnPage)
END IF
ITERATE LOOP
'------------------------------------------------------------------------------
EndKey:
IF LastPos < EndFld THEN
CALL SetCursorPos (Row,LastPos+1,ScrnPage)
ELSE
CALL SetCursorPos (Row,LastPos,ScrnPage)
END IF
CursorPos = GetCursorPos(ScrnPage)
ITERATE LOOP
'------------------------------------------------------------------------------
DelKey:
IF MoveCharLeft(Row,LastPos+1,Attr,ScrnSeg,ScrnPage) THEN
CALL SetCursorPos(Row,CursorPos,ScrnPage) ' Position the cursor to where
we started
DECR LastPos
END IF
ITERATE LOOP
'------------------------------------------------------------------------------
HomeKey:
CursorPos = StartFld
CALL SetCursorPos (Row,CursorPos,ScrnPage)
ITERATE LOOP
'------------------------------------------------------------------------------
BackSpaceKey:
IF CursorPos > StartFld THEN
IF MoveCharLeftBS(Row,LastPos+1,Attr,ScrnSeg,ScrnPage) THEN
IF CursorPos > StartFld THEN
DECR CursorPos
END IF
CALL SetCursorPos(Row,CursorPos,ScrnPage) ' Position the cursor to where
we started
DECR LastPos
END IF
END IF
ITERATE LOOP
'------------------------------------------------------------------------------
Spacebar:
BEEP
ITERATE LOOP
'------------------------------------------------------------------------------
EscKey:
SetCursorPos Row,StartFld,ScrnPage
CursorPos = StartFld
! push ds
! mov cx,StrLength
LoopEsc:
! push cx
WriteChar 32,Row,CursorPos,Attr,ScrnSeg
INCR CursorPos
! pop cx
! loop LoopEsc
! pop ds
CursorPos = StartFld ' Column where the input field starts
LastPos = CursorPos - 1
LOOP UNTIL AsciiCode? = ASC("q") OR AsciiCode? = ASC("Q")
'-----------------------------------------------------------------------
' The user has now left the input field
DIM i AS LOCAL LONG
FOR i = StartFld TO LastPos
CALL SetCursorPos(Row,i,ScrnPage)
AsciiCode = GetChar(ScrnPage)
s$ = s$ + CHR$(AsciiCode)
NEXT
FUNCTION = s ' return user's input string to the caller
END FUNCTION
'------------------------------------------------------------------------