5748362 [rkeene@sledge /home/rkeene/devel/archive/quickbasic]$ cat -n mswndow8.bas
   1: DECLARE SUB Inputbox (X!, y!, T$, prm$)
   2: DECLARE SUB Win (X!, y!, eX!, Ey!, q!)
   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 Dont have text -
   7: 'Background Color selector +
   8: 
   9: 
  10: 
  11: 
  12: 
  13: 
  14: DECLARE SUB LoadFont (f$)
  15: DECLARE SUB Font (T$)
  16: DECLARE SUB BackGround (C!)
  17: DECLARE SUB Sleep2 (T!)
  18: DECLARE SUB Window2 (length!, height!, row!, column!)
  19: DECLARE SUB Textbx (SX!, SY!, eX!, Ey!, T$, r!, l!, pw$, tb$, del)
  20: DECLARE SUB Button1 (X!, y!, S!, P!, tle$)
  21: DIM SHARED Txt(255) AS STRING
  22: DIM SHARED Wind(1 TO 16384)
  23: SCREEN 12
  24: LoadFont "C:\ROY1.FNT"
  25: '            ³
  26: '          Fontspec
  27: '
  28: ' Fontspec - Font drive:path\filename (e.g. C:\Font1.Fnt or Font1.Fnt )
  29: '+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
  30: BackGround 1
  31: '          ³
  32: '         Color
  33: '
  34: ' Color - Color of Background
  35: '+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
  36: 
  37: Window2 350, 426, 10, 20
  38: '        ³    ³    ³  ÀÄÄÄ¿
  39: '        ³    ³    ÀÄÄÄ¿  ÀÄÄÄÄ¿
  40: '    Length  Height  StartX  StartY
  41: '
  42: ' Length - How long (left to right) the window is
  43: ' Heigth - How tall (up and down) the window is
  44: ' StartX - Starting X position (pixels down from top)
  45: ' StartY - Starting Y position (pixels right of top)
  46: '
  47: '+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
  48: '
  49: Textbx 40, 40, 290, 55, Txt$, 0, 1, "", "NOTHING", 1
  50: '       ³   ³   ³    ³    ³   ³  ³   ³      ³      ÀÄÄÄÄ¿
  51: '       ³   ³   ³    ³    ³   ³  ³   ÀÄÄ¿   ÀÄÄÄÄÄÄÄÄÄ¿ ³
  52: '       ³   ³   ³    ÀÄÄÄ¿ÀÄÄ¿ÀÄ¿ÀÄÄÄÄÄ¿ÀÄÄÄÄÄÄÄÄÄÄÄÄ¿³ ÀÄÄÄÄÄÄÄÄ¿
  53: '       ³   ÀÄ¿ ÀÄÄÄÄÄ¿  ÀÄÄ¿ÀÄ¿ÀÄÄÄÄÄ¿ÀÄÄÄÄ¿        ³ÀÄÄÄÄÄÄÄÄ¿ ÀÄÄÄÄÄ¿
  54: '   StartX  StartY  EndX  EndY Text  Read  Max_Len Pass_Char TextBx  Overite
  55: '
  56: ' StartX    - Starting X position (pixels down from top)
  57: ' StartY    - Starting Y position (pixels right of top)
  58: ' EndX      - Ending X position (pixels down from top)
  59: ' EndY      - Ending Y position (pixels right of top)
  60: ' Text      - Text read from box
  61: ' Read      - Read text from box (1 to read,0 to just put box)
  62: ' Max_Len.  - Maximum length of text
  63: ' Pass_Char - Charectar to replace typed text ("" for normal text)
  64: ' TextBx    - Text to be in box
  65: ' Overrite  - Can the user overrite TextBx (1 = yes 0 = no)
  66: '
  67: '+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
  68: Button1 50, 100, 56, 0, "   G"
  69: '        ³   ³    ³  ÀÄÄÄ¿  ÀÄÄ¿
  70: '        ³   ÀÄ¿  ÀÄÄÄÄÄ¿ÀÄÄ¿  ÀÄ¿
  71: '     StartY  StartX  Size Press Title
  72: '
  73: ' StartX - Starting X position (pixels down from top)
  74: ' StartY - Starting Y position (pixels right of top)
  75: ' Size   - Size Of Button
  76: ' Press  - 1 or 0 (1 if pressed ,0 if not pressed)
  77: ' Title  - Text on Button
  78: '+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
  79: DO UNTIL INKEY$ = CHR$(13)
  80: Sleep2 .3
  81: Button1 50, 100, 56, 1, "   G"
  82: Sleep2 .3
  83: Button1 50, 100, 56, 0, "   G"
  84: LOOP
  85: 32 Textbx 40, 40, 290, 55, T$, 1, 16, "#", "ROY ", 0
  86: Textbx 40, 60, 290, 75, T$, 1, 16, "", "ROY ", 1
  87: Inputbox 10, 10, "d", "D"
  88: Win 10, 20, 370, 436, 1
  89: 
  90: SUB BackGround (C)
  91: LINE (-1, -1)-(640, 480), C, BF
  92: END SUB
  93: 
  94: SUB Button1 (X, y, S, P, tle$)
  95: IF P = 0 THEN clr1 = 15: clr2 = 8 ELSE clr1 = 8: clr2 = 15
  96: eX = X + S: Ey = y + S
  97: LINE (X, y)-(eX, Ey), 7, BF
  98: LINE (X, y)-(eX, Ey), 0, B
  99: LINE (X + 5, y + 5)-(eX - 5, Ey - 5), 7, BF
 100: LINE (X + 4, y + 4)-(eX - 4, Ey - 4), 0, B
 101: LINE (X, Ey)-(X + 4, Ey - 4), 0
 102: LINE (eX, y)-(eX - 4, y + 4), 0
 103: PAINT (X + 1, y + 1), clr1, 0
 104: PAINT (eX - 1, Ey - 1), clr2, 0
 105: END SUB
 106: 
 107: SUB Font (T$)
 108: DRAW "C0"
 109: FOR qww = 1 TO LEN(T$)
 110: DRAW "X" + VARPTR$(Txt(ASC(MID$(T$, qww, 1)))): GOTO 1011
 111: DRAW "C0BRE8G4L4R8L4H4F8H4E4G8E4U4D8BR6"
 112: 1011 NEXT qww
 113: END SUB
 114: 
 115: SUB Inputbox (X, y, T$, prm$)
 116: Z = 100
 117: DIM Back(1 TO 9999)
 118: GET (X, y)-(X + 100 + Z, y + 100 + Z), Back
 119: LINE (X, y)-(X + 100 + Z, y + 100 + Z), 0, BF
 120: LINE (X + 2, y + 2)-(X + 98 + Z, y + 98 + Z), 1, BF
 121: LINE (X + 10, y + 10)-(X + 90 + Z, y + 90 + Z), 0, BF
 122: LINE (X + 12, y + 12)-(X + 88 + Z, y + 88 + Z), 7, BF
 123: Xy = X + 18
 124: yX = y + 67 + Z
 125: Xx = X + 85 + Z
 126: yY = y + 82 + Z
 127: Textbx Xy, yX, Xx, yY, T$, 1, 14, "", "", 0
 128: PUT (X, y), Back, PSET
 129: END SUB
 130: 
 131: SUB LoadFont (f$)
 132: OPEN f$ FOR INPUT AS #1: T = 0
 133: DO UNTIL EOF(1)
 134: LINE INPUT #1, a$
 135: Txt(T) = a$
 136: T = T + 1
 137: LOOP
 138: END SUB
 139: 
 140: SUB SCapt (FIL$)
 141: OPEN FIL$ FOR OUTPUT AS #1 LEN = 10000
 142: FOR X = 0 TO 639
 143: FOR y = 0 TO 479
 144: vv$ = CHR$(POINT(X, y) + 32)
 145: PRINT #1, vv$; : PSET (X, y), 15
 146: IF INKEY$ = "" THEN  ELSE CLOSE 1: EXIT SUB
 147: NEXT y
 148: NEXT X
 149: CLOSE 1
 150: END SUB
 151: 
 152: SUB Sleep2 (T)
 153: a = TIMER
 154: DO UNTIL TIMER >= a + T: LOOP
 155: 
 156: 
 157: END SUB
 158: 
 159: SUB SLoad (FIL$)
 160: OPEN FIL$ FOR RANDOM AS #1
 161: FOR X = 0 TO 639
 162: FOR y = 0 TO 479
 163: GET #1, y + 1 * (X + 1), clr$
 164: IF INKEY$ = "" THEN  ELSE CLOSE 1: EXIT SUB
 165: IF EOF(1) THEN CLOSE 1: PSET (X, y), clr%: EXIT SUB
 166: PSET (X, y), ASC(clr$) - 32
 167: 10 NEXT y
 168: NEXT X
 169: END SUB
 170: 
 171: SUB Textbx (SX, SY, eX, Ey, T$, r, l, pw$, tb$, del)
 172: IF LEN(tb$) > l AND r = 1 THEN tb$ = MID$(tb$, 1, l)
 173: T$ = tb$: W = LEN(tb$)
 174: IF del = 1 THEN ds = 0 ELSE ds = LEN(tb$)
 175: IF LEN(pw$) > 1 THEN pw$ = LEFT$(pw$, 1)
 176: LINE (SX - 1, SY - 1)-(eX + 1, Ey + 1), 0, B
 177: LINE (SX, SY)-(eX, Ey), 15, BF
 178: MX$ = "M" + STR$(SX + 2) + "," + STR$(Ey - 2)
 179: DRAW "BX" + VARPTR$(MX$)
 180: IF pw$ = "" THEN Font tb$ ELSE Font STRING$(LEN(tb$), pw$)
 181: IF r = 1 THEN  ELSE EXIT SUB
 182: 12 a$ = INKEY$
 183: IF a$ = "" GOTO 12
 184: 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
 185: IF a$ = CHR$(13) THEN EXIT SUB
 186: IF W = l THEN GOTO 12
 187: T$ = T$ + a$: W = W + LEN(a$)
 188: B$ = UCASE$(a$)
 189: IF pw$ = "" THEN Font B$ ELSE Font pw$
 190: GOTO 12
 191: END SUB
 192: 
 193: SUB Win (X, y, eX, Ey, q)
 194: IF q = 1 THEN GET (X, y)-(eX, Ey), Wind ELSE PUT (X, y), Wind, PSET
 195: END SUB
 196: 
 197: SUB Window2 (length, height, row, column)
 198: LINE (column, row)-(column + length, row + height), 0, B
 199: FOR i% = 1 TO 2
 200: row = row + 1: column = column + 1: height = height - 1: length = length - 1
 201: LINE (column, row)-(column + length, row), 7
 202: LINE (column, row)-(column, row + height), 7
 203: NEXT i%
 204: row = row + 1: column = column + 1: height = height - 1: length = length - 1
 205: LINE (column, row)-(column + length, row), 0
 206: LINE (column, row)-(column, row + height), 0
 207: LINE (column, row)-(column + 18, row + 18), 7, BF
 208: LINE (column, row)-(column + 18, row + 18), 0, B
 209: LINE (column + 18, row - 2)-(column + 18, row + 5), 0
 210: LINE (column - 2, row + 18)-(column + 5, row + 18), 0
 211: LINE (column + 5, row + 7)-(column + 13, row + 9), 15, BF: LINE (column + 5, row + 7)-(column + 13, row + 9), 0, B
 212: LINE (column + 14, row + 7)-(column + 14, row + 9), 8
 213: LINE (column + 6, row + 10)-(column + 14, row + 10), 8, B
 214: LINE (column + 18, row)-(column + length, row + 18), 9, BF
 215: LINE (column + 18, row)-(column + length, row + 18), 0, B
 216: LINE (column + length, row - 3)-(column + length + 2, row + height), 7, BF
 217: LINE (column + length, row - 3)-(column + length + 3, row + height), 0, B
 218: LINE (column + length, row - 2)-(column + length, row - 1), 7
 219: LINE (column + length - 18, row - 2)-(column + length - 18, row - 1), 0
 220: LINE (column + length, row + 18)-(column + length + 2, row + 18), 0
 221: LINE (column, row + height - 3)-(column + length, row + height - 3), 0, B
 222: LINE (column, row + height - 2)-(column + length + 2, row + height), 7, BF
 223: LINE (column - 2, row + height)-(column + length + 2, row + height), 0, B
 224: LINE (column - 2, row + height - 18)-(column, row + height - 18), 0
 225: LINE (column + length - 2, row + height - 18)-(column + length + 2, row + height - 18), 0
 226: LINE (column + 18, row + height)-(column + 18, row + height - 2), 0
 227: LINE (column + length - 18, row + height)-(column + length - 18, row + height - 2), 0
 228: LINE (column + 1, row + 19)-(column + length - 1, row + height - 4), 7, BF
 229: END SUB
 230: 
5748363 [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:53