DECLARE SUB LoadWindowsDrivers ()
DECLARE SUB MsgBox (ms$, Tit$)
DECLARE SUB Windows (X!, Y!, Wd!, Ht!, Style%, BackColor!, ForeColor!, Visible!, Caption$, Name$)
DECLARE SUB ModifyStatus (frm$, l!, t!, w!, H!, s!, bc!, fc!, v!, c$)
DECLARE SUB DoEvents ()
DECLARE SUB QueryUnload ()
DECLARE SUB AddForm (frmID$)
DECLARE SUB Background (n!)
DECLARE SUB Refresh (frm$, n!)
DECLARE SUB Button2 (x1!, y1!, x2!, y2!, p!, t$)
DECLARE SUB MouseHide ()
DECLARE SUB Print2 (X!, Y!, cv!, t$)
DECLARE SUB MouseShow ()
DECLARE SUB MouseStatus (lb%, rb%, xMouse%, yMouse%)
DECLARE SUB Sleep2 (t!)
DECLARE SUB ConvWindInf (gg$, p1!, p2!, p3!, p4!, p5!, p6!, p7!, p8!, tt$, nm$)
DECLARE SUB Font (t$, cl!)
DECLARE FUNCTION LastPart$ (t$, s$)
DECLARE SUB LoadFont (f$)
DECLARE SUB MouseDriver (ax%, bx%, cx%, dx%)
DECLARE FUNCTION MouseInit% ()
DECLARE FUNCTION TextWidth! (t$)
DECLARE FUNCTION TRIMS$ (n!, t$)
DECLARE SUB ChangePal (Red%, Green%, Blue%, syscolor%)
'------------------------ Setup Neccasary Drivers ----------------------'
CONST True = -1
CONST False = NOT (True)
DIM SHARED Txt(255) AS STRING
DIM SHARED Mouse$
DIM SHARED NoMouse%
Mouse$ = SPACE$(57)
LoadWindowsDrivers
'---------------------------- Code Begins Here --------------------------'
Windows 0, 0, 640, 480, 2, 8, 0, True, "America OnLine", "Form1"

DO UNTIL 1 = 2: DoEvents: LOOP

QueryUnload
END
'---------------------------------- GOSUBS --------------------------------'
ResumeNext:
RESUME NEXT

TimerUp:
DoEvents
RETURN
'--------------------------------- DATA for mouse ----------------------'
DATA 55,89,E5,8B,5E,0C,8B,07,50,8B,5E,0A,8B,07,50,8B
DATA 5E,08,8B,0F,8B,5E,06,8B,17,5B,58,1E,07,CD,33,53
DATA 8B,5E,0C,89,07,58,8B,5E,0A,89,07,8B,5E,08,89,0F
DATA 8B,5E,06,89,17,5D,CA,08,00

'Adds a form to the QBWinem environment
'frmID$ = Left Top Width Height Style ForeColor BackColor Visible Len(Caption)Caption Name
SUB AddForm (frmID$)
X = FREEFILE
OPEN "WIND.WND" FOR RANDOM ACCESS READ AS #X
IF LOF(X) = 0 THEN
CLOSE X: OPEN "WIND.WND" FOR OUTPUT AS #X
ELSE
CLOSE X
OPEN "WIND.WND" FOR INPUT AS #X
DO UNTIL EOF(X)
LINE INPUT #X, g$
IF LastPart$(g$, " ") = LastPart$(frmID$, " ") THEN CLOSE X: EXIT SUB
LOOP
CLOSE X
OPEN "WIND.WND" FOR APPEND AS #X
END IF
PRINT #X, frmID$
CLOSE X
END SUB

'Sets the Background color
'n = a vaild color (0-15)
SUB Background (n)
LINE (0, 0)-(640, 480), n, BF
X = FREEFILE
OPEN "Back.WND" FOR OUTPUT AS #X
PRINT #X, TRIMS$(n, "")
CLOSE X
Refresh "", 1
END SUB

