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