By retro I mean it is written the way I wrote code with QBASIC and only uses the standard font.
One day I might start encapsulating a control's software as a class :)
The text can be left/right or centered for each text box.
If the text in the selected text box is larger than the width of the text box its full contents are displayed on the bottom bar.
Code: Select all
screenres 640,480,32
color rgb(0,0,0),rgb(200,200,240):cls
dim shared as integer mx,my,mb
' GLOBAL VARIABLES USED BY TEXTBOX ROUTINES DrawTextBox and EditTextBox
dim shared as integer cursor
type TextBox
as integer x
as integer y
as integer w
as integer h
as string t 'text
as integer a 'active=1
as integer j 'justify left = 0 /center = 1/right = 2
as integer posX 'retains info when text larger than width of text box
end type
cursor = 0
sub drawTextBox(tb as textBox)
dim as integer shiftX
screenlock()
'******************* THIS DRAWS THE BOX ***************************
'clear rectangle
line (tb.x,tb.y)-(tb.x+tb.w+8,tb.y+tb.h),rgb(255,255,255),bf
'draw border
line (tb.x,tb.y)-(tb.x+tb.w+8,tb.y+tb.h),rgb(127,127,127),b
line (tb.x+1,tb.y+1)-(tb.x+tb.w+7,tb.y+tb.h-1),rgb(127,127,127),b
'*******************************************************************
if tb.a = 1 then
'keep cursor within the box
if cursor > tb.posX+tb.w/8 then
tb.posX = tb.posX + 1
end if
if cursor < tb.posX+1 then
if tb.posX>0 then
tb.posX = tb.posX - 1
end if
end if
end if
if len(tb.t)*8 > tb.w or tb.j = 0 then
draw string (tb.x+4,tb.y+4),mid(tb.t,tb.posX+1,tb.w\8)
if tb.a = 1 then
line (tb.x+cursor*8+4-tb.posX*8,tb.y+2)-(tb.x+cursor*8+5-tb.posX*8,tb.y + 14),rgb(10,10,10),bf 'draw cursor
end if
else
if tb.j = 1 then shiftX = tb.w\2-len(tb.t)*8/2
if tb.j = 2 then shiftX = tb.w-len(tb.t)*8
draw string (tb.x+4+shiftX,tb.y+4),tb.t
if tb.a = 1 then
line (tb.x+cursor*8+4+shiftX,tb.y+2)-(tb.x+cursor*8+5+shiftX,tb.y + 14),rgb(10,10,10),bf 'draw cursor
end if
end if
screenunlock()
end sub
function editTextBox(tb as TextBox) as integer
dim as string key
dim as integer ascKey
cursor =(mx - tb.x)\8+tb.posX
if cursor > len(tb.t) then
cursor = len(tb.t)
end if
while mb=1
getmouse mx,my,,mb
wend
tb.a = 1 'activate
while inkey<>"":wend 'clear buffer
drawTextBox(tb) 'show cursor
do
getmouse mx,my,,mb
if mb=1 then
if mx>tb.x and mx<tb.x+tb.w and my>tb.y and my<tb.y+tb.h then
cursor =(mx - tb.x)\8+tb.posX
if cursor > len(tb.t) then
cursor = len(tb.t)
end if
while mb=1
getmouse mx,my,,mb
wend
end if
drawTextBox(tb) ' to show cursor at new position
end if
key = inkey
if key<>"" then
if len(key)>1 then
ascKey = asc(right(key,1))
if ascKey = 75 then 'CURSOR LEFT
if cursor > 0 then
cursor = cursor -1
end if
end if
if ascKey = 77 then 'CURSOR RIGHT
if cursor < len(tb.t) then
cursor = cursor + 1
end if
end if
if ascKey = 83 then 'DELETE
tb.t = left(tb.t,cursor) + right(tb.t,len(tb.t)-cursor-1)
end if
else
ascKey = asc(key)
if ascKey =8 then
if cursor > 0 then 'BACKSPACE
tb.t = left(tb.t,cursor-1) + mid(tb.t,cursor+1,len(tb.t)-cursor)
cursor = cursor - 1
end if
else
if ascKey<>9 and ascKey<>27 and ascKey<>13 then 'TAB, ESC, ENTER
tb.t = left(tb.t,cursor) + key + right(tb.t,len(tb.t)-cursor)
cursor = cursor + 1
end if
end if
end if
drawTextBox(tb)
end if
sleep 2
loop until asc(key)=13 or ascKey=9 or ascKey=27 or mb=1 'ENTER, TAB, ESC
tb.a = 0 'deactivate
drawTextBox(tb) 'this draws contents without cursor
return ascKey
end function
'=====================================================================
'=============== USE OF TEXTBOX EXAMPLE ========================
'=====================================================================
'global variables
dim shared as integer event 'flag button down on a text box
dim shared as integer retKey 'exit char returned from editTextBox
dim shared as integer col,row 'column and row of current textbox being edited
dim shared as textBox tb1(5,20) 'create a 3 x 20 textbox array
'initialize 5 x 20 array of text boxes
for j as integer = 0 to 19
for i as integer = 0 to 4
tb1(i,j).x = i*100+50
tb1(i,j).y = j*18+50
tb1(i,j).w = 11*8 'wide enough for 10 characters 8 pixels wide
tb1(i,j).h = 16
tb1(i,j).t = ""
tb1(i,j).a = 0
tb1(i,j).j = 0
next i
next j
sub update()
screenlock
cls
for j as integer = 0 to 19
for i as integer = 0 to 4
drawTextBox(tb1(i,j))
next i
next j
draw string (50,10),"USE MOUSE KEY TO SELECT A TEXT BOX"
draw string (50,20),"HIT ESC KEY TO EXIT PROGRAM"
'display content of current textbox
line (0,460)-(639,479),rgb(100,100,200),bf
draw string (20,479-12),tb1(col,row).t
screenunlock
end sub
' --- MAIN ---
update() 'show the text boxes to start with
do
getmouse mx,my,,mb
'test if left mouse button down event over a text box
event = -1
for j as integer = 0 to 19
for i as integer = 0 to 4
if mb=1 and mx>tb1(i,j).x and mx<tb1(i,j).x+tb1(i,j).w and my>tb1(i,j).y and my<tb1(i,j).y+tb1(i,j).h then
col = i
row = j
event = 1
end if
next i
next j
'mouse down on text box event?
if event = 1 then
update()
retKey = editTextBox(tb1(col,row))
update()
end if
sleep 2
loop until multikey(&H01)