This program is the latest version of my multi-line input routine which works without the need for addins. It can do numeric only input plus normal text and can do single or multi-line. Also will allow you to border the text with a line. An example program is included below, just paste into dbpro and run.
#CONSTANT MaxTextBoxWidth 100
#CONSTANT MaxTextBoxHeight 100
GLOBAL DIM TextBoxArray(MaxTextBoxWidth,MaxTextBoxHeight) AS INTEGER
LOCAL result AS STRING
LOCAL x AS INTEGER
LOCAL y AS INTEGER
LOCAL width AS INTEGER
LOCAL title AS STRING
LOCAL numChars AS INTEGER
LOCAL numRows AS INTEGER
GLOBAL fontWidth AS INTEGER
GLOBAL fontHeight AS INTEGER
fontWidth=TEXT WIDTH("Q")
fontHeight=TEXT HEIGHT("Q")
result=""
title="Enter the Description"
numChars=30
numRows=5
if LEN(title)>numChars then width=LEN(title) else width=numChars
x=INT((SCREEN WIDTH()-(width*fontWidth))/2)
y=INT((SCREEN HEIGHT()-(2*fontHeight))/2)
CLS
TEXT x,y,title
result=TextBoxInput(0, x, y+fontHeight, numChars, numRows, "", 1)
PRINT "Finish"
WAIT KEY
END
function TextBoxInput(numOnly AS INTEGER, startX AS INTEGER,startY AS INTEGER,numCols AS INTEGER,numRows AS INTEGER, originalText AS STRING,drawBorder AS INTEGER)
LOCAL posX AS INTEGER
LOCAL posY AS INTEGER
LOCAL endX AS INTEGER
LOCAL endY AS INTEGER
LOCAL lth AS INTEGER
LOCAL lp1 AS INTEGER
LOCAL lp2 AS INTEGER
LOCAL totalWidth AS INTEGER
LOCAL isNumber AS INTEGER
LOCAL allow AS INTEGER
LOCAL char AS STRING
LOCAL key AS STRING
LOCAL finalString AS STRING
` Set up array to spaces
ClearTextBox()
CLEAR ENTRY BUFFER
totalWidth=numCols*fontWidth
if (totalWidth+startX)>SCREEN WIDTH()
CLS
PRINT "Fatal error, TextBoxInput is trying to display text past the width of the screen"
PRINT "Screen width =";SCREEN WIDTH()
PRINT "total message width=";totalWidth
PRINT "startX =";startX
PRINT "Furthest point =";startX+totalWidth
PRINT "Number of colums =";numCols
PRINT "fontWidth =";fontWidth
WAIT KEY
END
endif
` If border was requested draw now
if drawBorder=1
LINE startX-2, startY-2, startX+(numCols*fontWidth)+2, startY-2
LINE startX+(numCols*fontWidth)+2, startY-2, startX+(numCols*fontWidth)+2, startY+(numRows*fontHeight)+2
LINE startX+(numCols*fontWidth)+2, startY+(numRows*fontHeight)+2, startX-2, startY+(numRows*fontHeight)+2
LINE startX-2, startY+(numRows*fontHeight)+2, startX-2, startY-2
endif
` Convert previous text to the array
posX=0
posY=0
lth=LEN(originalText)
for lp1=1 TO lth
TextBoxArray(posX, posY)=ASC(MID$(originalText, lp1))
posX=posX+1
if posX>(numCols-1)
posX=0
posY=posY+1
if posY>(numRows-1)
posY=0
endif
endif
next lp1
if numOnly=1 AND originalText="0" then posX=0
` Set up text styles and colours
SET TEXT OPAQUE
INK RGB(255,255,255),0
` Display contents of window
RefreshTextBox(startX, startY, numCols, numRows)
` Main loop
do
` Do stuff while in text input
InTextProcessing()
`Display the cursor over current square
SET TEXT TRANSPARENT
TEXT startX+(posX*fontWidth),StartY+(posY*fontHeight),"_"
SET TEXT OPAQUE
if RETURNKEY()
while RETURNKEY()
endwhile
TEXT startX+(posX*fontWidth),StartY+(posY*fontHeight),CHR$(TextBoxArray(posX,posY))
EXIT
endif
if LEFTKEY()
char=CHR$(TextBoxArray(posX,posY))
TEXT startX+(posX*fontWidth),StartY+(posY*fontHeight),char
posX=posX-1
if posX<0
posX=numCols-1
posY=posY-1
if posY<0
posY=numRows-1
endif
endif
SET TEXT TRANSPARENT
TEXT startX+(posX*fontWidth),StartY+(posY*fontHeight),"_"
SET TEXT OPAQUE
while LEFTKEY()
endwhile
endif
if RIGHTKEY()
char=CHR$(TextBoxArray(posX,posY))
TEXT startX+(posX*fontWidth),StartY+(posY*fontHeight),char
posX=posX+1
if posX>(numCols-1)
posX=0
posY=posY+1
if posY>(numRows-1)
posY=0
endif
endif
SET TEXT TRANSPARENT
TEXT startX+(posX*fontWidth),StartY+(posY*fontHeight),"_"
SET TEXT OPAQUE
while RIGHTKEY()
endwhile
endif
if UPKEY()
char=CHR$(TextBoxArray(posX,posY))
TEXT startX+(posX*fontWidth),StartY+(posY*fontHeight),char
posY=posY-1
if posY<0
posY=(numRows-1)
endif
SET TEXT TRANSPARENT
TEXT startX+(posX*fontWidth),StartY+(posY*fontHeight),"_"
SET TEXT OPAQUE
while UPKEY()
endwhile
endif
if DOWNKEY()
char=CHR$(TextBoxArray(posX,posY))
TEXT startX+(posX*fontWidth),StartY+(posY*fontHeight),char
posY=posY+1
if posY>(numRows-1)
posY=0
endif
SET TEXT TRANSPARENT
TEXT startX+(posX*fontWidth),StartY+(posY*fontHeight),"_"
SET TEXT OPAQUE
while DOWNKEY()
endwhile
endif
key=ENTRY$()
key=MID$(key,1)
` Backspace
if ASC(key)=8
char=CHR$(TextBoxArray(posX,posY))
TEXT startX+(posX*fontWidth),StartY+(posY*fontHeight),char
posX=posX-1
if posX<0
posX=(numCols-1)
posY=posY-1
if posY<0
posY=(numRows-1)
endif
endif
TextBoxArray(posX,posY)=32
TEXT startX+(posX*fontWidth),StartY+(posY*fontHeight)," "
endif
`Normal keypress
if ASC(key)>=48 AND ASC(key)<=57
isNumber=1
else
if posX=0 AND posY=0 AND key="-"
isNumber=1
else
isNumber=0
endif
endif
allow=1
if numOnly=1 AND isNumber=0 then allow=0
if key<>"" AND ASC(key)>31 AND allow=1
TextBoxArray(posX,posY)=ASC(key)
TEXT startX+(posX*fontWidth),StartY+(posY*fontHeight),key
posX=posX+1
if posX>(numCols-1)
posX=0
posY=posY+1
if posY>(numRows-1)
posY=0
endif
endif
endif
if SCANCODE()=211
for lp1=posX TO (numCols-2)
TextBoxArray(lp1,posY)=TextBoxArray(lp1+1,posY)
next lp1
if posY=numRows-1
TextBoxArray(numCols-1,posY)=32
else
TextBoxArray(numCols-1,posY)=TextBoxArray(0,posY+1)
endif
for lp1=posY+1 TO (numRows-1)
for lp2=0 TO (numCols-2)
TextBoxArray(lp2,lp1)=TextBoxArray(lp2+1,lp1)
next lp2
if lp1=numRows-1
TextBoxArray(numCols-1,lp1)=32
else
TextBoxArray(numCols-1,lp1)=TextBoxArray(0,lp1+1)
endif
next lp1
RefreshTextBox(startX, startY, numCols, numRows)
while SCANCODE()=211
endwhile
endif
CLEAR ENTRY BUFFER
loop
CLEAR ENTRY BUFFER
endX=0
endY=0
` work out end of string
for posY=(numRows-1) TO 0 STEP -1
for posX=(numCols-1) TO 0 STEP -1
if TextBoxArray(posX,posY)<>32
if endX=0
endX=posX
endY=posY
endif
endif
next posX
next posY
` Generate final string
finalString=""
for posY=0 TO endY-1
for posX=0 TO (numCols-1)
finalString=finalString+CHR$(TextBoxArray(posX,posY))
next posX
next posY
for posX=0 TO endX
finalString=finalString+CHR$(TextBoxArray(posX,endY))
next posX
SET TEXT TRANSPARENT
if finalString=" " then finalString=""
if numOnly AND finalString="-" then finalString="0"
endfunction finalString
function ClearTextBox()
LOCAL posX AS INTEGER
LOCAL posY AS INTEGER
for posX=0 TO MaxTextBoxWidth
for posY=0 TO MaxTextBoxHeight
TextBoxArray(posX,posY)=32
next posY
next posX
endfunction
function RefreshTextBox(startX AS INTEGER, startY AS INTEGER, numCols AS INTEGER, numRows AS INTEGER)
LOCAL posX AS INTEGER
LOCAL posY AS INTEGER
LOCAL code AS INTEGER
LOCAL char AS STRING
for posY=0 TO (numRows-1)
for posX=0 TO (numCols-1)
code=TextBoxArray(posX,posY)
char=CHR$(code)
TEXT startX+(posX*fontWidth),StartY+(posY*fontHeight),char
next posX
next posY
endfunction
function DisplayTextBox(startX AS INTEGER, startY AS INTEGER, numCols AS INTEGER, numRows AS INTEGER, theString AS STRING, drawBorder AS INTEGER)
LOCAL posX AS INTEGER
LOCAL posY AS INTEGER
LOCAL lth AS INTEGER
ClearTextBox()
posX=0
posY=0
if drawBorder=1
LINE startX-2, startY-2, startX+(numCols*fontWidth)+2, startY-2
LINE startX+(numCols*fontWidth)+2, startY-2, startX+(numCols*fontWidth)+2, startY+(numRows*fontHeight)+2
LINE startX+(numCols*fontWidth)+2, startY+(numRows*fontHeight)+2, startX-2, startY+(numRows*fontHeight)+2
LINE startX-2, startY+(numRows*fontHeight)+2, startX-2, startY-2
endif
lth=LEN(theString)
for lp1=1 TO lth
TextBoxArray(posX, posY)=ASC(MID$(theString, lp1))
posX=posX+1
if posX>(numCols-1)
posX=0
posY=posY+1
if posY>(numRows-1)
posY=0
endif
endif
next lp1
RefreshTextBox(startX, startY, numcols, numRows)
endfunction
function InTextProcessing()
endfunction
----
"What is this talk of 'release'? Klingons do not'release' software. It escapes leaving a bloody trail of developers and quality assurance people in its wake!"