'Draws a button
'x1=starting x pos of button
'y1=starting y pos of button
'x2=ending x pos of button
'y2=ending y pos of button
'p = (0-3) 0=unpushed:1=pushed:3=on enter push and release
't$=Text On Button
SUB Button2 (x1, y1, x2, y2, p, t$)
MouseHide
IF p = 1 OR p = 4 THEN q = 1: GOTO PUSHED
LINE (x1, y1)-(x1, y2 - 1), 15
LINE (x1, y1)-(x2 - 1, y1), 15
LINE (x2 - 1, y1 + 1)-(x2 - 1, y2 - 1), 8
LINE (x2 - 1, y2 - 1)-(x1 + 1, y2 - 1), 8
LINE (x1, y2)-(x2, y2), 0
LINE (x2, y2)-(x2, y1), 0
LINE (x1 + 1, y1 + 1)-(x2 - 2, y2 - 2), 7, BF
IF p = 6 THEN Print2 INT(((x2 - x1) / 2) - ((LEN(t$) / 2) * 8) + x1), y1 + 14, 0, t$: MouseShow: DO UNTIL Clk% <> 0 AND ClX% > x1 - 1 AND ClX% < x2 + 1 AND ClY% > y1 - 1 AND ClY% < y2 + 1 OR INKEY$ = CHR$(13): MouseStatus l%, r%, ClX%, ClY%: Clk% = l% + r%: LOOP: Sleep2 .13: MouseHide: GOTO PUSHED
IF p = 5 THEN Print2 INT(((x2 - x1) / 2) - ((LEN(t$) / 2) * 8) + x1), y1 + 14, 0, t$: DO UNTIL Clk = 1 AND ClX > x1 - 1 AND ClX < x2 + 1 AND ClY > y1 - 1 AND ClY < y2 + 1: LOOP: Sleep2 .13: GOTO PUSHED
IF p = 3 THEN Print2 INT(((x2 - x1) / 2) - ((LEN(t$) / 2) * 8) + x1), y1 + 14, 0, t$: MouseShow: DO UNTIL INKEY$ = CHR$(13): LOOP: q = 1: MouseHide ELSE GOTO ssd
PUSHED:
LINE (x1, y1)-(x1, y2), 0
LINE (x1, y1)-(x2, y1), 0
LINE (x1 + 1, y1 + 1)-(x1 + 1, y2 - 1), 8
LINE (x1 + 1, y1 + 1)-(x2 - 1, y1 + 1), 8
LINE (x1 + 1, y2)-(x2, y2), 15
LINE (x2, y2)-(x2, y1 + 1), 15
LINE (x1 + 2, y1 + 2)-(x2 - 1, y2 - 1), 7, BF
ssd:
IF LEN(t$) * 8 > x2 - x1 THEN EXIT SUB
wdt = x2 - x1
Print2 INT((wdt / 2) - ((LEN(t$) / 2) * 8) + x1), y1 + 14 + q, 0, t$
IF p > 2 THEN Sleep2 .13
IF p > 2 THEN Button2 x1, y1, x2, y2, 0, t$
MouseShow
END SUB

SUB ChangePal (Red%, Green%, Blue%, syscolor%)
palmask = &H3C6
palregrd = &H3CF
palregwr = &H3C8
paldata = &H3C9
OUT palmask, &HFF
OUT palregwr, syscolor%
OUT paldata, Red%
OUT paldata, Green%
OUT paldata, Blue%
END SUB

