DECLARE SUB Inputbox (X!, y!, T$, Prm$)
DECLARE SUB Win (X!, y!, eX!, Ey!, q!)
DECLARE SUB LoadFont (f$)
DECLARE SUB Font (T$, C!)
DECLARE SUB Background (C!)
DECLARE SUB Sleep2 (T!)
DECLARE SUB Window2 (length!, height!, row!, column!)
DECLARE SUB Textbx (SX!, SY!, eX!, Ey!, T$, r!, l!, pw$, tb$, del)
DECLARE SUB Button1 (X!, y!, eX!, Ey!, P!, tle$)
DIM SHARED Txt(255) AS STRING
DIM SHARED Wind(1 TO 16384)
SCREEN 12
DEF SEG = 0
POKE &H417, (160 XOR &H40)
LoadFont "C:\ROY1.FNT"
Background 1
Window2 300, 426, 10, 20
Textbx 40, 40, 290, 55, Txt$, 0, 1, "", "NOTHING", 1
Button1 50, 100, 100, 150, 0, "   G"
DO UNTIL INKEY$ = CHR$(13): Sleep2 .3: Button1 50, 100, 100, 150, 1, "   G": Sleep2 .3: Button1 50, 100, 100, 150, 0, "   G": LOOP
Textbx 40, 40, 290, 55, T$, 1, 16, "@", "ROY ", 0
Textbx 40, 60, 290, 75, T$, 1, 16, "", "ROY ", 1
Inputbox 10, 10, Roy$, "DADA!"


END
DATA "My name is Roy S. Keene this is Visual Basic for QBasic, QuickBasic, and Power-"
DATA "Basic.","     It is fully explained in the comments however, if you need help E-Mail me.",,"Age      : 13","Sex      : M","Grade    : 7"
DATA "Aol name : RKeene12(@Aol.Com)","","I'm a member of the DDE a hacking group also aimed at the obliteration of any","and all viruses.  If you are interested in this group E-Mail me. We are based inJackson,MS.",,"Feel free to modify and re-distribute this code.","As long as you include the font it will work. It is otherwise self-contained.",,"If you do wish to include my name in the comments you may.","Graphics aren't my specialty I'm better at the programming the guts. My friend, James, is better at graphics than me."
DATA ,"Copyright(C) MCMXCV Keene Enterprises Inc."
3322
END

SUB AboutTheAuthor
ON ERROR GOTO 3322
 SCREEN 12: CLS
DO UNTIL EEE = 1
READ a$: PRINT a$
LOOP
EXIT SUB
END SUB

SUB Background (C)
LINE (-1, -1)-(640, 480), C, BF
END SUB

SUB Button1 (X, y, eX, Ey, P, tle$)
IF P = 0 THEN clr1 = 15: clr2 = 8 ELSE clr1 = 8: clr2 = 15
LINE (X + 2, y + 2)-(eX - 3, Ey - 3), 7, BF
LINE (X, y)-(eX, Ey), 8, B



END SUB

SUB Font (T$, C)
CC$ = STR$(C)
CC$ = "C" + MID$(CC$, 2, LEN(CC$) - 1)
DRAW "X" + VARPTR$(CC$)
FOR qww = 1 TO LEN(T$)
DRAW "X" + VARPTR$(Txt(ASC(MID$(T$, qww, 1)))): GOTO 1011
1011 NEXT qww
END SUB

SUB Inputbox (X, y, T$, Prm$)
Z = 140
DIM Back(1 TO 9998)
GET (X, y)-(X + 100 + Z, y + 100 + Z), Back
LINE (X, y)-(X + 100 + Z, y + 100 + Z), 0, BF
LINE (X + 2, y + 2)-(X + 98 + Z, y + 98 + Z), 1, BF
LINE (X + 10, y + 10)-(X + 90 + Z, y + 90 + Z), 0, BF
LINE (X + 12, y + 12)-(X + 88 + Z, y + 88 + Z), 7, BF
Xy = X + 15
yX = y + 67 + Z
Xx = X + 85 + Z
yY = y + 82 + Z
Xyz$ = "M" + STR$(X + 13) + "," + STR$(y + 23)
DRAW "X" + VARPTR$(Xyz$)
Font Prm$, 0
Textbx Xy, yX, Xx, yY, T$, 1, 14, "", "", 0
PUT (X, y), Back, PSET
END SUB

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

