5748478 [rkeene@sledge /home/rkeene/devel/archive/quickbasic]$ cat -n thngy.bas
   1: DECLARE SUB LoadFont (f$)
   2: DECLARE SUB BackGround (a!)
   3: DECLARE SUB MsgBox (ms$, Tit$)
   4: DECLARE SUB InputBox (x!, y!, t$, Prm$)
   5: DECLARE SUB Window2 (Length!, Height!, Row!, Column!, tt$)
   6: DECLARE SUB Print2 (x!, y!, cv!, t$)
   7: DECLARE SUB UnLoadFont ()
   8: DECLARE SUB opencom ()
   9: DECLARE SUB connect ()
  10: DECLARE SUB Font (t$, cl!)
  11: DECLARE SUB TextBx (SX!, SY!, eX!, Ey!, t$, r!, l!, pw$, tb$, del!)
  12: DECLARE SUB Button2 (x1!, y1!, x2!, y2!, p!, t$)
  13: DECLARE SUB SLEEP2 (t!)
  14: DECLARE SUB SCapt (f$)
  15: DECLARE SUB SLoad (f$)
  16: DIM SHARED txt(255) AS STRING
  17: DIM SHARED C
  18: DIM SHARED Wxyz(4)
  19: ON com1 GOSUB Com1x
  20: 'KEY 15, CHR$(0) + CHR$(55)
  21: 'ON KEY(1) GOSUB Capt: KEY(1) ON
  22: 'ON KEY(2) GOSUB Load: KEY(2) ON
  23: SCREEN 12
  24: CLS
  25: LoadFont "C:\ASCIn.FNT"
  26: BackGround 3
  27: MsgBox "Pranker v1.1", ":-)"
  28: Window2 200, 200, 10, 10, "Status"
  29: 2 InputBox 50, 50, nm$, "Enter number to dial"
  30: IF RTRIM$(LTRIM$(STR$(VAL(nm$)))) = RTRIM$(LTRIM$(nm$)) THEN  ELSE GOTO 2
  31: 21 InputBox 50, 50, As$, "Times to call?"
  32: IF RTRIM$(LTRIM$(STR$(VAL(As$)))) = RTRIM$(LTRIM$(As$)) THEN  ELSE GOTO 21
  33: Print2 -4, -4, 0, "Calling       :" + nm$
  34: Print2 -4, -4, 0, "Times to Call :" + As$
  35: Print2 -4, -4, 0, "Com Port      :1"
  36: opencom
  37: FOR q = 1 TO VAL(As$)
  38: PRINT #1, "ATDT" + nm$
  39: 
  40: NEXT q
  41: UnLoadFont
  42: END
  43: 
  44: Capt:
  45: SCapt "Win1.BSV"
  46: RETURN
  47: 
  48: Load:
  49: SLoad "Win1.BSV"
  50: RETURN
  51: 
  52: Com1x:
  53: x$ = INPUT$(1, 1)
  54: PRINT x$;
  55: RETURN
  56: 
  57: SUB BackGround (a)
  58: C = a
  59: LINE (0, 0)-(640, 480), a, BF
  60: END SUB
  61: 
  62: SUB Button1 (x, y, s, p, tle$)
  63: IF p = 0 THEN clr1 = 15: clr2 = 8 ELSE clr1 = 8: clr2 = 15
  64: eX = x + s: Ey = y + s
  65: LINE (x, y)-(eX, Ey), 1, BF
  66: LINE (x, y)-(eX, Ey), 0, B
  67: LINE (x + 5, y + 5)-(eX - 5, Ey - 5), 1, BF
  68: LINE (x + 4, y + 4)-(eX - 4, Ey - 4), 0, B
  69: LINE (x, Ey)-(x + 4, Ey - 4), 0
  70: LINE (eX, y)-(eX - 4, y + 4), 0
  71: PAINT (x + 1, y + 1), clr1, 0
  72: PAINT (eX - 1, Ey - 1), clr2, 0
  73: END SUB
  74: 
  75: SUB Button2 (x1, y1, x2, y2, p, t$)
  76: IF p = 1 THEN q = 1: GOTO PUSHED
  77: LINE (x1, y1)-(x1, y2 - 1), 15
  78: LINE (x1, y1)-(x2 - 1, y1), 15
  79: LINE (x2 - 1, y1 + 1)-(x2 - 1, y2 - 1), 8
  80: LINE (x2 - 1, y2 - 1)-(x1 + 1, y2 - 1), 8
  81: LINE (x1, y2)-(x2, y2), 0
  82: LINE (x2, y2)-(x2, y1), 0
  83: LINE (x1 + 1, y1 + 1)-(x2 - 2, y2 - 2), 7, BF
  84: 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
  85: PUSHED:
  86: LINE (x1, y1)-(x1, y2), 0
  87: LINE (x1, y1)-(x2, y1), 0
  88: LINE (x1 + 1, y1 + 1)-(x1 + 1, y2 - 1), 8
  89: LINE (x1 + 1, y1 + 1)-(x2 - 1, y1 + 1), 8
  90: LINE (x1 + 1, y2)-(x2, y2), 15
  91: LINE (x2, y2)-(x2, y1 + 1), 15
  92: LINE (x1 + 2, y1 + 2)-(x2 - 1, y2 - 1), 7, BF
  93: ssd:
  94: IF LEN(t$) * 8 > x2 - x1 THEN EXIT SUB
  95: wdt = x2 - x1
  96: Print2 INT((wdt / 2) - ((LEN(t$) / 2) * 8) + x1), y1 + 14 + q, 0, t$
  97: IF p = 3 THEN SLEEP2 .13
  98: END SUB
  99: 
 100: SUB CheckBox (x1, y1, cc, t$, cl)
 101: x2 = x1 + 10
 102: y2 = y1 + 10
 103: LINE (x1, y1)-(x2, y2), cl, B
 104: m$ = "BM" + LTRIM$(RTRIM$(STR$(x1))) + "," + LTRIM$(RTRIM$(STR$(y1))) + "C" + LTRIM$(RTRIM$(STR$(cl))): DRAW "X" + VARPTR$(m$)
 105: IF cc = 1 THEN DRAW "F9BH9BR10G9"
 106: Print2 x2 + 5, y2 + 2, cl, t$
 107: END SUB
 108: 
 109: SUB connect
 110: 'Window2 639,479,0,0,"Terminal Emulation
 111: a = 20: a = a + 17
 112: Print2 10, a, 0, "Start Typing when modems connect... Press <Esc> to hang up:"
 113: a = a + 17: Print2 10, a, 0, ""
 114: DO UNTIL ch$ = CHR$(27)
 115: ch$ = INKEY$
 116: IF ch$ <> "" THEN PRINT #1, ch$;
 117: IF LOC(1) <> 0 THEN inchar$ = INPUT$(1, #1) ELSE inchar$ = ""
 118: IF inchar$ = CHR$(8) AND POS(0) <> 1 THEN
 119: LOCATE , POS(0) - 1
 120: PRINT " ";
 121: LOCATE , POS(0) - 1
 122: ELSEIF inchar$ = CHR$(8) AND POS(0) = 1 AND CSRLIN <> 1 THEN
 123: LOCATE CSRLIN - 1, 80
 124: PRINT " ";
 125: LOCATE , POS(0) - 1
 126: 'ELSEIF inchar$ = CHR$(8) THEN
 127: END IF
 128: IF inchar$ = CHR$(13) THEN a = a + 17: Print2 10, a, 0, "" ELSE Print2 -1, -1, 0, inchar$
 129: IF inchar$ = CHR$(1) THEN END
 130: LOOP
 131: FOR r = 1 TO 5
 132: PRINT #1, "ATH"
 133: NEXT r
 134: PRINT #1, "ATS0=0"
 135: CLOSE #1
 136: END SUB
 137: 
 138: SUB Font (t$, cl)
 139: IF cl = -1 THEN  ELSE f$ = "C" + LTRIM$(RTRIM$(STR$(cl))): DRAW "X" + VARPTR$(f$)
 140: IF txt(32) = "" THEN LOCATE 1, 1: PRINT "System Error. Unable to continue.": END
 141: FOR qww = 1 TO LEN(t$)
 142: 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
 143: 1011 NEXT qww
 144: END SUB
 145: 
 146: SUB InputBox (x, y, t$, Prm$)
 147: Z = 90
 148: s = 50
 149: DIM back(1 TO 9998)
 150: GET (x, y)-(x + 100 + Z, y + 50 + Z), back
 151: LINE (x, y)-(x + 100 + Z, y + 50 + Z), 0, BF
 152: LINE (x + 2, y + 2)-(x + 98 + Z, y + 48 + Z), 1, BF
 153: LINE (x + 10, y + 10)-(x + 90 + Z, y + 40 + Z), 0, BF
 154: LINE (x + 12, y + 12)-(x + 88 + Z, y + 38 + Z), 7, BF
 155: Xy = x + 15
 156: yX = y + 67 - s + Z
 157: Xx = x + 85 + Z
 158: yY = y + 82 - s + Z
 159: Xyz$ = "BM" + STR$(x + 14) + "," + STR$(y + 25)
 160: DRAW "X" + VARPTR$(Xyz$)
 161: Font Prm$, 0
 162: TextBx Xy, yX, Xx, yY, t$, 1, 17, "", "", 0
 163: PUT (x, y), back, PSET
 164: END SUB
 165: 
 166: SUB LoadFont (f$)
 167: OPEN f$ FOR INPUT AS #1: t = 0
 168: DO UNTIL EOF(1)
 169: LINE INPUT #1, a$
 170: txt(t) = a$
 171: t = t + 1
 172: LOOP
 173: CLOSE 1
 174: END SUB
 175: 
 176: SUB MsgBox (ms$, Tit$)
 177: wt$ = "Ok"
 178: s = 17
 179: v = 15
 180: s = s + v
 181: FOR w = 1 TO LEN(ms$): l = l + 1: IF MID$(ms$, w, 1) = CHR$(13) THEN s = s + v
 182: NEXT w
 183: IF LEN(Tit$) >= LEN(ms$) THEN pix = INT(LEN(Tit$) * 8.2) ELSE pix = INT(LEN(ms$) * 8.2)
 184: IF INT(LEN(wt$) * 8.2) > pix THEN pix = INT(LEN(" (Press ENTER to continue.)") * 8.2)
 185: x = 320 - INT(pix / 2)
 186: y = 175 - s
 187: DIM back(1 TO 9998)
 188: GET (x, y)-(x + pix, y + s + v), back
 189: LINE (x + 1, y + 1)-(x + pix - 1, y + v), 1, BF
 190: m$ = "BM" + RTRIM$(LTRIM$(STR$(x + 5))) + ", " + RTRIM$(LTRIM$(STR$(y + v + 1)))
 191: DRAW "X" + VARPTR$(m$)
 192: Font Tit$, 15
 193: LINE (x, y)-(x + pix, y + s + v), 0, B
 194: LINE (x, y + v)-(x + pix, y + s + v), 0, B
 195: LINE (x + 1, y + v + 1)-(x + pix - 1, y + s + v - 1), 7, BF
 196: m$ = "BM" + RTRIM$(LTRIM$(STR$(x + 2))) + ", " + RTRIM$(LTRIM$(STR$(y + v + v + 1)))
 197: DRAW "X" + VARPTR$(m$)
 198: j = y
 199: FOR a = 1 TO LEN(ms$)
 200: 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$)
 201: Font MID$(ms$, a, 1), 0
 202: NEXT a
 203: 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$)
 204: 'Font wt$
 205: d = INT(x + (pix / 2) + (LEN(wt$) / 2) - 30)
 206: j = INT(j + v + v + 1)
 207: m = 117
 208: n = -107
 209: Button2 j - n, d - m, j + 35 - n, d + 14 - m, 3, wt$
 210: PUT (x, y), back, PSET
 211: END SUB
 212: 
 213: SUB opencom
 214: OPEN "Com1,N,8,1" FOR RANDOM AS #1 LEN = 4800
 215: END SUB
 216: 
 217: SUB Print2 (x, y, cv, t$)
 218: IF x = -1 AND y = -1 THEN d$ = "C" + LTRIM$(RTRIM$(STR$(cv))): GOTO 3
 219: IF x = -2 THEN x = (POS(0) * 8) - 7: g = -2
 220: IF y = -2 THEN y = CSRLIN * 16: n = -2
 221: IF x = -4 THEN x = -3: mm = 11
 222: IF y = -4 THEN y = -3: nm = 11
 223: IF x = -3 THEN x = Wxyz(2) + 7
 224: IF y = -3 THEN y = Wxyz(1) + 35
 225: 
 226: d$ = "BM" + LTRIM$(RTRIM$(STR$(x))) + "," + LTRIM$(RTRIM$(STR$(y))) + " C" + LTRIM$(RTRIM$(STR$(cv)))
 227: 3 DRAW "X" + VARPTR$(d$)
 228: Font t$, cv
 229: IF g = -2 THEN LOCATE CSRLIN, POS(0) + LEN(t$)
 230: IF n = -2 THEN LOCATE CSRLIN + 1, 1
 231: IF nm = 11 AND mm = 11 THEN Wxyz(1) = Wxyz(1) + 16
 232: END SUB
 233: 
 234: SUB SCapt (f$)
 235: DEF SEG = &HA000
 236: BSAVE f$, 0, 64000
 237: END SUB
 238: 
 239: SUB setmodemoption
 240: COLOR 2
 241: InputBox 70, 70, portno$, "COM(1 or 2): "
 242: InputBox 70, 70, speed$, "Modem Speed: "
 243: comport$ = "COM" + portno$ + ":" + speed$
 244: OPEN "BASTerm.CFG" FOR OUTPUT AS #2
 245: PRINT #2, comport$
 246: CLOSE #2
 247: END SUB
 248: 
 249: SUB SLEEP2 (t)
 250: a = TIMER
 251: DO UNTIL TIMER >= a + t: LOOP
 252: END SUB
 253: 
 254: SUB SLoad (f$)
 255: DEF SEG = &HA000
 256: BLOAD f$, 0
 257: END SUB
 258: 
 259: SUB TextBx (SX, SY, eX, Ey, t$, r, l, pw$, tb$, del)
 260: IF LEN(tb$) > l AND r = 1 THEN tb$ = MID$(tb$, 1, l)
 261: t$ = tb$: w = LEN(tb$)
 262: IF del = 1 THEN ds = 0 ELSE ds = LEN(tb$)
 263: IF LEN(pw$) > 1 THEN pw$ = LEFT$(pw$, 1)
 264: LINE (SX - 1, SY - 1)-(eX + 1, Ey + 1), 0, B
 265: LINE (SX, SY)-(eX, Ey), 15, BF
 266: MX$ = "M" + STR$(SX + 2) + "," + STR$(Ey - 0)
 267: DRAW "BX" + VARPTR$(MX$)
 268: IF pw$ = "" THEN Font tb$, 0 ELSE Font STRING$(LEN(tb$), pw$), 0
 269: IF r = 1 THEN  ELSE EXIT SUB
 270: 12 a$ = INKEY$
 271: IF a$ = "" GOTO 12
 272: 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$, 0: GOTO 12 ELSE Font STRING$(LEN(t$), pw$), 0: GOTO 12
 273: IF a$ = CHR$(13) THEN EXIT SUB
 274: IF w >= l THEN GOTO 12
 275: t$ = t$ + a$: w = w + LEN(a$)
 276: B$ = a$
 277: IF pw$ = "" THEN Font B$, 0 ELSE Font pw$, 0
 278: GOTO 12
 279: END SUB
 280: 
 281: SUB UnLoadFont
 282: FOR q = 0 TO 255
 283: txt(q) = ""
 284: NEXT q
 285: END SUB
 286: 
 287: SUB waitforcall
 288: CLS : BackGround C
 289: Window2 630, 470, 0, 0, "Terminal Emulation"
 290: COLOR 3
 291: opencom
 292: PRINT #1, "ATS0=1"
 293: connect
 294: END SUB
 295: 
 296: SUB Window2 (Length, Height, Row, Column, tt$)
 297: Wxyz(1) = Row
 298: Wxyz(2) = Column
 299: Wxyz(3) = Row + Height
 300: Wxyz(4) = Column + Length
 301: LINE (Column, Row)-(Column + Length, Row + Height), 0, B
 302: FOR i% = 1 TO 2
 303: Row = Row + 1: Column = Column + 1: Height = Height - 1: Length = Length - 1
 304: LINE (Column, Row)-(Column + Length, Row), 7
 305: LINE (Column, Row)-(Column, Row + Height), 7
 306: NEXT i%
 307: Row = Row + 1: Column = Column + 1: Height = Height - 1: Length = Length - 1
 308: LINE (Column, Row)-(Column + Length, Row), 0
 309: LINE (Column, Row)-(Column, Row + Height), 0
 310: LINE (Column, Row)-(Column + 18, Row + 18), 7, BF
 311: LINE (Column, Row)-(Column + 18, Row + 18), 0, B
 312: LINE (Column + 18, Row - 2)-(Column + 18, Row + 5), 0
 313: LINE (Column - 2, Row + 18)-(Column + 5, Row + 18), 0
 314: LINE (Column + 5, Row + 7)-(Column + 13, Row + 9), 15, BF: LINE (Column + 5, Row + 7)-(Column + 13, Row + 9), 0, B
 315: LINE (Column + 14, Row + 7)-(Column + 14, Row + 9), 8
 316: LINE (Column + 6, Row + 10)-(Column + 14, Row + 10), 8, B
 317: LINE (Column + 18, Row)-(Column + Length, Row + 18), 9, BF
 318: LINE (Column + 18, Row)-(Column + Length, Row + 18), 0, B
 319: LINE (Column + Length, Row - 3)-(Column + Length + 2, Row + Height), 7, BF
 320: LINE (Column + Length, Row - 3)-(Column + Length + 3, Row + Height), 0, B
 321: LINE (Column + Length, Row - 2)-(Column + Length, Row - 1), 7
 322: LINE (Column + Length - 18, Row - 2)-(Column + Length - 18, Row - 1), 0
 323: LINE (Column + Length, Row + 18)-(Column + Length + 2, Row + 18), 0
 324: LINE (Column, Row + Height - 3)-(Column + Length, Row + Height - 3), 0, B
 325: LINE (Column, Row + Height - 2)-(Column + Length + 2, Row + Height), 7, BF
 326: LINE (Column - 2, Row + Height)-(Column + Length + 2, Row + Height), 0, B
 327: LINE (Column - 2, Row + Height - 18)-(Column, Row + Height - 18), 0
 328: LINE (Column + Length - 2, Row + Height - 18)-(Column + Length + 2, Row + Height - 18), 0
 329: LINE (Column + 18, Row + Height)-(Column + 18, Row + Height - 2), 0
 330: LINE (Column + Length - 18, Row + Height)-(Column + Length - 18, Row + Height - 2), 0
 331: LINE (Column + 1, Row + 19)-(Column + Length - 1, Row + Height - 4), 7, BF
 332: mm$ = "BM" + RTRIM$(LTRIM$(STR$(Column + 20))) + "," + LTRIM$(RTRIM$(STR$(Row + 17)))
 333: DRAW "X" + VARPTR$(mm$)
 334: Font tt$, 0
 335: END SUB
 336: 
5748479 [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:10:09