'Breaks form information text into neccasary component
'gg$=form id
'p1 - nm$ = used for sending all property's at once
'
SUB ConvWindInf (gg$, p1, p2, p3, p4, p5, p6, p7, p8, tt$, nm$)
DIM FirstS(7)
FirstS(0) = VAL(MID$(gg$, 1, INSTR(gg$, " ")))
FOR q = 1 TO 7
CNtr = INSTR(CNtr + 1, gg$, " ")
ln = INSTR(CNtr + 1, gg$, " ") - CNtr
FirstS(q) = VAL(MID$(gg$, CNtr, ln))
NEXT q
NmLN = ASC(MID$(gg$, CNtr + ln + 1, 1))
FOR q = CNtr + ln + 2 TO NmLN + CNtr + ln + 1
tt$ = tt$ + MID$(gg$, q, 1)
NEXT q
CNtr = q
FOR q = CNtr + 1 TO LEN(gg$)
nm$ = nm$ + MID$(gg$, q, 1)
NEXT q
p1 = FirstS(0)
p2 = FirstS(1)
p3 = FirstS(2)
p4 = FirstS(3)
p5 = FirstS(4)
p6 = FirstS(5)
p7 = FirstS(6)
p8 = FirstS(7)
END SUB

SUB DoEvents
MouseStatus l%, r%, X%, Y%
a$ = INKEY$
IF a$ = CHR$(27) THEN QueryUnload: END
IF a$ = CHR$(9) THEN MsgBox "Tab key was pressed", "/\/\ /-\ CRO /\/\ /-\ |\|"
IF a$ = " " THEN ModifyStatus "Form1", -1, -1, -1, -1, -1, -1, -1, -3, ""
END SUB

'Draws text on the screen using my fonts
't$ = Text to be printed
'cl = color of text (0-15)
SUB Font (t$, cl)
IF cl = -1 THEN  ELSE f$ = "C" + LTRIM$(RTRIM$(STR$(cl))): DRAW "X" + VARPTR$(f$)
IF Txt(32) = "" THEN EXIT SUB
FOR qww = 1 TO LEN(t$)
IF ASC(MID$(t$, qww, 1)) = 0 THEN DRAW "X" + VARPTR$(Txt(32)) ELSE DRAW "X" + VARPTR$(Txt(ASC(MID$(t$, qww, 1)))): DRAW "BL": GOTO 1011
1011 NEXT qww
END SUB

' Used for finding the lastpart of a string
't$=text to find last part of
's$=seperator, what denotes the lastpart from the rest of the string
FUNCTION LastPart$ (t$, s$)
FOR q = LEN(t$) TO 1 STEP -1
IF MID$(t$, q, 1) = s$ THEN EXIT FOR ELSE d$ = MID$(t$, q, 1) + d$
NEXT q
LastPart$ = d$
END FUNCTION

'Loads a font from disk
'f$ = Font name (PB version loads several)
SUB LoadFont (f$)
ON ERROR GOTO ResumeNext
OPEN f$ FOR INPUT AS #1: t = 0
DO UNTIL EOF(1) OR FRE("") < 1000
LINE INPUT #1, Txt(t)
IF t = 255 THEN EXIT DO
t = t + 1
LOOP
CLOSE 1
END SUB

' Just a sub to make everything look neat
SUB LoadWindowsDrivers
SCREEN 12
LoadFont "\FONTS\MSSANSSE.FNT"
Background 3
ON TIMER(1) GOSUB TimerUp: TIMER ON

FOR I% = 1 TO 57: READ a$: H$ = CHR$(VAL("&H" + a$)): MID$(Mouse$, I%, 1) = H$: NEXT I%
ms% = MouseInit%
IF NOT ms% THEN PRINT "Mouse not found": NoMouse% = True
MouseShow
ChangePal 0, 0, 165, 1
ChangePal 0, 0, 255, 9
END SUB

