DECLARE SUB Font (t$, cl!, n!)
DECLARE FUNCTION TextWidth! (t$, n!)
DECLARE SUB TextBox (SX!, SY!, eX!, Ey!, t$, r!, l!, Pw$, tb$, del!, Mln!, nf!)
DECLARE SUB LoadFont (f$, n!)
DECLARE FUNCTION TextHeight! (t$, n!)
CLEAR , , 1000
DIM SHARED Txt$(255, 1 TO 5)
SCREEN 12
LoadFont "C:\FONTS\MSSANSSE.FNT", 1
LoadFont "C:\FONTS\SYSTEM.FNT", 2
TextBox 10, 10, 100, 100, "", 1, 30, "", "", 1, 0, 1
TextBox 10, 10, 100, 100, "", 1, 30, "*", "", 1, 0, 2

SUB Font (t$, cl, n)
IF cl = -1 THEN  ELSE f$ = "C" + LTRIM$(RTRIM$(STR$(cl))): DRAW "X" + VARPTR$(f$)
IF Txt$(32, n) = "" THEN EXIT SUB
FOR qww = 1 TO LEN(t$)
IF ASC(MID$(t$, qww, 1)) = 0 THEN DRAW "X" + VARPTR$(Txt$(32, n)) ELSE DRAW "X" + VARPTR$(Txt$(ASC(MID$(t$, qww, 1)), n)): DRAW "BL": GOTO 1011
1011 NEXT qww
END SUB

SUB LoadFont (f$, n)
OPEN f$ FOR INPUT AS #1: t = 0
DO UNTIL EOF(1) OR t = 255
LINE INPUT #1, a$
Txt$(t, n) = a$
t = t + 1
LOOP
CLOSE 1
END SUB

SUB TextBox (SX, SY, eX, Ey, t$, r, l, Pw$, tb$, del, Mln, nf)
crln = 1
My = SY
IF LEN(tb$) > l AND r = 1 THEN tb$ = MID$(tb$, 1, l)
w = LEN(tb$)
IF del = 1 THEN ds = 0 ELSE ds = LEN(tb$)
IF LEN(Pw$) > 1 THEN Pw$ = LEFT$(Pw$, 1)
LINE (SX - 1, SY - 1)-(eX + 1, Ey + 1), 0, B
LINE (SX, SY)-(eX, Ey), 15, BF
mx$ = "M" + STR$(SX + 2) + "," + STR$(SY + 13)
DRAW "BX" + VARPTR$(mx$)
IF Pw$ = "" THEN Font tb$, 0, nf ELSE Font STRING$(LEN(tb$), Pw$), 0, nf
IF r = 1 THEN  ELSE EXIT SUB
12 a$ = INKEY$
IF a$ = "" GOTO 12
mx$ = "M" + STR$(SX + 2) + "," + STR$(My + 13)
IF a$ = CHR$(8) THEN
IF (Mln = 0 AND LEN(t$) = 0) OR (Mln > 0 AND sss = 0) THEN GOTO 12
IF Pw$ = "" = 0 THEN Dstnc = TextWidth(Pw$, nf) - 1: Ht = TextHeight(Pw$, nf) - 1 ELSE Dstnc = TextWidth(RIGHT$(t$, 1), nf) - 1: Ht = TextHeight(RIGHT$(t$, 1), nf) - 1
t$ = LEFT$(t$, LEN(t$) - 1): LINE (POINT(0), POINT(1))-(POINT(0) - Dstnc, POINT(1) - Ht), 15, BF: PSET (POINT(0) + 1, POINT(1) + Ht), POINT(POINT(0), POINT(1)): w = w - 1
END IF
IF a$ = CHR$(13) AND Mln = 0 OR (Mln > 0 AND crln = Mln AND a$ = CHR$(13)) THEN EXIT SUB
IF a$ = CHR$(13) AND Mln > 0 AND crln < Mln THEN My = My + 16: mx$ = "M" + STR$(SX + 2) + "," + STR$(My + 13): DRAW "BX" + VARPTR$(mx$): crr = 1: sss = -1: crln = crln + 1: Font tb$, 0, nf
IF sss >= l THEN GOTO 12
t$ = t$ + a$: w = w + LEN(a$)
sss = sss + LEN(a$)
B$ = a$
IF Pw$ = "" THEN Font B$, 0, nf ELSE Font Pw$, 0, nf
GOTO 12
END SUB

FUNCTION TextHeight (t$, n)
FOR q = 1 TO LEN(t$)
ta$ = Txt$(ASC(MID$(t$, q, 1)), n)
FOR m = 1 TO LEN(ta$)
IF LCASE$(MID$(ta$, m, 1)) = "u" THEN
IF VAL(MID$(ta$, m + 1, 2)) > 0 THEN vl = VAL(MID$(ta$, m + 1, 2)) ELSE vl = 1
sz = sz + vl: m = m + 2
END IF
'IF LCASE$(MID$(ta$, m, 1)) = "d" THEN
'IF VAL(MID$(ta$, m + 1, 2)) > 0 THEN vl = VAL(MID$(ta$, m + 1, 2)) ELSE vl = 1
'sz = sz - vl
'END IF
IF LCASE$(MID$(ta$, m, 1)) = "r" OR LCASE$(MID$(ta$, m, 1)) = "l" OR LCASE$(MID$(ta$, m, 1)) = "b" THEN
IF sz > MemSZ THEN MemSZ = sz
sz = 0
END IF
NEXT m
NEXT q
TextHeight = INT(MemSZ)
END FUNCTION

FUNCTION TextWidth (t$, n)
FOR q = 1 TO LEN(t$)
ta$ = Txt$(ASC(MID$(t$, q, 1)), n)
FOR m = 1 TO LEN(ta$)
IF LCASE$(MID$(ta$, m, 2)) = "br" THEN sz = sz + 1
IF LCASE$(MID$(ta$, m, 2)) = "bl" THEN sz = sz - 1
NEXT m
NEXT q
TextWidth = sz
END FUNCTION