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