1: DECLARE SUB Font (t$, cl!, n!) 2: DECLARE FUNCTION TextWidth! (t$, n!) 3: DECLARE SUB TextBox (SX!, SY!, eX!, Ey!, t$, r!, l!, Pw$, tb$, del!, Mln!, nf!) 4: DECLARE SUB LoadFont (f$, n!) 5: DECLARE FUNCTION TextHeight! (t$, n!) 6: CLEAR , , 1000 7: DIM SHARED Txt$(255, 1 TO 5) 8: SCREEN 12 9: LoadFont "C:\FONTS\MSSANSSE.FNT", 1 10: LoadFont "C:\FONTS\SYSTEM.FNT", 2 11: TextBox 10, 10, 100, 100, "", 1, 30, "", "", 1, 0, 1 12: TextBox 10, 10, 100, 100, "", 1, 30, "*", "", 1, 0, 2 13: 14: SUB Font (t$, cl, n) 15: IF cl = -1 THEN ELSE f$ = "C" + LTRIM$(RTRIM$(STR$(cl))): DRAW "X" + VARPTR$(f$) 16: IF Txt$(32, n) = "" THEN EXIT SUB 17: FOR qww = 1 TO LEN(t$) 18: 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 19: 1011 NEXT qww 20: END SUB 21: 22: SUB LoadFont (f$, n) 23: OPEN f$ FOR INPUT AS #1: t = 0 24: DO UNTIL EOF(1) OR t = 255 25: LINE INPUT #1, a$ 26: Txt$(t, n) = a$ 27: t = t + 1 28: LOOP 29: CLOSE 1 30: END SUB 31: 32: SUB TextBox (SX, SY, eX, Ey, t$, r, l, Pw$, tb$, del, Mln, nf) 33: crln = 1 34: My = SY 35: IF LEN(tb$) > l AND r = 1 THEN tb$ = MID$(tb$, 1, l) 36: w = LEN(tb$) 37: IF del = 1 THEN ds = 0 ELSE ds = LEN(tb$) 38: IF LEN(Pw$) > 1 THEN Pw$ = LEFT$(Pw$, 1) 39: LINE (SX - 1, SY - 1)-(eX + 1, Ey + 1), 0, B 40: LINE (SX, SY)-(eX, Ey), 15, BF 41: mx$ = "M" + STR$(SX + 2) + "," + STR$(SY + 13) 42: DRAW "BX" + VARPTR$(mx$) 43: IF Pw$ = "" THEN Font tb$, 0, nf ELSE Font STRING$(LEN(tb$), Pw$), 0, nf 44: IF r = 1 THEN ELSE EXIT SUB 45: 12 a$ = INKEY$ 46: IF a$ = "" GOTO 12 47: mx$ = "M" + STR$(SX + 2) + "," + STR$(My + 13) 48: IF a$ = CHR$(8) THEN 49: IF (Mln = 0 AND LEN(t$) = 0) OR (Mln > 0 AND sss = 0) THEN GOTO 12 50: 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 51: 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 52: END IF 53: IF a$ = CHR$(13) AND Mln = 0 OR (Mln > 0 AND crln = Mln AND a$ = CHR$(13)) THEN EXIT SUB 54: 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 55: IF sss >= l THEN GOTO 12 56: t$ = t$ + a$: w = w + LEN(a$) 57: sss = sss + LEN(a$) 58: B$ = a$ 59: IF Pw$ = "" THEN Font B$, 0, nf ELSE Font Pw$, 0, nf 60: GOTO 12 61: END SUB 62: 63: FUNCTION TextHeight (t$, n) 64: FOR q = 1 TO LEN(t$) 65: ta$ = Txt$(ASC(MID$(t$, q, 1)), n) 66: FOR m = 1 TO LEN(ta$) 67: IF LCASE$(MID$(ta$, m, 1)) = "u" THEN 68: IF VAL(MID$(ta$, m + 1, 2)) > 0 THEN vl = VAL(MID$(ta$, m + 1, 2)) ELSE vl = 1 69: sz = sz + vl: m = m + 2 70: END IF 71: 'IF LCASE$(MID$(ta$, m, 1)) = "d" THEN 72: 'IF VAL(MID$(ta$, m + 1, 2)) > 0 THEN vl = VAL(MID$(ta$, m + 1, 2)) ELSE vl = 1 73: 'sz = sz - vl 74: 'END IF 75: IF LCASE$(MID$(ta$, m, 1)) = "r" OR LCASE$(MID$(ta$, m, 1)) = "l" OR LCASE$(MID$(ta$, m, 1)) = "b" THEN 76: IF sz > MemSZ THEN MemSZ = sz 77: sz = 0 78: END IF 79: NEXT m 80: NEXT q 81: TextHeight = INT(MemSZ) 82: END FUNCTION 83: 84: FUNCTION TextWidth (t$, n) 85: FOR q = 1 TO LEN(t$) 86: ta$ = Txt$(ASC(MID$(t$, q, 1)), n) 87: FOR m = 1 TO LEN(ta$) 88: IF LCASE$(MID$(ta$, m, 2)) = "br" THEN sz = sz + 1 89: IF LCASE$(MID$(ta$, m, 2)) = "bl" THEN sz = sz - 1 90: NEXT m 91: NEXT q 92: TextWidth = sz 93: END FUNCTION 94: |