' Allows You to modify the status of a form
'frm$=Form name
'l -  fc= (-1 to ignore)
'v= visible (-2 to ignore)
'c$=Caption (Null to ignore)
SUB ModifyStatus (frm$, l, t, w, H, s, bc, fc, v, c$)
X = FREEFILE
OPEN "WIND.WND" FOR INPUT AS #X
z = FREEFILE
OPEN "WIND.TMP" FOR OUTPUT AS #z
DO UNTIL EOF(X)
LINE INPUT #1, g$
IF LastPart$(frm$, " ") = LastPart$(g$, " ") THEN
ConvWindInf g$, p1, p2, p3, p4, p5, p6, p7, p8, ttl$, Nam$
op8 = p8
IF l = -1 THEN  ELSE p1 = l: EntSc = 1
IF t = -1 THEN  ELSE p2 = t: EntSc = 1
IF w = -1 THEN  ELSE p3 = w: EntSc = 1
IF H = -1 THEN  ELSE p4 = H: EntSc = 1
IF s = -1 THEN  ELSE p5 = s
IF bc = -1 THEN  ELSE p6 = bc
IF fc = -1 THEN  ELSE p7 = fc
IF v = -3 THEN v = NOT (p8)
IF v = -2 THEN  ELSE p8 = v: EntSc = 1
IF c$ = "" THEN  ELSE ttl$ = c$
IF op8 = False THEN EntSc = 0
IF LEN(g$) + LOC(X) >= LOF(X) THEN  ELSE EntSc = 1
g$ = TRIMS$(p1, "") + " " + TRIMS$(p2, "") + " " + TRIMS$(p3, "") + " " + TRIMS$(p4, "") + " " + TRIMS$(CSNG(p5), "") + " " + TRIMS$(p6, "") + " " + TRIMS$(p7, "") + " " + TRIMS$(p8, "") + " " + CHR$(LEN(ttl$)) + ttl$ + " " + TRIMS$(0, Nam$)
END IF
PRINT #z, g$
LOOP
CLOSE X, z
KILL "WIND.WND"
NAME "WIND.TMP" AS "WIND.WND"
IF (op8 = False AND p8 = False) THEN  ELSE Refresh frm$, EntSc
END SUB

SUB MouseDriver (ax%, bx%, cx%, dx%)
IF NoMouse% = True THEN EXIT SUB
DEF SEG = VARSEG(Mouse$)
Mouse% = SADD(Mouse$)
CALL Absolute(ax%, bx%, cx%, dx%, Mouse%)
END SUB

SUB MouseHide
MouseDriver 2, 0, 0, 0
END SUB

FUNCTION MouseInit%
  ax% = 0
  MouseDriver ax%, 0, 0, 0
  MouseInit% = ax%
END FUNCTION

SUB MouseShow
MouseDriver 1, 0, 0, 0
END SUB

SUB MouseStatus (lb%, rb%, xMouse%, yMouse%)
  ax% = 3
  MouseDriver ax%, bx%, cx%, dx%
  lb% = ((bx% AND 1) <> 0)
  rb% = ((bx% AND 2) <> 0)
  xMouse% = cx%
  yMouse% = dx%
END SUB

'Moves a form
SUB Move (nm$, left, top)
ModifyStatus nm$, left, top, -1, -1, -1, -1, -1, -1, ""
END SUB

