5748392 [rkeene@sledge /home/rkeene/devel/archive/quickbasic]$ cat -n wndos(s).bas
   1: DECLARE SUB Window2 (Length!, Height!, Row!, Column!, tt$, Nm$)
   2: DECLARE FUNCTION TRIM$ (t$)
   3: DECLARE SUB LoadFont (f$)
   4: DECLARE SUB BackGround (a!)
   5: DECLARE SUB MsgBox (ms$, Tit$)
   6: DECLARE SUB InputBox (x!, y!, t$, Prm$)
   7: DECLARE SUB LoadMouse ()
   8: DECLARE SUB Button2 (x1!, y1!, x2!, y2!, p!, t$)
   9: DECLARE SUB CheckBox (x1!, y1!, cc!, t$, cl!, id!)
  10: DECLARE SUB TextBox (SX!, SY!, eX!, Ey!, t$, r!, l!, pw$, tb$, del!, mln!)
  11: DECLARE SUB UnLoadFont ()
  12: DECLARE SUB SCapt (f$)
  13: DECLARE SUB SLoad (f$)
  14: DECLARE SUB PutBack ()
  15: DECLARE SUB PutMouse (nnn!)
  16: DECLARE SUB ProClk (x!, y!)
  17: DECLARE SUB Print2 (x!, y!, cv!, t$)
  18: DECLARE SUB Sleep2 (t!)
  19: DECLARE SUB connect ()
  20: DECLARE SUB Font (t$, cl!)
  21: DECLARE SUB TextBx (SX!, SY!, eX!, Ey!, t$, r!, l!, pw$, tb$, del!)
  22: DECLARE SUB opencom ()
  23: DECLARE SUB PopMenu (x!, y!)
  24: DECLARE FUNCTION Stat$ (num!)
  25: DECLARE SUB ReBoot (Warm%)
  26: CLEAR , , 1000
  27: DIM SHARED txt(255) AS STRING
  28: DIM SHARED Wxyz(4)
  29: DIM SHARED Mouse(400)
  30: DIM SHARED ChkBx(100)
  31: DIM SHARED BackGroundColor
  32: DIM SHARED Msx, Msy
  33: DIM SHARED Clx, Cly, Clk
  34: DIM SHARED MouseClr$
  35: KEY 15, CHR$(0) + CHR$(82)
  36: ON KEY(1) GOSUB Capt: KEY(1) ON
  37: ON KEY(2) GOSUB Load: KEY(2) ON
  38: ON KEY(11) GOSUB UpArow: KEY(11) ON
  39: ON KEY(12) GOSUB LtArow: KEY(12) ON
  40: ON KEY(13) GOSUB RtArow: KEY(13) ON
  41: ON KEY(14) GOSUB DnArow: KEY(14) ON
  42: ON KEY(15) GOSUB Click: KEY(15) ON
  43: ON TIMER(3) GOSUB Clkn: TIMER ON
  44: FOR q = 0 TO 100: ChkBx(q) = -1: NEXT q: q = 0
  45: MouseClr$ = CHR$(INT(RND * 245)) + CHR$(INT(RND * 150)) + CHR$(INT(RND * 210)) + CHR$(INT(RND * 100))
  46: SCREEN 12
  47: CLS
  48: Msx = POINT(0)
  49: Msy = POINT(1)
  50: Xi = 5
  51: Yi = 5
  52: LoadFont "C:\ASCIn.FNT"
  53: BackGround 3
  54: MsgBox "Windows Like Code (WINDOS)", "** Unregistered Version **"
  55: InputBox 50, 50, pw$, "Enter the password"
  56: IF pw$ = CHR$(73) + CHR$(32) + CHR$(3) + CHR$(32) + CHR$(85) THEN  ELSE MsgBox "*** Unauthorized Access ***", ":-) :-| :-(": END
  57: BackGround 1
  58: Window2 320, 300, 10, 10, "Main Menu", "Main"
  59: LoadMouse
  60: Button2 30, 285, 60, 300, 0, "END"
  61: Button2 110, 285, 148, 300, 0, "FREE"
  62: Button2 158, 285, 158 + 56, 300, 0, "Reboot"
  63: CheckBox 30, 230, 0, "Display Mouse Status", 0, 1
  64: TextBox 18, 43, 243, 218, Null$, 1, 28, "", "", 1, 11
  65: DO UNTIL INKEY$ = CHR$(13)
  66: IF ChkBx(1) = 1 THEN LOCATE 1, 1: PRINT Msx; Msy; "Click is:"; Stat$(Clk); "  "
  67: LOOP
  68: Button2 70, 285, 100, 300, 5, "BYE"
  69: UnLoadFont
  70: END
  71: '****************************************************************************
  72: '* GoSUBs                                                                   *
  73: '****************************************************************************
  74: Capt:
  75: SCapt "Win1.BSV"
  76: RETURN
  77: 
  78: Load:
  79: SLoad "Win1.BSV"
  80: RETURN
  81: 
  82: UpArow:
  83: PutBack
  84: Msy = Msy - Yi
  85: IF Msy < 0 THEN Msy = Msy + Yi
  86: PutMouse 0
  87: RETURN
  88: 
  89: DnArow:
  90: PutBack
  91: Msy = Msy + Yi
  92: IF Msy > 479 THEN Msy = Msy - Yi
  93: PutMouse 0
  94: RETURN
  95: 
  96: LtArow:
  97: PutBack
  98: Msx = Msx - Xi
  99: IF Msx < 0 THEN Msx = Msx + Xi
 100: PutMouse 0
 101: RETURN
 102: 
 103: RtArow:
 104: PutBack
 105: Msx = Msx + Xi
 106: IF Msx > 639 THEN Msx = Msx - Xi
 107: PutMouse 0
 108: RETURN
 109: 
 110: Click:
 111: TIMER ON
 112: Clx = Msx
 113: Cly = Msy
 114: Clk = 1
 115: ProClk Clx, Cly
 116: RETURN
 117: 
 118: Clkn:
 119: 'LOCATE 2, 1: PRINT Clk; Msy; Msx
 120: IF Clk = 1 THEN Clk = 0: TIMER OFF
 121: RETURN
 122: 
 123: SUB BackGround (a)
 124: BackGroundColor = a
 125: LINE (0, 0)-(640, 480), a, BF
 126: Msx = 320: Msy = 240
 127: PutMouse 0
 128: END SUB
 129: 
 130: SUB Button1 (x, y, s, p, tle$)
 131: IF p = 0 THEN clr1 = 15: clr2 = 8 ELSE clr1 = 8: clr2 = 15
 132: eX = x + s: Ey = y + s
 133: LINE (x, y)-(eX, Ey), 1, BF
 134: LINE (x, y)-(eX, Ey), 0, B
 135: LINE (x + 5, y + 5)-(eX - 5, Ey - 5), 1, BF
 136: LINE (x + 4, y + 4)-(eX - 4, Ey - 4), 0, B
 137: LINE (x, Ey)-(x + 4, Ey - 4), 0
 138: LINE (eX, y)-(eX - 4, y + 4), 0
 139: PAINT (x + 1, y + 1), clr1, 0
 140: PAINT (eX - 1, Ey - 1), clr2, 0
 141: END SUB
 142: 
 143: SUB Button2 (x1, y1, x2, y2, p, t$)
 144: IF p = 1 OR p = 4 THEN q = 1: GOTO PUSHED
 145: 'PRINT Clk; Clx; Cly; p; x1; x2; Y1; y2
 146: LINE (x1, y1)-(x1, y2 - 1), 15
 147: LINE (x1, y1)-(x2 - 1, y1), 15
 148: LINE (x2 - 1, y1 + 1)-(x2 - 1, y2 - 1), 8
 149: LINE (x2 - 1, y2 - 1)-(x1 + 1, y2 - 1), 8
 150: LINE (x1, y2)-(x2, y2), 0
 151: LINE (x2, y2)-(x2, y1), 0
 152: LINE (x1 + 1, y1 + 1)-(x2 - 2, y2 - 2), 7, BF
 153: IF p = 6 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 OR INKEY$ = CHR$(13): LOOP: Sleep2 .13: GOTO PUSHED
 154: 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
 155: IF p = 3 THEN Print2 INT(((x2 - x1) / 2) - ((LEN(t$) / 2) * 8) + x1), y1 + 14, 0, t$: DO UNTIL INKEY$ = CHR$(13): LOOP: q = 1 ELSE GOTO ssd
 156: PUSHED:
 157: LINE (x1, y1)-(x1, y2), 0
 158: LINE (x1, y1)-(x2, y1), 0
 159: LINE (x1 + 1, y1 + 1)-(x1 + 1, y2 - 1), 8
 160: LINE (x1 + 1, y1 + 1)-(x2 - 1, y1 + 1), 8
 161: LINE (x1 + 1, y2)-(x2, y2), 15
 162: LINE (x2, y2)-(x2, y1 + 1), 15
 163: LINE (x1 + 2, y1 + 2)-(x2 - 1, y2 - 1), 7, BF
 164: IF p > 3 THEN PutMouse 1
 165: ssd:
 166: IF LEN(t$) * 8 > x2 - x1 THEN EXIT SUB
 167: wdt = x2 - x1
 168: Print2 INT((wdt / 2) - ((LEN(t$) / 2) * 8) + x1), y1 + 14 + q, 0, t$
 169: IF p > 2 THEN Sleep2 .13
 170: IF p > 2 THEN Button2 x1, y1, x2, y2, 0, t$: PutMouse 1
 171: END SUB
 172: 
 173: SUB CheckBox (x1, y1, cc, t$, cl, id)
 174: PutBack
 175: IF ChkBx(id) = -1 THEN ChkBxCntr = ChkBxCntr + 1
 176: ChkBx(id) = cc
 177: x2 = x1 + 10
 178: y2 = y1 + 10
 179: LINE (x1, y1)-(x2, y2), cl, B
 180: m$ = "BM" + LTRIM$(RTRIM$(STR$(x1))) + "," + LTRIM$(RTRIM$(STR$(y1))) + "C" + LTRIM$(RTRIM$(STR$(cl))): DRAW "X" + VARPTR$(m$)
 181: IF cc = 1 THEN cl$ = "C" + RTRIM$(LTRIM$(STR$(cl))): DRAW "X" + VARPTR$(cl$)
 182: IF cc = 0 THEN bgg$ = "C" + RTRIM$(LTRIM$(STR$(POINT(x1 + 2, y1 + 1)))): DRAW "X" + VARPTR$(bgg$)
 183: DRAW "F9BH9BR10G9"
 184: Print2 x2 + 5, y2 + 2, cl, t$
 185: PutMouse 0
 186: END SUB
 187: 
 188: SUB Font (t$, cl)
 189: IF cl = -1 THEN  ELSE f$ = "C" + LTRIM$(RTRIM$(STR$(cl))): DRAW "X" + VARPTR$(f$)
 190: IF txt(32) = "" THEN LOCATE 1, 1: PRINT "System Error. Unable to continue.": END
 191: FOR qww = 1 TO LEN(t$)
 192: 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
 193: 1011 NEXT qww
 194: END SUB
 195: 
 196: SUB InputBox (x, y, t$, Prm$)
 197: Z = 90
 198: s = 50
 199: DIM back(1 TO 9998)
 200: GET (x, y)-(x + 100 + Z, y + 50 + Z), back
 201: LINE (x, y)-(x + 100 + Z, y + 50 + Z), 0, BF
 202: LINE (x + 2, y + 2)-(x + 98 + Z, y + 48 + Z), 1, BF
 203: LINE (x + 10, y + 10)-(x + 90 + Z, y + 40 + Z), 0, BF
 204: LINE (x + 12, y + 12)-(x + 88 + Z, y + 38 + Z), 7, BF
 205: Xy = x + 15
 206: yX = y + 67 - s + Z
 207: Xx = x + 85 + Z
 208: yY = y + 82 - s + Z
 209: Xyz$ = "BM" + STR$(x + 14) + "," + STR$(y + 25)
 210: DRAW "X" + VARPTR$(Xyz$)
 211: Font Prm$, 0
 212: TextBx Xy, yX, Xx, yY, t$, 1, 17, "", "", 0
 213: PUT (x, y), back, PSET
 214: END SUB
 215: 
 216: SUB LoadFont (f$)
 217: OPEN f$ FOR INPUT AS #1: t = 0
 218: DO UNTIL EOF(1)
 219: LINE INPUT #1, txt(t)
 220: t = t + 1
 221: LOOP
 222: CLOSE 1
 223: END SUB
 224: 
 225: SUB LoadMouse
 226: GET (Msx, Msy)-(Msx + 10, Msy + 10), Mouse
 227: PutMouse 0
 228: END SUB
 229: 
 230: SUB MsgBox (ms$, Tit$)
 231: wt$ = "OK"
 232: s = 17
 233: v = 15
 234: s = s + v
 235: FOR w = 1 TO LEN(ms$): l = l + 1: IF MID$(ms$, w, 1) = CHR$(13) THEN s = s + v
 236: NEXT w
 237: IF LEN(Tit$) >= LEN(ms$) THEN pix = INT(LEN(Tit$) * 8.4) ELSE pix = INT(LEN(ms$) * 8)
 238: IF INT(LEN(wt$) * 8.4) > pix THEN pix = INT(LEN(" (Press ENTER to continue.)") * 8.4)
 239: x = 320 - INT(pix / 2)
 240: y = 175 - s
 241: DIM back(1 TO 10998)
 242: GET (x, y)-(x + pix, y + s + v), back
 243: LINE (x + 1, y + 1)-(x + pix - 1, y + v), 1, BF
 244: m$ = "BM" + RTRIM$(LTRIM$(STR$(x + 5))) + ", " + RTRIM$(LTRIM$(STR$(y + v + 1)))
 245: DRAW "X" + VARPTR$(m$)
 246: Font Tit$, 15
 247: LINE (x, y)-(x + pix, y + s + v), 0, B
 248: LINE (x, y + v)-(x + pix, y + s + v), 0, B
 249: LINE (x + 1, y + v + 1)-(x + pix - 1, y + s + v - 1), 7, BF
 250: m$ = "BM" + RTRIM$(LTRIM$(STR$(x + 2))) + ", " + RTRIM$(LTRIM$(STR$(y + v + v + 1)))
 251: DRAW "X" + VARPTR$(m$)
 252: j = y
 253: FOR a = 1 TO LEN(ms$)
 254: 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$)
 255: Font MID$(ms$, a, 1), 0
 256: NEXT a
 257: 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$)
 258: 'Font wt$
 259: d = INT(x + (pix / 2) + (LEN(wt$) / 2) - 30)
 260: j = INT(j + v + v + 1)
 261: m = 117
 262: n = -107
 263: Button2 j - n, d - m, j + 35 - n, d + 14 - m, 6, wt$
 264: PUT (x, y), back, PSET
 265: END SUB
 266: 
 267: SUB PopMenu (x, y)
 268: DIM Behnd(1 TO 2000)
 269: PutBack
 270: lns = 2
 271: bw = 2
 272: mx = 100
 273: My = (lns * 16) + (bw * 2)
 274: GET (x, y)-(x + mx, y + My), Behnd
 275: LINE (x, y)-(x + mx, y + My), 14, BF
 276: LINE (x, y)-(x + mx, y + My), 0, B
 277: LINE (x + mx, y)-(x, y + My), 0
 278: PAINT (x + 1, y + 2), 15, 0
 279: PAINT ((x + mx) - 6, y + 5), 8, 0
 280: LINE (x + bw, y + bw)-(x + mx - bw, y + My - bw), 7, BF
 281: Print2 x + bw, y + bw + (16 * 1) - 4, 0, "Close"
 282: Print2 x + bw, y + bw + (16 * 2) - 4, 0, "Exit"
 283: PutMouse 0
 284: Sleep2 5
 285: PUT (x, y), Behnd, PSET
 286: IF Msx > x - 1 AND Msx < x + (mx + 1) AND Msy > y - 1 AND Msy < y + (My + 1) THEN  ELSE PutBack
 287: PutMouse 0
 288: END SUB
 289: 
 290: SUB Print2 (x, y, cv, t$)
 291: IF x = -1 AND y = -1 THEN d$ = "C" + LTRIM$(RTRIM$(STR$(cv))): GOTO 3
 292: IF x = -2 THEN x = (POS(0) * 8) - 7: g = -2
 293: IF y = -2 THEN y = CSRLIN * 16: n = -2
 294: IF x = -3 THEN x = Wxyz(2) + 7
 295: IF y = -3 THEN y = Wxyz(1) + 35
 296: xxx$ = LTRIM$(RTRIM$(STR$(x)))
 297: yyy$ = LTRIM$(RTRIM$(STR$(y)))
 298: ccc$ = " C" + LTRIM$(RTRIM$(STR$(cv)))
 299: d$ = "BM" + xxx$
 300: d$ = d$ + "," + yyy$
 301: d$ = d$ + ccc$
 302: 'LOCATE 1, 1: PRINT d$
 303: 3 DRAW "X" + VARPTR$(d$)
 304: Font t$, cv
 305: IF g = -2 THEN LOCATE CSRLIN, POS(0) + LEN(t$)
 306: IF n = -2 THEN LOCATE CSRLIN + 1, 1
 307: END SUB
 308: 
 309: SUB ProClk (x, y)
 310: Ox = POINT(0): Oy = POINT(1): Oc = POINT(Ox, Oy)
 311: PutBack
 312: IF x > 13 AND x < 32 AND y > 13 AND y < 32 THEN PopMenu x, y: Clk = 0: GOTO NXY
 313: IF x > 29 AND x < 61 AND y > 284 AND y < 301 THEN Button2 30, 285, 60, 300, 4, "END": UnLoadFont: END
 314: IF x > 109 AND x < 149 AND y > 284 AND y < 301 THEN Button2 110, 285, 149, 300, 4, "FREE": MsgBox STR$(FRE(1)) + "Bytes", "Free Memmory": Clk = 0: GOTO NXY
 315: IF x > 29 AND x < 207 AND y > 229 AND y < 241 AND ChkBx(1) = 0 THEN CheckBox 30, 230, 1, "Display Mouse Status", 0, 1: Clk = 0: GOTO NXY
 316: IF x > 29 AND x < 207 AND y > 229 AND y < 241 AND ChkBx(1) = 1 THEN CheckBox 30, 230, 0, "Display Mouse Status", 0, 1: Clk = 0: GOTO NXY
 317: IF x > 157 AND x < 158 + 56 AND y > 284 AND y < 301 THEN Button2 110, 285, 149, 300, 4, "Reboot": CALL ReBoot(1): Clk = 0: GOTO NXY
 318: NXY:
 319: PutBack
 320: PutMouse 0
 321: PSET (Ox, Oy), Oc
 322: END SUB
 323: 
 324: SUB PutBack
 325: 'KEY(11) OFF: KEY(12) OFF: KEY(13) OFF: KEY(14) OFF
 326: PPX = Msx: PPY = Msy
 327: Ox = POINT(0): Oy = POINT(1): Oc = POINT(Ox, Oy)
 328: PUT (PPX, PPY), Mouse, PSET
 329: PSET (Ox, Oy), Oc
 330: END SUB
 331: 
 332: SUB PutMouse (nnn)
 333: Ox = POINT(0): Oy = POINT(1): Oc = POINT(Ox, Oy)
 334: n1 = 14: n4 = 8: n2 = 4: n3 = 4: u1 = 2: r1 = 2: l1 = 1: u3 = 3: r2 = 3
 335: IF Msx + 80 > 639 THEN mm = 639 - Msx ELSE mm = 80
 336: IF Msy + 20 > 479 THEN mn = 479 - Msy ELSE mn = 20
 337: IF nnn = 0 THEN GET (Msx, Msy)-(Msx + mm, Msy + mn), Mouse
 338: LINE (Msx, Msy)-(Msx, Msy + n1), 0
 339: LINE (Msx, Msy + n1)-(Msx + n2, Msy + n1 - u3), 0
 340: LINE (Msx + n2, Msy + n1 - u3)-(Msx + n2 + n3, Msy + n1 + n4 - u3), 0
 341: LINE (Msx + n2 + n3, Msy + n1 + n4 - u3)-(Msx + n2 + n3 + r1, Msy + n1 + n4 - u1 - u3), 0
 342: LINE (Msx + n2 + n3 + r1, Msy + n1 + n4 - u1 - u3)-(Msx + n2 + n3 - l1, Msy + n1 - u3), 0
 343: LINE (Msx + n2 + n3 - l1, Msy + n1 - u3)-(Msx + n2 + n3 + r2, Msy + n1 - u3), 0
 344: LINE (Msx + n2 + n3 + r2, Msy + n1 - u3)-(Msx, Msy), 0
 345: PAINT (Msx + 2, Msy + 5), 15, 0
 346: 
 347: 'Print2 Msx + n3 + 2, Msy + n1 / 2 + 5, 0, "Shareware"
 348: PSET (Ox, Oy), Oc
 349: 'KEY(11) ON: KEY(12) ON: KEY(13) ON: KEY(14) ON
 350: END SUB
 351: 
 352: SUB ReBoot (Warm%) STATIC
 353:   IF Warm% THEN                 'if they want a warm boot
 354:     DEF SEG = 0                 'assign the value 1234 Hex
 355:     POKE &H473, &H12            'to address 0000:0473 Hex
 356:     POKE &H472, &H34
 357:   END IF
 358:   DEF SEG = &HFFFF              'either way call the BIOS
 359:   CALL Absolute(0)              'routine at FFFF:0000 Hex
 360: END SUB
 361: 
 362: SUB SCapt (f$)
 363: DEF SEG = &HA000
 364: BSAVE f$, 0, 64000
 365: END SUB
 366: 
 367: SUB Sleep2 (t)
 368: a = TIMER
 369: DO UNTIL TIMER >= a + t: LOOP
 370: END SUB
 371: 
 372: SUB SLoad (f$)
 373: DEF SEG = &HA000
 374: BLOAD f$, 0
 375: END SUB
 376: 
 377: FUNCTION Stat$ (num)
 378: IF num > 0 THEN Stat$ = "on"
 379: IF num < 1 THEN Stat$ = "off"
 380: END FUNCTION
 381: 
 382: SUB TextBox (SX, SY, eX, Ey, t$, r, l, pw$, tb$, del, mln)
 383: crln = 1
 384: My = SY
 385: IF LEN(tb$) > l AND r = 1 THEN tb$ = MID$(tb$, 1, l)
 386: w = LEN(tb$)
 387: IF del = 1 THEN ds = 0 ELSE ds = LEN(tb$)
 388: IF LEN(pw$) > 1 THEN pw$ = LEFT$(pw$, 1)
 389: LINE (SX - 1, SY - 1)-(eX + 1, Ey + 1), 0, B
 390: LINE (SX, SY)-(eX, Ey), 15, BF
 391: mx$ = "M" + STR$(SX + 2) + "," + STR$(SY + 13)
 392: DRAW "BX" + VARPTR$(mx$)
 393: IF pw$ = "" THEN Font tb$, 0 ELSE Font STRING$(LEN(tb$), pw$), 0
 394: IF r = 1 THEN  ELSE EXIT SUB
 395: 12 a$ = INKEY$
 396: IF a$ = "" GOTO 12
 397: mx$ = "M" + STR$(SX + 2) + "," + STR$(My + 13)
 398: IF a$ = CHR$(8) AND mln = 0 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$, 0: GOTO 12 ELSE Font STRING$(LEN(t$), pw$), 0: GOTO 12
 399: 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) - 8, POINT(1) - 13)-(POINT(0) - 1, POINT(1)), 15, BF: DRAW "BL7": w = w - 1: sss = sss - 1: GOTO 12
 400: IF a$ = CHR$(13) AND mln = 0 OR (mln > 0 AND crln = mln AND a$ = CHR$(13)) THEN EXIT SUB
 401: 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$, 0
 402: IF sss >= l THEN GOTO 12
 403: t$ = t$ + a$: w = w + LEN(a$)
 404: sss = sss + LEN(a$)
 405: B$ = a$
 406: IF pw$ = "" THEN Font B$, 0 ELSE Font pw$, 0
 407: GOTO 12
 408: END SUB
 409: 
 410: SUB TextBx (SX, SY, eX, Ey, t$, r, l, pw$, tb$, del)
 411: IF LEN(tb$) > l AND r = 1 THEN tb$ = MID$(tb$, 1, l)
 412: t$ = tb$: w = LEN(tb$)
 413: IF del = 1 THEN ds = 0 ELSE ds = LEN(tb$)
 414: IF LEN(pw$) > 1 THEN pw$ = LEFT$(pw$, 1)
 415: LINE (SX - 1, SY - 1)-(eX + 1, Ey + 1), 0, B
 416: LINE (SX, SY)-(eX, Ey), 15, BF
 417: mx$ = "M" + STR$(SX + 2) + "," + STR$(Ey - 0)
 418: DRAW "BX" + VARPTR$(mx$)
 419: IF pw$ = "" THEN Font tb$, 0 ELSE Font STRING$(LEN(tb$), pw$), 0
 420: IF r = 1 THEN  ELSE EXIT SUB
 421: 21 a$ = INKEY$
 422: IF a$ = "" GOTO 21
 423: IF a$ = CHR$(8) THEN IF LEN(t$) - ds = 0 THEN GOTO 21 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$, 0: GOTO 21 ELSE Font STRING$(LEN(t$), pw$), 0:
 424: IF a$ = CHR$(13) THEN EXIT SUB
 425: IF w >= l THEN GOTO 21
 426: t$ = t$ + a$: w = w + LEN(a$)
 427: B$ = a$
 428: IF pw$ = "" THEN Font B$, 0 ELSE Font pw$, 0
 429: GOTO 21
 430: END SUB
 431: 
 432: FUNCTION TRIM$ (t$)
 433: TRIM$ = LTRIM$(RTRIM$(t$))
 434: END FUNCTION
 435: 
 436: SUB UnLoadFont
 437: FOR q = 0 TO 255
 438: txt(q) = ""
 439: NEXT q
 440: END SUB
 441: 
 442: SUB Window2 (Length, Height, Row, Column, tt$, Nm$)
 443: PutBack
 444: OPEN "WINDOWS.POS" FOR BINARY AS #1: ffff = LOF(1): CLOSE 1
 445: IF ffff = 0 THEN OPEN "WINDOWS.POS" FOR OUTPUT AS #1 ELSE OPEN "WINDOWS.POS" FOR APPEND AS #1
 446: PRINT #1, Nm$ + " " + TRIM$(STR$(Row)) + " " + TRIM$(STR$(Column)) + " " + TRIM$(STR$(Row + Height)) + " " + TRIM$(STR$(Column + Length))
 447: CLOSE 1
 448: Wxyz(1) = Row
 449: Wxyz(2) = Column
 450: Wxyz(3) = Row + Height
 451: Wxyz(4) = Column + Length
 452: LINE (Column, Row)-(Column + Length, Row + Height), 0, B
 453: FOR i% = 1 TO 2
 454: Row = Row + 1: Column = Column + 1: Height = Height - 1: Length = Length - 1
 455: LINE (Column, Row)-(Column + Length, Row), 7
 456: LINE (Column, Row)-(Column, Row + Height), 7
 457: NEXT i%
 458: Row = Row + 1: Column = Column + 1: Height = Height - 1: Length = Length - 1
 459: LINE (Column, Row)-(Column + Length, Row), 0
 460: LINE (Column, Row)-(Column, Row + Height), 0
 461: LINE (Column, Row)-(Column + 18, Row + 18), 7, BF
 462: LINE (Column, Row)-(Column + 18, Row + 18), 0, B
 463: LINE (Column + 18, Row - 2)-(Column + 18, Row + 5), 0
 464: LINE (Column - 2, Row + 18)-(Column + 5, Row + 18), 0
 465: LINE (Column + 5, Row + 7)-(Column + 13, Row + 9), 15, BF: LINE (Column + 5, Row + 7)-(Column + 13, Row + 9), 0, B
 466: LINE (Column + 14, Row + 7)-(Column + 14, Row + 9), 8
 467: LINE (Column + 6, Row + 10)-(Column + 14, Row + 10), 8, B
 468: LINE (Column + 18, Row)-(Column + Length, Row + 18), 9, BF
 469: LINE (Column + 18, Row)-(Column + Length, Row + 18), 0, B
 470: LINE (Column + Length, Row - 3)-(Column + Length + 2, Row + Height), 7, BF
 471: LINE (Column + Length, Row - 3)-(Column + Length + 3, Row + Height), 0, B
 472: LINE (Column + Length, Row - 2)-(Column + Length, Row - 1), 7
 473: LINE (Column + Length - 18, Row - 2)-(Column + Length - 18, Row - 1), 0
 474: LINE (Column + Length, Row + 18)-(Column + Length + 2, Row + 18), 0
 475: LINE (Column, Row + Height - 3)-(Column + Length, Row + Height - 3), 0, B
 476: LINE (Column, Row + Height - 2)-(Column + Length + 2, Row + Height), 7, BF
 477: LINE (Column - 2, Row + Height)-(Column + Length + 2, Row + Height), 0, B
 478: LINE (Column - 2, Row + Height - 18)-(Column, Row + Height - 18), 0
 479: LINE (Column + Length - 2, Row + Height - 18)-(Column + Length + 2, Row + Height - 18), 0
 480: LINE (Column + 18, Row + Height)-(Column + 18, Row + Height - 2), 0
 481: LINE (Column + Length - 18, Row + Height)-(Column + Length - 18, Row + Height - 2), 0
 482: LINE (Column + 1, Row + 19)-(Column + Length - 1, Row + Height - 4), 7, BF
 483: mm$ = "BM" + RTRIM$(LTRIM$(STR$(Column + 20))) + "," + LTRIM$(RTRIM$(STR$(Row + 17)))
 484: DRAW "X" + VARPTR$(mm$)
 485: Font tt$, 0
 486: 'PutMouse 0
 487: END SUB
 488: 
5748393 [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:17