SUB SCapt (FIL$)
OPEN FIL$ FOR OUTPUT AS #1 LEN = 10000
FOR X = 0 TO 639
FOR y = 0 TO 479
vv$ = CHR$(POINT(X, y) + 32)
PRINT #1, vv$; : PSET (X, y), 15
IF INKEY$ = "" THEN  ELSE CLOSE 1: EXIT SUB
NEXT y
NEXT X
CLOSE 1
END SUB

SUB Sleep2 (T)
a = TIMER
DO UNTIL TIMER >= a + T: LOOP


END SUB

SUB SLoad (FIL$)
OPEN FIL$ FOR RANDOM AS #1
FOR X = 0 TO 639
FOR y = 0 TO 479
GET #1, y + 1 * (X + 1), clr$
IF INKEY$ = "" THEN  ELSE CLOSE 1: EXIT SUB
IF EOF(1) THEN CLOSE 1: PSET (X, y), clr%: EXIT SUB
PSET (X, y), ASC(clr$) - 32
10 NEXT y
NEXT X
END SUB

SUB Textbx (SX, SY, eX, Ey, T$, r, l, pw$, tb$, del)
IF LEN(tb$) > l AND r = 1 THEN tb$ = MID$(tb$, 1, l)
T$ = tb$: 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$(Ey - 2)
DRAW "BX" + VARPTR$(MX$)
IF pw$ = "" THEN Font tb$, 0 ELSE Font STRING$(LEN(tb$), pw$), 0
IF r = 1 THEN  ELSE EXIT SUB
12 a$ = INKEY$
IF a$ = "" GOTO 12
IF a$ = CHR$(8) THEN IF LEN(T$) - ds = 0 THEN GOTO 12 ELSE T$ = LEFT$(T$, LEN(T$) - 1): W = W - 1: LINE (SX - 1, SY - 1)-(eX + 1, Ey + 1), 0, B: LINE (SX, SY)-(eX, Ey), 15, BF: DRAW "BX" + VARPTR$(MX$): IF pw$ = "" THEN Font UCASE$(T$), 0: GOTO 12 ELSE Font STRING$(LEN(T$), pw$), 0: GOTO 12
IF a$ = CHR$(13) THEN EXIT SUB
IF W = l THEN GOTO 12
T$ = T$ + a$: W = W + LEN(a$)
B$ = UCASE$(a$)
IF pw$ = "" THEN Font B$, 0 ELSE Font pw$, 0
GOTO 12
END SUB

SUB Window2 (length, height, row, column)
LINE (column, row)-(column + length, row + height), 0, B
FOR i% = 1 TO 2
row = row + 1: column = column + 1: height = height - 1: length = length - 1
LINE (column, row)-(column + length, row), 7
LINE (column, row)-(column, row + height), 7
NEXT i%
row = row + 1: column = column + 1: height = height - 1: length = length - 1
LINE (column, row)-(column + length, row), 0
LINE (column, row)-(column, row + height), 0
LINE (column, row)-(column + 18, row + 18), 7, BF
LINE (column, row)-(column + 18, row + 18), 0, B
LINE (column + 18, row - 2)-(column + 18, row + 5), 0
LINE (column - 2, row + 18)-(column + 5, row + 18), 0
LINE (column + 5, row + 7)-(column + 13, row + 9), 15, BF: LINE (column + 5, row + 7)-(column + 13, row + 9), 0, B
LINE (column + 14, row + 7)-(column + 14, row + 9), 8
LINE (column + 6, row + 10)-(column + 14, row + 10), 8, B
LINE (column + 18, row)-(column + length, row + 18), 9, BF
LINE (column + 18, row)-(column + length, row + 18), 0, B
LINE (column + length, row - 3)-(column + length + 2, row + height), 7, BF
LINE (column + length, row - 3)-(column + length + 3, row + height), 0, B
LINE (column + length, row - 2)-(column + length, row - 1), 7
LINE (column + length - 18, row - 2)-(column + length - 18, row - 1), 0
LINE (column + length, row + 18)-(column + length + 2, row + 18), 0
LINE (column, row + height - 3)-(column + length, row + height - 3), 0, B
LINE (column, row + height - 2)-(column + length + 2, row + height), 7, BF
LINE (column - 2, row + height)-(column + length + 2, row + height), 0, B
LINE (column - 2, row + height - 18)-(column, row + height - 18), 0
LINE (column + length - 2, row + height - 18)-(column + length + 2, row + height - 18), 0
LINE (column + 18, row + height)-(column + 18, row + height - 2), 0
LINE (column + length - 18, row + height)-(column + length - 18, row + height - 2), 0
LINE (column + 1, row + 19)-(column + length - 1, row + height - 4), 7, BF
END SUB