SUB MsgBox (ms$, Tit$)
MouseHide
wt$ = "OK"
s = 17
v = 15
s = s + v
FOR w = 1 TO LEN(ms$): l = l + 1: IF MID$(ms$, w, 1) = CHR$(13) THEN s = s + v
NEXT w
IF LEN(Tit$) >= LEN(ms$) THEN pix = INT(LEN(Tit$) * 8.4) ELSE pix = INT(LEN(ms$) * 8)
IF INT(LEN(wt$) * 8.4) > pix THEN pix = INT(LEN(" (Press ENTER to continue.)") * 8.4)
X = 320 - INT(pix / 2)
Y = 175 - s
DIM back(1 TO 10998)
GET (X, Y)-(X + pix, Y + s + v), back
LINE (X + 1, Y + 1)-(X + pix - 1, Y + v), 1, BF
m$ = "BM" + RTRIM$(LTRIM$(STR$(X + 5))) + ", " + RTRIM$(LTRIM$(STR$(Y + v + 1)))
DRAW "X" + VARPTR$(m$)
Font Tit$, 15
LINE (X, Y)-(X + pix, Y + s + v), 0, B
LINE (X, Y + v)-(X + pix, Y + s + v), 0, B
LINE (X + 1, Y + v + 1)-(X + pix - 1, Y + s + v - 1), 7, BF
m$ = "BM" + RTRIM$(LTRIM$(STR$(X + 2))) + ", " + RTRIM$(LTRIM$(STR$(Y + v + v + 1)))
DRAW "X" + VARPTR$(m$)
j = Y
FOR a = 1 TO LEN(ms$)
IF MID$(ms$, a, 1) = CHR$(13) THEN j = j + v: m$ = "BM" + RTRIM$(LTRIM$(STR$(X + 2))) + ", " + RTRIM$(LTRIM$(STR$(j + v + v + 1))): DRAW "X" + VARPTR$(m$)
Font MID$(ms$, a, 1), 0
NEXT a
j = j + v: m$ = "BM" + RTRIM$(LTRIM$(STR$(INT(X + (pix / 2) + (LEN(wt$) / 2) - 30)))) + ", " + RTRIM$(LTRIM$(STR$(j + v + v + 1))): DRAW "X" + VARPTR$(m$)
'Font wt$
d = INT(X + (pix / 2) + (LEN(wt$) / 2) - 30)
j = INT(j + v + v + 1)
m = 117
n = -107
MouseShow
Button2 j - n, d - m, j + 35 - n, d + 14 - m, 6, wt$
PUT (X, Y), back, PSET
END SUB

SUB Print2 (X, Y, cv, t$)
IF X = -1 AND Y = -1 THEN d$ = "C" + LTRIM$(RTRIM$(STR$(cv))): GOTO 3
IF X = -2 THEN X = (POS(0) * 8) - 7: g = -2
IF Y = -2 THEN Y = CSRLIN * 16: n = -2
xxx$ = LTRIM$(RTRIM$(STR$(X)))
yyy$ = LTRIM$(RTRIM$(STR$(Y)))
ccc$ = " C" + LTRIM$(RTRIM$(STR$(cv)))
'LOCATE 1, 1: PRINT d$
3 PSET (X, Y), POINT(X, Y)
Font t$, cv
IF g = -2 THEN LOCATE CSRLIN, POS(0) + LEN(t$)
IF n = -2 THEN LOCATE CSRLIN + 1, 1
END SUB

'Does nessacery stuff before shutting down
SUB QueryUnload
KILL "WIND.WND"
KILL "BACK.WND"
END SUB

' Refreshes a form or the screen
'frm$=Name of form to refresh (ignored if n=1)
'n=Refresh screen (0 to ignore)
SUB Refresh (frm$, n)
IF n = 1 THEN
OPEN "WIND.WND" FOR RANDOM AS #1
IF LOF(1) = 0 THEN CLOSE 1: EXIT SUB ELSE CLOSE 1
OPEN "WIND.WND" FOR INPUT AS #1
DIM FirstS(6) AS SINGLE
OPEN "BACK.WND" FOR INPUT AS #2: INPUT #2, Bck: CLOSE #2
MouseHide
LINE (0, 0)-(640, 480), Bck, BF
DO UNTIL EOF(1)
LINE INPUT #1, gg$
ConvWindInf gg$, p1, p2, p3, p4, p5, p6, p7, p8, tt$, nm$
Windows p1, p2, p3, p4, CINT(p5), p6, p7, p8, tt$, nm$
CNtr = 0: ln = 0: FOR q = 0 TO 5: FirstS(q) = 0: NEXT q: tt$ = "": nm$ = ""
LOOP
CLOSE 1
MouseShow
EXIT SUB
END IF
OPEN "WIND.WND" FOR RANDOM AS #1
IF LOF(1) = 0 THEN CLOSE 1: EXIT SUB ELSE CLOSE 1
OPEN "WIND.WND" FOR INPUT AS #1
DO UNTIL EOF(1)
LINE INPUT #1, gg$
IF LastPart$(gg$, " ") = frm$ THEN ConvWindInf gg$, p1, p2, p3, p4, p5, p6, p7, p8, tt$, nm$: Windows p1, p2, p3, p4, CINT(p5), p6, p7, p8, tt$, nm$
LOOP
CLOSE 1
END SUB

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

