5748479 [rkeene@sledge /home/rkeene/devel/archive/quickbasic]$ cat -n mswdow10.bas
   1: DECLARE SUB Print2 (x!, y!, cv!, t$)
   2: '
   3: '  Textbx is very short ,but its very powerful +                           
   4: '  Fonts are made using the letter ASCII charectar code +                  
   5: '  Syntax is explained +                                                   
   6: '  Buttons have text +                                                     
   7: '  Background Color selector +                                             
   8: '  Input boxes +                                                           
   9: '
  10: DECLARE SUB Button2 (x1!, y1!, x2!, y2!, t$, p!)
  11: DECLARE SUB Inputbox (x!, y!, t$, Prm$)
  12: DECLARE SUB Win (x!, y!, eX!, Ey!, q!)
  13: DECLARE SUB LoadFont (f$)
  14: DECLARE SUB Font (t$)
  15: DECLARE SUB Background (C!)
  16: DECLARE SUB SLEEP2 (t!)
  17: DECLARE SUB Window2 (length!, height!, row!, column!)
  18: DECLARE SUB Textbx (SX!, SY!, eX!, Ey!, t$, r!, l!, pw$, tb$, del)
  19: DECLARE SUB Button1 (x!, y!, S!, p!, tle$)
  20: DIM SHARED txt(255) AS STRING
  21: DIM SHARED Wind(1 TO 16384)
  22: SCREEN 12
  23: DEF SEG = 0
  24: POKE &H417, (160 XOR &H40)
  25: LoadFont "C:\ASCIN.FNT"
  26: '            ³
  27: '          Fontspec
  28: '
  29: ' Fontspec - Font drive:path\filename (ex. C:\Font1.Fnt or Font1.Fnt )
  30: '+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
  31: Background 1
  32: '          ³
  33: '         Color
  34: '
  35: ' Color - Color of Background
  36: '+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
  37: 
  38: Window2 300, 426, 10, 20
  39: '        ³    ³    ³  ÀÄÄÄ¿
  40: '        ³    ³    ÀÄÄÄ¿  ÀÄÄÄÄ¿
  41: '    Length  Height  StartX  StartY
  42: '
  43: ' Length - How long (left to right) the window is
  44: ' Heigth - How tall (up and down) the window is
  45: ' StartX - Starting X position (pixels down from top)
  46: ' StartY - Starting Y position (pixels right of top)
  47: '
  48: '+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
  49: '
  50: Textbx 40, 40, 290, 55, txt$, 0, 1, "", "NOTHING", 1
  51: '       ³   ³   ³    ³    ³   ³  ³   ³      ³      ÀÄÄÄÄ¿
  52: '       ³   ³   ³    ³    ³   ³  ³   ÀÄÄ¿   ÀÄÄÄÄÄÄÄÄÄ¿ ³
  53: '       ³   ³   ³    ÀÄÄÄ¿ÀÄÄ¿ÀÄ¿ÀÄÄÄÄÄ¿ÀÄÄÄÄÄÄÄÄÄÄÄÄ¿³ ÀÄÄÄÄÄÄÄÄ¿
  54: '       ³   ÀÄ¿ ÀÄÄÄÄÄ¿  ÀÄÄ¿ÀÄ¿ÀÄÄÄÄÄ¿ÀÄÄÄÄ¿        ³ÀÄÄÄÄÄÄÄÄ¿ ÀÄÄÄÄÄ¿
  55: '   StartX  StartY  EndX  EndY Text  Read  Max_Len Pass_Char TextBx  Overite
  56: '
  57: ' StartX    - Starting X position (pixels down from top)
  58: ' StartY    - Starting Y position (pixels right of top)
  59: ' EndX      - Ending X position (pixels down from top)
  60: ' EndY      - Ending Y position (pixels right of top)
  61: ' Text      - Text read from box
  62: ' Read      - Read text from box (1 to read,0 to just put box)
  63: ' Max_Len.  - Maximum length of text
  64: ' Pass_Char - Charectar to replace typed text ("" for normal text)
  65: ' TextBx    - Text to be in box
  66: ' Overrite  - Can the user overrite TextBx (1 = yes, 0 = no)
  67: '
  68: '+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
  69: 'Button1 50, 100, 56, 0, "   G"
  70: '         ³   ³    ³  ÀÄÄÄ¿  ÀÄÄ¿
  71: '         ³   ÀÄ¿  ÀÄÄÄÄÄ¿ÀÄÄ¿  ÀÄ¿
  72: '      StartY  StartX  Size Press Title
  73: '
  74: ' StartX - Starting X position (pixels down from top)
  75: ' StartY - Starting Y position (pixels right of top)
  76: ' Size   - Size Of Button
  77: ' Press  - 1 or 0 (1 if pressed ,0 if not pressed)
  78: ' Title  - Text on Button
  79: '+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
  80: 'Inputbox 10, 10, Roy$, "TYPE:"
  81: '          ³   ³   ÀÄÄÄÄ¿ ÀÄÄÄÄ¿
  82: '      StartX StartY   Text  Prompt
  83: '
  84: ' StartX - Starting X position (pixels down from top)
  85: ' StartY - Starting Y position (pixels right of top)
  86: ' Text   - Text read from box
  87: ' Prompt - Text in box
  88: '+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
  89: 
  90: '              Syntax explanations               
  91: '
  92: '               Place Program here               
  93: 
  94: DO UNTIL INKEY$ = CHR$(13): SLEEP2 .3: Button2 50, 100, 90, 117, "COOL", 0: SLEEP2 .3: Button2 50, 100, 90, 117, "COOL", 1: LOOP
  95: 
  96: Textbx 40, 40, 290, 55, t$, 1, 27, "@", "ROY ", 0
  97: Textbx 40, 60, 290, 75, t$, 1, 27, "", "ROY ", 1
  98: Inputbox 10, 10, Roy$, "DADA!"
  99: Button2 50, 100, 90, 117, "Ok", 3
 100: FOR q = 1 TO 255: txt(q) = "": NEXT q
 101: 
 102: SUB Background (C)
 103: LINE (-1, -1)-(640, 480), C, BF
 104: END SUB
 105: 
 106: SUB Button1 (x, y, S, p, tle$)
 107: IF p = 0 THEN clr1 = 15: clr2 = 8 ELSE clr1 = 8: clr2 = 15
 108: eX = x + S: Ey = y + S
 109: LINE (x, y)-(eX, Ey), 7, BF
 110: LINE (x, y)-(eX, Ey), 0, B
 111: LINE (x + 5, y + 5)-(eX - 5, Ey - 5), 7, BF
 112: LINE (x + 4, y + 4)-(eX - 4, Ey - 4), 0, B
 113: LINE (x, Ey)-(x + 4, Ey - 4), 0
 114: LINE (eX, y)-(eX - 4, y + 4), 0
 115: PAINT (x + 1, y + 1), clr1, 0
 116: PAINT (eX - 1, Ey - 1), clr2, 0
 117: END SUB
 118: 
 119: SUB Button2 (x1, y1, x2, y2, t$, p)
 120: IF p = 1 THEN q = 1: GOTO PUSHED
 121: LINE (x1, y1)-(x1, y2 - 1), 15
 122: LINE (x1, y1)-(x2 - 1, y1), 15
 123: LINE (x2 - 1, y1 + 1)-(x2 - 1, y2 - 1), 8
 124: LINE (x2 - 1, y2 - 1)-(x1 + 1, y2 - 1), 8
 125: LINE (x1, y2)-(x2, y2), 0
 126: LINE (x2, y2)-(x2, y1), 0
 127: LINE (x1 + 1, y1 + 1)-(x2 - 2, y2 - 2), 7, BF
 128: 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
 129: PUSHED:
 130: LINE (x1, y1)-(x1, y2), 0
 131: LINE (x1, y1)-(x2, y1), 0
 132: LINE (x1 + 1, y1 + 1)-(x1 + 1, y2 - 1), 8
 133: LINE (x1 + 1, y1 + 1)-(x2 - 1, y1 + 1), 8
 134: LINE (x1 + 1, y2)-(x2, y2), 15
 135: LINE (x2, y2)-(x2, y1 + 1), 15
 136: LINE (x1 + 2, y1 + 2)-(x2 - 1, y2 - 1), 7, BF
 137: ssd:
 138: IF LEN(t$) * 8 > x2 - x1 THEN EXIT SUB
 139: wdt = x2 - x1
 140: Print2 INT((wdt / 2) - ((LEN(t$) / 2) * 8) + x1), y1 + 14 + q, 0, t$
 141: IF p = 3 THEN SLEEP2 .13: Button2 x1, y1, x2, y2, t$, 0
 142: END SUB
 143: 
 144: SUB Font (t$)
 145: DRAW "C0"
 146: FOR qww = 1 TO LEN(t$)
 147: DRAW "X" + VARPTR$(txt(ASC(MID$(t$, qww, 1)))): GOTO 1011
 148: 1011 NEXT qww
 149: END SUB
 150: 
 151: SUB Inputbox (x, y, t$, Prm$)
 152: Z = 140
 153: DIM Back(1 TO 9998)
 154: GET (x, y)-(x + 100 + Z, y + 100 + Z), Back
 155: LINE (x, y)-(x + 100 + Z, y + 100 + Z), 0, BF
 156: LINE (x + 2, y + 2)-(x + 98 + Z, y + 98 + Z), 1, BF
 157: LINE (x + 10, y + 10)-(x + 90 + Z, y + 90 + Z), 0, BF
 158: LINE (x + 12, y + 12)-(x + 88 + Z, y + 88 + Z), 7, BF
 159: Xy = x + 15
 160: yX = y + 67 + Z
 161: Xx = x + 85 + Z
 162: yY = y + 82 + Z
 163: Xyz$ = "M" + STR$(x + 13) + "," + STR$(y + 23)
 164: DRAW "X" + VARPTR$(Xyz$)
 165: Font Prm$
 166: Textbx Xy, yX, Xx, yY, t$, 1, 14, "", "", 0
 167: PUT (x, y), Back, PSET
 168: END SUB
 169: 
 170: SUB LoadFont (f$)
 171: OPEN f$ FOR INPUT AS #1: t = 0
 172: DO UNTIL EOF(1)
 173: LINE INPUT #1, a$
 174: txt(t) = a$
 175: t = t + 1
 176: LOOP
 177: END SUB
 178: 
 179: SUB Print2 (x, y, cv, t$)
 180: IF x = -1 AND y = -1 THEN d$ = "C" + LTRIM$(RTRIM$(STR$(cv))): GOTO 3
 181: IF x = -2 THEN x = (POS(0) * 8) - 7: g = -2
 182: IF y = -2 THEN y = CSRLIN * 16: n = -2
 183: d$ = "BM" + LTRIM$(RTRIM$(STR$(x))) + "," + LTRIM$(RTRIM$(STR$(y))) + " C" + LTRIM$(RTRIM$(STR$(cv)))
 184: 3 DRAW "X" + VARPTR$(d$)
 185: Font t$
 186: IF g = -2 THEN LOCATE CSRLIN, POS(0) + LEN(t$)
 187: IF n = -2 THEN LOCATE CSRLIN + 1, 1
 188: END SUB
 189: 
 190: SUB SCapt (FIL$)
 191: OPEN FIL$ FOR OUTPUT AS #1 LEN = 10000
 192: FOR x = 0 TO 639
 193: FOR y = 0 TO 479
 194: vv$ = CHR$(POINT(x, y) + 32)
 195: PRINT #1, vv$; : PSET (x, y), 15
 196: IF INKEY$ = "" THEN  ELSE CLOSE 1: EXIT SUB
 197: NEXT y
 198: NEXT x
 199: CLOSE 1
 200: END SUB
 201: 
 202: SUB SLEEP2 (t)
 203: a = TIMER
 204: DO UNTIL TIMER >= a + t: LOOP
 205: 
 206: 
 207: END SUB
 208: 
 209: SUB SLoad (FIL$)
 210: OPEN FIL$ FOR RANDOM AS #1
 211: FOR x = 0 TO 639
 212: FOR y = 0 TO 479
 213: GET #1, y + 1 * (x + 1), clr$
 214: IF INKEY$ = "" THEN  ELSE CLOSE 1: EXIT SUB
 215: IF EOF(1) THEN CLOSE 1: PSET (x, y), clr%: EXIT SUB
 216: PSET (x, y), ASC(clr$) - 32
 217: 10 NEXT y
 218: NEXT x
 219: END SUB
 220: 
 221: SUB Textbx (SX, SY, eX, Ey, t$, r, l, pw$, tb$, del)
 222: IF LEN(tb$) > l AND r = 1 THEN tb$ = MID$(tb$, 1, l)
 223: t$ = tb$: W = LEN(tb$)
 224: IF del = 1 THEN ds = 0 ELSE ds = LEN(tb$)
 225: IF LEN(pw$) > 1 THEN pw$ = LEFT$(pw$, 1)
 226: LINE (SX - 1, SY - 1)-(eX + 1, Ey + 1), 0, B
 227: LINE (SX, SY)-(eX, Ey), 15, BF
 228: MX$ = "M" + STR$(SX + 2) + "," + STR$(Ey - 2)
 229: DRAW "BX" + VARPTR$(MX$)
 230: IF pw$ = "" THEN Font tb$ ELSE Font STRING$(LEN(tb$), pw$)
 231: IF r = 1 THEN  ELSE EXIT SUB
 232: 12 a$ = INKEY$
 233: IF a$ = "" GOTO 12
 234: 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$): GOTO 12 ELSE Font STRING$(LEN(t$), pw$): GOTO 12
 235: IF a$ = CHR$(13) THEN EXIT SUB
 236: IF W = l THEN GOTO 12
 237: t$ = t$ + a$: W = W + LEN(a$)
 238: B$ = UCASE$(a$)
 239: IF pw$ = "" THEN Font B$ ELSE Font pw$
 240: GOTO 12
 241: END SUB
 242: 
 243: SUB Window2 (length, height, row, column)
 244: LINE (column, row)-(column + length, row + height), 0, B
 245: FOR i% = 1 TO 2
 246: row = row + 1: column = column + 1: height = height - 1: length = length - 1
 247: LINE (column, row)-(column + length, row), 7
 248: LINE (column, row)-(column, row + height), 7
 249: NEXT i%
 250: row = row + 1: column = column + 1: height = height - 1: length = length - 1
 251: LINE (column, row)-(column + length, row), 0
 252: LINE (column, row)-(column, row + height), 0
 253: LINE (column, row)-(column + 18, row + 18), 7, BF
 254: LINE (column, row)-(column + 18, row + 18), 0, B
 255: LINE (column + 18, row - 2)-(column + 18, row + 5), 0
 256: LINE (column - 2, row + 18)-(column + 5, row + 18), 0
 257: LINE (column + 5, row + 7)-(column + 13, row + 9), 15, BF: LINE (column + 5, row + 7)-(column + 13, row + 9), 0, B
 258: LINE (column + 14, row + 7)-(column + 14, row + 9), 8
 259: LINE (column + 6, row + 10)-(column + 14, row + 10), 8, B
 260: LINE (column + 18, row)-(column + length, row + 18), 9, BF
 261: LINE (column + 18, row)-(column + length, row + 18), 0, B
 262: LINE (column + length, row - 3)-(column + length + 2, row + height), 7, BF
 263: LINE (column + length, row - 3)-(column + length + 3, row + height), 0, B
 264: LINE (column + length, row - 2)-(column + length, row - 1), 7
 265: LINE (column + length - 18, row - 2)-(column + length - 18, row - 1), 0
 266: LINE (column + length, row + 18)-(column + length + 2, row + 18), 0
 267: LINE (column, row + height - 3)-(column + length, row + height - 3), 0, B
 268: LINE (column, row + height - 2)-(column + length + 2, row + height), 7, BF
 269: LINE (column - 2, row + height)-(column + length + 2, row + height), 0, B
 270: LINE (column - 2, row + height - 18)-(column, row + height - 18), 0
 271: LINE (column + length - 2, row + height - 18)-(column + length + 2, row + height - 18), 0
 272: LINE (column + 18, row + height)-(column + 18, row + height - 2), 0
 273: LINE (column + length - 18, row + height)-(column + length - 18, row + height - 2), 0
 274: LINE (column + 1, row + 19)-(column + length - 1, row + height - 4), 7, BF
 275: END SUB
 276: 
5748480 [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:05:36