5748254 [rkeene@sledge /home/rkeene/devel/archive/quickbasic]$ cat -n is1.bas
   1: DECLARE SUB GetInfo (Nm$, out$)
   2: DECLARE SUB UnLoadFont ()
   3: DECLARE SUB MsgBox (ms$, Tit$)
   4: DECLARE SUB Inputbox (x!, y!, t$, Prm$)
   5: DECLARE SUB Win (x!, y!, eX!, Ey!, q!)
   6: DECLARE SUB LoadFont (f$)
   7: DECLARE SUB Font (t$)
   8: DECLARE SUB Background (C!)
   9: DECLARE SUB Sleep2 (t!)
  10: DECLARE SUB Window2 (length!, height!, row!, column!)
  11: DECLARE SUB Textbx (SX!, SY!, eX!, Ey!, t$, r!, l!, pw$, tb$, del)
  12: DECLARE SUB Button1 (x!, y!, s!, P!, tle$)
  13: DIM SHARED txt(255) AS STRING
  14: SCREEN 9
  15: LoadFont "C:\ASCIN.FNT"
  16: Background 1
  17: G10:
  18: Inputbox INT(RND * 50), INT(RND * 50), Roy$, "What Is Your Name?"
  19: IF RTRIM$(LTRIM$(Roy$)) = "" THEN GOTO G10
  20: MsgBox "Hello " + RTRIM$(LTRIM$(Roy$)) + "." + CHR$(13) + "My name is IS1.", "Greetings " + RTRIM$(LTRIM$(Roy$))
  21: 'GetInfo Roy$, Info$
  22: Window2 250, 150, 10, 10
  23: MsgBox "IS - Inteligence Simulator V6.0 By Roy Keene & James Lampton", "IS1 Information"
  24: MsgBox "Made in QBASIC the Windows Like Code was Made By Roy Keene", "IS1 Information"
  25: MsgBox "The mind was made by James Lampton & Roy Keene", "IS1 Information"
  26: UnLoadFont
  27: 
  28: SUB Background (C)
  29: LINE (-1, -1)-(640, 480), C, BF
  30: END SUB
  31: 
  32: SUB Button1 (x, y, s, P, tle$)
  33: IF P = 0 THEN clr1 = 15: clr2 = 8 ELSE clr1 = 8: clr2 = 15
  34: eX = x + s: Ey = y + s
  35: LINE (x, y)-(eX, Ey), 7, BF
  36: LINE (x, y)-(eX, Ey), 0, B
  37: LINE (x + 5, y + 5)-(eX - 5, Ey - 5), 7, BF
  38: LINE (x + 4, y + 4)-(eX - 4, Ey - 4), 0, B
  39: LINE (x, Ey)-(x + 4, Ey - 4), 0
  40: LINE (eX, y)-(eX - 4, y + 4), 0
  41: PAINT (x + 1, y + 1), clr1, 0
  42: PAINT (eX - 1, Ey - 1), clr2, 0
  43: END SUB
  44: 
  45: SUB Font (t$)
  46: DRAW "C0"
  47: IF txt(32) = "" THEN LOCATE 1, 1: PRINT "System Error. Unable to continue.": END
  48: FOR qww = 1 TO LEN(t$)
  49: DRAW "X" + VARPTR$(txt(ASC(MID$(t$, qww, 1)))): GOTO 1011
  50: 1011 NEXT qww
  51: END SUB
  52: 
  53: SUB GetInfo (Nm$, out$)
  54: OPEN "Names.dat" FOR INPUT AS #1
  55: DO UNTIL EOF(1)
  56: LINE INPUT #1, s$
  57: 'IF UCASE$(s$) = UCASE$(Nm$)
  58: LOOP
  59: END SUB
  60: 
  61: SUB Inputbox (x, y, t$, Prm$)
  62: Z = 90
  63: s = 50
  64: DIM back(1 TO 9998)
  65: GET (x, y)-(x + 100 + Z, y + 50 + Z), back
  66: LINE (x, y)-(x + 100 + Z, y + 50 + Z), 0, BF
  67: LINE (x + 2, y + 2)-(x + 98 + Z, y + 48 + Z), 1, BF
  68: LINE (x + 10, y + 10)-(x + 90 + Z, y + 40 + Z), 0, BF
  69: LINE (x + 12, y + 12)-(x + 88 + Z, y + 38 + Z), 7, BF
  70: Xy = x + 15
  71: yX = y + 67 - s + Z
  72: Xx = x + 85 + Z
  73: yY = y + 82 - s + Z
  74: Xyz$ = "M" + STR$(x + 14) + "," + STR$(y + 25)
  75: DRAW "X" + VARPTR$(Xyz$)
  76: Font Prm$
  77: Textbx Xy, yX, Xx, yY, t$, 1, 17, "", "", 0
  78: PUT (x, y), back, PSET
  79: END SUB
  80: 
  81: SUB LoadFont (f$)
  82: OPEN f$ FOR INPUT AS #1: t = 0
  83: DO UNTIL EOF(1)
  84: LINE INPUT #1, a$
  85: txt(t) = a$
  86: t = t + 1
  87: LOOP
  88: CLOSE 1
  89: END SUB
  90: 
  91: SUB MsgBox (ms$, Tit$)
  92: wt$ = "[ENTER]"
  93: s = 17
  94: v = 15
  95: s = s + v
  96: FOR w = 1 TO LEN(ms$): l = l + 1: IF MID$(ms$, w, 1) = CHR$(13) THEN s = s + v
  97: NEXT w
  98: IF LEN(Tit$) >= LEN(ms$) THEN pix = INT(LEN(Tit$) * 9.2) ELSE pix = INT(LEN(ms$) * 9.2)
  99: IF INT(LEN(wt$) * 9.2) > pix THEN pix = INT(LEN(" (Press ENTER to continue.)") * 9.2)
 100: x = 320 - INT(pix / 2)
 101: y = 175 - s
 102: DIM back(1 TO 9998)
 103: GET (x, y)-(x + pix, y + s + v), back
 104: LINE (x + 1, y + 1)-(x + pix - 1, y + v), 9, BF
 105: M$ = "BM" + RTRIM$(LTRIM$(STR$(x + 5))) + ", " + RTRIM$(LTRIM$(STR$(y + v + 1)))
 106: DRAW "X" + VARPTR$(M$)
 107: Font Tit$
 108: LINE (x + 1, y + v + 1)-(x + pix - 1, y + s + v - 1), 7, BF
 109: M$ = "BM" + RTRIM$(LTRIM$(STR$(x + 2))) + ", " + RTRIM$(LTRIM$(STR$(y + v + v + 1)))
 110: DRAW "X" + VARPTR$(M$)
 111: j = y
 112: FOR a = 1 TO LEN(ms$)
 113: 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$)
 114: Font MID$(ms$, a, 1)
 115: NEXT a
 116: 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$)
 117: Font wt$
 118: DO UNTIL INKEY$ = CHR$(13): LOOP
 119: PUT (x, y), back, PSET
 120: END SUB
 121: 
 122: SUB SCapt (FIL$)
 123: OPEN FIL$ FOR BINARY AS #1 LEN = 10000
 124: FOR x = 0 TO 639
 125: FOR y = 0 TO 479
 126: vv$ = CHR$(POINT(x, y) + 32)
 127: PUT #1, y + x, vv$: PSET (x, y), 15
 128: IF INKEY$ = "" THEN  ELSE CLOSE 1: EXIT SUB
 129: NEXT y
 130: NEXT x
 131: CLOSE 1
 132: END SUB
 133: 
 134: SUB Sleep2 (t)
 135: a = TIMER
 136: DO UNTIL TIMER >= a + t: LOOP
 137: 
 138: 
 139: END SUB
 140: 
 141: SUB SLoad (FIL$)
 142: OPEN FIL$ FOR RANDOM AS #1
 143: FOR x = 0 TO 639
 144: FOR y = 0 TO 479
 145: GET #1, y + 1 * (x + 1), clr$
 146: IF INKEY$ = "" THEN  ELSE CLOSE 1: EXIT SUB
 147: IF EOF(1) THEN CLOSE 1: PSET (x, y), clr%: EXIT SUB
 148: PSET (x, y), ASC(clr$) - 32
 149: 10 NEXT y
 150: NEXT x
 151: END SUB
 152: 
 153: SUB Textbx (SX, SY, eX, Ey, t$, r, l, pw$, tb$, del)
 154: IF LEN(tb$) > l AND r = 1 THEN tb$ = MID$(tb$, 1, l)
 155: t$ = tb$: w = LEN(tb$)
 156: IF del = 1 THEN ds = 0 ELSE ds = LEN(tb$)
 157: IF LEN(pw$) > 1 THEN pw$ = LEFT$(pw$, 1)
 158: LINE (SX - 1, SY - 1)-(eX + 1, Ey + 1), 0, B
 159: LINE (SX, SY)-(eX, Ey), 15, BF
 160: MX$ = "M" + STR$(SX + 2) + "," + STR$(Ey - 0)
 161: DRAW "BX" + VARPTR$(MX$)
 162: IF pw$ = "" THEN Font tb$ ELSE Font STRING$(LEN(tb$), pw$)
 163: IF r = 1 THEN  ELSE EXIT SUB
 164: 12 a$ = INKEY$
 165: IF a$ = "" GOTO 12
 166: 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 t$: GOTO 12 ELSE Font STRING$(LEN(t$), pw$): GOTO 12
 167: IF a$ = CHR$(13) THEN EXIT SUB
 168: IF w >= l THEN GOTO 12
 169: t$ = t$ + a$: w = w + LEN(a$)
 170: B$ = a$
 171: IF pw$ = "" THEN Font B$ ELSE Font pw$
 172: GOTO 12
 173: END SUB
 174: 
 175: SUB UnLoadFont
 176: 'Free Up Memmory Used By Font
 177: 'Do Not Try To Use The Font After This Command Is Issued
 178: FOR q = 0 TO 255
 179: txt(q) = ""
 180: NEXT q
 181: END SUB
 182: 
 183: SUB Window2 (length, height, row, column)
 184: LINE (column, row)-(column + length, row + height), 0, B
 185: FOR i% = 1 TO 2
 186: row = row + 1: column = column + 1: height = height - 1: length = length - 1
 187: LINE (column, row)-(column + length, row), 7
 188: LINE (column, row)-(column, row + height), 7
 189: NEXT i%
 190: row = row + 1: column = column + 1: height = height - 1: length = length - 1
 191: LINE (column, row)-(column + length, row), 0
 192: LINE (column, row)-(column, row + height), 0
 193: LINE (column, row)-(column + 18, row + 18), 7, BF
 194: LINE (column, row)-(column + 18, row + 18), 0, B
 195: LINE (column + 18, row - 2)-(column + 18, row + 5), 0
 196: LINE (column - 2, row + 18)-(column + 5, row + 18), 0
 197: LINE (column + 5, row + 7)-(column + 13, row + 9), 15, BF: LINE (column + 5, row + 7)-(column + 13, row + 9), 0, B
 198: LINE (column + 14, row + 7)-(column + 14, row + 9), 8
 199: LINE (column + 6, row + 10)-(column + 14, row + 10), 8, B
 200: LINE (column + 18, row)-(column + length, row + 18), 9, BF
 201: LINE (column + 18, row)-(column + length, row + 18), 0, B
 202: LINE (column + length, row - 3)-(column + length + 2, row + height), 7, BF
 203: LINE (column + length, row - 3)-(column + length + 3, row + height), 0, B
 204: LINE (column + length, row - 2)-(column + length, row - 1), 7
 205: LINE (column + length - 18, row - 2)-(column + length - 18, row - 1), 0
 206: LINE (column + length, row + 18)-(column + length + 2, row + 18), 0
 207: LINE (column, row + height - 3)-(column + length, row + height - 3), 0, B
 208: LINE (column, row + height - 2)-(column + length + 2, row + height), 7, BF
 209: LINE (column - 2, row + height)-(column + length + 2, row + height), 0, B
 210: LINE (column - 2, row + height - 18)-(column, row + height - 18), 0
 211: LINE (column + length - 2, row + height - 18)-(column + length + 2, row + height - 18), 0
 212: LINE (column + 18, row + height)-(column + 18, row + height - 2), 0
 213: LINE (column + length - 18, row + height)-(column + length - 18, row + height - 2), 0
 214: LINE (column + 1, row + 19)-(column + length - 1, row + height - 4), 7, BF
 215: END SUB
 216: 
5748255 [rkeene@sledge /home/rkeene/devel/archive/quickbasic]$

Click here to go back to the directory listing.
Click here to download this file.
last modified: 2000-05-09 21:03:47