5748283 [rkeene@sledge /home/rkeene/devel/archive/quickbasic]$ cat -n window9.bas
   1: DECLARE SUB Inputbox (X!, y!, T$, Prm$)
   2: DECLARE SUB Win (X!, y!, eX!, Ey!, q!)
   3: DECLARE SUB LoadFont (f$)
   4: DECLARE SUB Font (T$, C!)
   5: DECLARE SUB Background (C!)
   6: DECLARE SUB Sleep2 (T!)
   7: DECLARE SUB Window2 (length!, height!, row!, column!)
   8: DECLARE SUB Textbx (SX!, SY!, eX!, Ey!, T$, r!, l!, pw$, tb$, del)
   9: DECLARE SUB Button1 (X!, y!, eX!, Ey!, P!, tle$)
  10: DIM SHARED Txt(255) AS STRING
  11: DIM SHARED Wind(1 TO 16384)
  12: SCREEN 12
  13: DEF SEG = 0
  14: POKE &H417, (160 XOR &H40)
  15: LoadFont "C:\ROY1.FNT"
  16: Background 1
  17: Window2 300, 426, 10, 20
  18: Textbx 40, 40, 290, 55, Txt$, 0, 1, "", "NOTHING", 1
  19: Button1 50, 100, 100, 150, 0, "   G"
  20: DO UNTIL INKEY$ = CHR$(13): Sleep2 .3: Button1 50, 100, 100, 150, 1, "   G": Sleep2 .3: Button1 50, 100, 100, 150, 0, "   G": LOOP
  21: Textbx 40, 40, 290, 55, T$, 1, 16, "@", "ROY ", 0
  22: Textbx 40, 60, 290, 75, T$, 1, 16, "", "ROY ", 1
  23: Inputbox 10, 10, Roy$, "DADA!"
  24: 
  25: 
  26: END
  27: DATA "My name is Roy S. Keene this is Visual Basic for QBasic, QuickBasic, and Power-"
  28: DATA "Basic.","     It is fully explained in the comments however, if you need help E-Mail me.",,"Age      : 13","Sex      : M","Grade    : 7"
  29: 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."
  30: DATA ,"Copyright(C) MCMXCV Keene Enterprises Inc."
  31: 3322
  32: END
  33: 
  34: SUB AboutTheAuthor
  35: ON ERROR GOTO 3322
  36:  SCREEN 12: CLS
  37: DO UNTIL EEE = 1
  38: READ a$: PRINT a$
  39: LOOP
  40: EXIT SUB
  41: END SUB
  42: 
  43: SUB Background (C)
  44: LINE (-1, -1)-(640, 480), C, BF
  45: END SUB
  46: 
  47: SUB Button1 (X, y, eX, Ey, P, tle$)
  48: IF P = 0 THEN clr1 = 15: clr2 = 8 ELSE clr1 = 8: clr2 = 15
  49: LINE (X + 2, y + 2)-(eX - 3, Ey - 3), 7, BF
  50: LINE (X, y)-(eX, Ey), 8, B
  51: 
  52: 
  53: 
  54: END SUB
  55: 
  56: SUB Font (T$, C)
  57: CC$ = STR$(C)
  58: CC$ = "C" + MID$(CC$, 2, LEN(CC$) - 1)
  59: DRAW "X" + VARPTR$(CC$)
  60: FOR qww = 1 TO LEN(T$)
  61: DRAW "X" + VARPTR$(Txt(ASC(MID$(T$, qww, 1)))): GOTO 1011
  62: 1011 NEXT qww
  63: END SUB
  64: 
  65: SUB Inputbox (X, y, T$, Prm$)
  66: Z = 140
  67: DIM Back(1 TO 9998)
  68: GET (X, y)-(X + 100 + Z, y + 100 + Z), Back
  69: LINE (X, y)-(X + 100 + Z, y + 100 + Z), 0, BF
  70: LINE (X + 2, y + 2)-(X + 98 + Z, y + 98 + Z), 1, BF
  71: LINE (X + 10, y + 10)-(X + 90 + Z, y + 90 + Z), 0, BF
  72: LINE (X + 12, y + 12)-(X + 88 + Z, y + 88 + Z), 7, BF
  73: Xy = X + 15
  74: yX = y + 67 + Z
  75: Xx = X + 85 + Z
  76: yY = y + 82 + Z
  77: Xyz$ = "M" + STR$(X + 13) + "," + STR$(y + 23)
  78: DRAW "X" + VARPTR$(Xyz$)
  79: Font Prm$, 0
  80: Textbx Xy, yX, Xx, yY, T$, 1, 14, "", "", 0
  81: PUT (X, y), Back, PSET
  82: END SUB
  83: 
  84: SUB LoadFont (f$)
  85: OPEN f$ FOR INPUT AS #1: T = 0
  86: DO UNTIL EOF(1)
  87: LINE INPUT #1, a$
  88: Txt(T) = a$
  89: T = T + 1
  90: LOOP
  91: END SUB
  92: 
  93: SUB SCapt (FIL$)
  94: OPEN FIL$ FOR OUTPUT AS #1 LEN = 10000
  95: FOR X = 0 TO 639
  96: FOR y = 0 TO 479
  97: vv$ = CHR$(POINT(X, y) + 32)
  98: PRINT #1, vv$; : PSET (X, y), 15
  99: IF INKEY$ = "" THEN  ELSE CLOSE 1: EXIT SUB
 100: NEXT y
 101: NEXT X
 102: CLOSE 1
 103: END SUB
 104: 
 105: SUB Sleep2 (T)
 106: a = TIMER
 107: DO UNTIL TIMER >= a + T: LOOP
 108: 
 109: 
 110: END SUB
 111: 
 112: SUB SLoad (FIL$)
 113: OPEN FIL$ FOR RANDOM AS #1
 114: FOR X = 0 TO 639
 115: FOR y = 0 TO 479
 116: GET #1, y + 1 * (X + 1), clr$
 117: IF INKEY$ = "" THEN  ELSE CLOSE 1: EXIT SUB
 118: IF EOF(1) THEN CLOSE 1: PSET (X, y), clr%: EXIT SUB
 119: PSET (X, y), ASC(clr$) - 32
 120: 10 NEXT y
 121: NEXT X
 122: END SUB
 123: 
 124: SUB Textbx (SX, SY, eX, Ey, T$, r, l, pw$, tb$, del)
 125: IF LEN(tb$) > l AND r = 1 THEN tb$ = MID$(tb$, 1, l)
 126: T$ = tb$: W = LEN(tb$)
 127: IF del = 1 THEN ds = 0 ELSE ds = LEN(tb$)
 128: IF LEN(pw$) > 1 THEN pw$ = LEFT$(pw$, 1)
 129: LINE (SX - 1, SY - 1)-(eX + 1, Ey + 1), 0, B
 130: LINE (SX, SY)-(eX, Ey), 15, BF
 131: MX$ = "M" + STR$(SX + 2) + "," + STR$(Ey - 2)
 132: DRAW "BX" + VARPTR$(MX$)
 133: IF pw$ = "" THEN Font tb$, 0 ELSE Font STRING$(LEN(tb$), pw$), 0
 134: IF r = 1 THEN  ELSE EXIT SUB
 135: 12 a$ = INKEY$
 136: IF a$ = "" GOTO 12
 137: 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
 138: IF a$ = CHR$(13) THEN EXIT SUB
 139: IF W = l THEN GOTO 12
 140: T$ = T$ + a$: W = W + LEN(a$)
 141: B$ = UCASE$(a$)
 142: IF pw$ = "" THEN Font B$, 0 ELSE Font pw$, 0
 143: GOTO 12
 144: END SUB
 145: 
 146: SUB Window2 (length, height, row, column)
 147: LINE (column, row)-(column + length, row + height), 0, B
 148: FOR i% = 1 TO 2
 149: row = row + 1: column = column + 1: height = height - 1: length = length - 1
 150: LINE (column, row)-(column + length, row), 7
 151: LINE (column, row)-(column, row + height), 7
 152: NEXT i%
 153: row = row + 1: column = column + 1: height = height - 1: length = length - 1
 154: LINE (column, row)-(column + length, row), 0
 155: LINE (column, row)-(column, row + height), 0
 156: LINE (column, row)-(column + 18, row + 18), 7, BF
 157: LINE (column, row)-(column + 18, row + 18), 0, B
 158: LINE (column + 18, row - 2)-(column + 18, row + 5), 0
 159: LINE (column - 2, row + 18)-(column + 5, row + 18), 0
 160: LINE (column + 5, row + 7)-(column + 13, row + 9), 15, BF: LINE (column + 5, row + 7)-(column + 13, row + 9), 0, B
 161: LINE (column + 14, row + 7)-(column + 14, row + 9), 8
 162: LINE (column + 6, row + 10)-(column + 14, row + 10), 8, B
 163: LINE (column + 18, row)-(column + length, row + 18), 9, BF
 164: LINE (column + 18, row)-(column + length, row + 18), 0, B
 165: LINE (column + length, row - 3)-(column + length + 2, row + height), 7, BF
 166: LINE (column + length, row - 3)-(column + length + 3, row + height), 0, B
 167: LINE (column + length, row - 2)-(column + length, row - 1), 7
 168: LINE (column + length - 18, row - 2)-(column + length - 18, row - 1), 0
 169: LINE (column + length, row + 18)-(column + length + 2, row + 18), 0
 170: LINE (column, row + height - 3)-(column + length, row + height - 3), 0, B
 171: LINE (column, row + height - 2)-(column + length + 2, row + height), 7, BF
 172: LINE (column - 2, row + height)-(column + length + 2, row + height), 0, B
 173: LINE (column - 2, row + height - 18)-(column, row + height - 18), 0
 174: LINE (column + length - 2, row + height - 18)-(column + length + 2, row + height - 18), 0
 175: LINE (column + 18, row + height)-(column + 18, row + height - 2), 0
 176: LINE (column + length - 18, row + height)-(column + length - 18, row + height - 2), 0
 177: LINE (column + 1, row + 19)-(column + length - 1, row + height - 4), 7, BF
 178: END SUB
 179: 
5748284 [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:10