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