FUNCTION TextWidth (t$)
FOR q = 1 TO LEN(t$)
ta$ = Txt$(ASC(MID$(t$, q, 1)))
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

FUNCTION TRIMS$ (n, t$)
IF t$ = "" THEN TRIMS$ = LTRIM$(RTRIM$(STR$(n))) ELSE TRIMS$ = LTRIM$(RTRIM$(t$))
END FUNCTION

SUB Windows (X, Y, Wd, Ht, Style%, BackColor, ForeColor, Visible, Caption$, Name$)
IF Visible = False THEN GOTO DoNotShow
MouseHide
x2 = X + Wd
y2 = Y + Ht
IF Style% = 2 OR Style% = 3 THEN
LINE (X, Y)-(X, Y + Ht), 7
LINE (X, Y)-(X + Wd, Y), 7
LINE (X + 1, Y + 1)-(X + 1, Y + Ht - 1), 15
LINE (X + 1, Y + 1)-(X + Wd - 1, Y + 1), 15
LINE (X + 2, Y + 2)-(X + Wd - 2, Y + 2), 7
LINE (X + 2, Y + 2)-(X + 2, Y + Ht - 2), 7
LINE (X, Y + Ht)-(X + Wd, Y + Ht), 0
LINE (X + Wd, Y)-(X + Wd, Y + Ht), 0
LINE (X + 1, Y + Ht - 1)-(X + Wd - 1, Y + Ht - 1), 8
LINE (X + Wd - 1, Y + 1)-(X + Wd - 1, Y + Ht - 1), 8
LINE (X + 2, Y + Ht - 2)-(X + Wd - 2, Y + Ht - 2), 7
LINE (X + Wd - 2, Y + 2)-(X + Wd - 2, Y + Ht - 2), 7
LINE (X + 3, Y + 3)-(X + Wd - 3, Y + Ht - 3), BackColor, BF
IF Caption$ <> "" THEN LINE ((X + 3), Y + 3)-(X + Wd - 3, Y + 19), 1, BF
'IF TextWidth(Caption$) > (X + Wd) / 2 THEN Caption$ = LEFT$(Caption$, 1) + "..."
Print2 ((X + 2 + 20) - (Style% - 2) * 18), Y + 17, 15, Caption$
END IF
IF Style% = 0 THEN LINE (X, Y)-(X + Wd, Y + Ht), BackColor, BF
IF Style% = 1 THEN
LINE (X, Y)-(X + Wd, Y + Ht), 0, B
LINE (X + 1, Y + 1)-(X + Wd - 1, Y + Ht - 1), BackColor, BF
IF Caption$ <> "" THEN LINE (X + 1, Y + 1)-(X + Wd - 1, Y + 18), 1, BF
Print2 (X + 2 + 20), Y + 17, 15, Caption$
END IF
MouseShow
DoNotShow:
frm$ = TRIMS$(X, "") + " " + TRIMS$(Y, "") + " " + TRIMS$(Wd, "") + " " + TRIMS$(Ht, "") + " " + TRIMS$(CSNG(Style%), "") + " " + TRIMS$(BackColor, "") + " " + TRIMS$(ForeColor, "") + " " + TRIMS$(Visible, "") + " " + CHR$(LEN(Caption$)) + Caption$ + " " + TRIMS$(0, Name$)
AddForm frm$
END SUB