5748367 [rkeene@sledge /home/rkeene/devel/archive/quickbasic]$ cat -n mswndow6.bas
   1: DECLARE SUB Font (T$)
   2: DECLARE SUB BackGround (C!)
   3: DECLARE SUB Sleep2 (T!)
   4: DECLARE SUB Window2 (length!, height!, row!, column!)
   5: DECLARE SUB Textbx (SX!, SY!, EX!, EY!, T$, r!, l!, PW$)
   6: DECLARE SUB Button1 (X!, Y!, S!, P!, tle$)
   7: SCREEN 12
   8: 
   9: BackGround 1
  10: '          ³
  11: '         Color
  12: '
  13: ' Color - Color of Background
  14: '+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
  15: 
  16: Window2 350, 426, 10, 20
  17: '        ³    ³    ³  ÀÄÄÄ¿
  18: '        ³    ³    ÀÄÄÄ¿  ÀÄÄÄÄ¿
  19: '    Length  Height  StartX  StartY
  20: '
  21: ' Length - How long (left to right) the window is
  22: ' Heigth - How tall (up and down) the window is
  23: ' StartX - Starting X position (pixels down from top)
  24: ' StartY - Starting Y position (pixels right of top)
  25: '
  26: '+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
  27: Textbx 40, 40, 290, 55, Txt$, 0, 0, ""'®ÄÄÄÄ¿
  28: '       ³   ³   ³    ÀÄÄÄ¿ÀÄÄ¿ÀÄ¿ÀÄÄÄÄÄÄÄÄ¿ ÀÄÄÄÄ¿
  29: '       ³   ÀÄ¿ ÀÄÄÄÄÄ¿  ÀÄÄ¿ÀÄ¿ÀÄÄÄÄÄ¿   ÀÄÄ¿   ÀÄÄÄÄ¿
  30: '   StartX  StartY  EndX  EndY Text  Read  Max Len. Pass Char
  31: '
  32: ' StartX    - Starting X position (pixels down from top)
  33: ' StartY    - Starting Y position (pixels right of top)
  34: ' EndX      - Ending X position (pixels down from top)
  35: ' EndY      - Ending Y position (pixels right of top)
  36: ' Text      - Text read from box
  37: ' Read      - Read text from box (1 to read,0 to just put box)
  38: ' Max Len.  - Maximum length of text
  39: ' Pass Char - Charectar to replace typed text ("" for normal text)
  40: '
  41: '+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
  42: Button1 50, 100, 56, 0, "   G"
  43: '        ³   ³    ³  ÀÄÄÄ¿  ÀÄÄ¿
  44: '        ³   ÀÄ¿  ÀÄÄÄÄÄ¿ÀÄÄ¿  ÀÄ¿
  45: '     StartY  StartX  Size Press Title
  46: '
  47: ' StartX - Starting X position (pixels down from top)
  48: ' StartY - Starting Y position (pixels right of top)
  49: ' Size   - Size Of Button
  50: ' Press  - 1 or 0 (1 if pressed ,0 if not pressed)
  51: ' Title  - Text on Button
  52: '+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
  53: DO UNTIL INKEY$ = CHR$(13)
  54: Sleep2 .3
  55: Button1 50, 100, 56, 1, "   G"
  56: Sleep2 .3
  57: Button1 50, 100, 56, 0, "   G"
  58: LOOP
  59: 32 Textbx 40, 40, 290, 55, Txt$, 1, 16, "*"
  60: Textbx 40, 60, 290, 75, T$, 1, 16, ""
  61: 
  62: SUB BackGround (C)
  63: LINE (-1, -1)-(640, 480), C, BF
  64: END SUB
  65: 
  66: SUB Button1 (X, Y, S, P, tle$)
  67: IF P = 0 THEN clr1 = 15: clr2 = 8 ELSE clr1 = 8: clr2 = 15
  68: EX = X + S: EY = Y + S
  69: LINE (X, Y)-(EX, EY), 7, BF
  70: LINE (X, Y)-(EX, EY), 0, B
  71: LINE (X + 5, Y + 5)-(EX - 5, EY - 5), 7, BF
  72: LINE (X + 4, Y + 4)-(EX - 4, EY - 4), 0, B
  73: LINE (X, EY)-(X + 4, EY - 4), 0
  74: LINE (EX, Y)-(EX - 4, Y + 4), 0
  75: PAINT (X + 1, Y + 1), clr1, 0
  76: PAINT (EX - 1, EY - 1), clr2, 0
  77: END SUB
  78: 
  79: SUB Font (T$)
  80: FOR qww = 1 TO LEN(T$)
  81: IF MID$(T$, qww, 1) = CHR$(0) THEN DRAW "C0BR9": GOTO 1011
  82: IF MID$(T$, qww, 1) = " " OR MID$(T$, qww, 1) = CHR$(255) THEN DRAW "C0BR9": GOTO 1011
  83: IF MID$(T$, qww, 1) = "A" THEN DRAW "C0U6E4F4D2L7R7D4BR3": GOTO 1011
  84: IF MID$(T$, qww, 1) = "B" THEN DRAW "C0BUU8R6BDBRD3BGL6R6BFD2BGL6R6BR4": GOTO 1011
  85: IF MID$(T$, qww, 1) = "C" THEN DRAW "C0BUU7BER6F1H1L6BGD7FR6EBDBR3": GOTO 1011
  86: IF MID$(T$, qww, 1) = "D" THEN DRAW "C0U9R5F2D5G2L5R5BR5": GOTO 1011
  87: IF MID$(T$, qww, 1) = "E" THEN DRAW "C0U9R7L7D4R4L4D5R7BR3": GOTO 1011
  88: IF MID$(T$, qww, 1) = "F" THEN DRAW "C0U9R7L7D4R4L4D5BR10": GOTO 1011
  89: IF MID$(T$, qww, 1) = "G" THEN DRAW "C0BU1U7E1R6F1H1L6G1D7F1R6E1U3L3R3BD4BR3": GOTO 1011
  90: IF MID$(T$, qww, 1) = "H" THEN DRAW "C0U9D4R7U4D9BR3": GOTO 1011
  91: IF MID$(T$, qww, 1) = "I" THEN DRAW "C0R4U9L4R7L3D9R3BR3": GOTO 1011
  92: IF MID$(T$, qww, 1) = "J" THEN DRAW "C0BU4D3F1R4E1U7L3R7BR2BD8": GOTO 1011
  93: IF MID$(T$, qww, 1) = "K" THEN DRAW "C0U9D4E4G4F5BR3": GOTO 1011
  94: IF MID$(T$, qww, 1) = "L" THEN DRAW "C0U9D9R7BR3": GOTO 1011
  95: IF MID$(T$, qww, 1) = "M" THEN DRAW "C0U9F4E4D9BR3": GOTO 1011
  96: IF MID$(T$, qww, 1) = "N" THEN DRAW "C0U9F2DF2DF2DU9D9BR3": GOTO 1011
  97: IF MID$(T$, qww, 1) = "O" THEN DRAW "C0BUU7E1R6F1D7G1L6H1F1BR10": GOTO 1011
  98: IF MID$(T$, qww, 1) = "P" THEN DRAW "C0U9R6FD2GL6D5BR10": GOTO 1011
  99: IF MID$(T$, qww, 1) = "Q" THEN DRAW "C0BUU7E1R6F1D7G1L6H1F1BDBR4ULU2D2RF2H2BR6": GOTO 1011
 100: IF MID$(T$, qww, 1) = "R" THEN DRAW "C0U9R6FD2GL6F5BR4": GOTO 1011
 101: IF MID$(T$, qww, 1) = "S" THEN DRAW "C0BU5U3ER6FHL6GD3FR6FD2GL6HBDBR11": GOTO 1011
 102: IF MID$(T$, qww, 1) = "T" THEN DRAW "C0BR4U9L4R7L3D9BR6": GOTO 1011
 103: IF MID$(T$, qww, 1) = "U" THEN DRAW "C0BUU8D8FR6EU8BD9BR3": GOTO 1011
 104: IF MID$(T$, qww, 1) = "V" THEN DRAW "C0BU4U5D5F4E4U5BD9BR3": GOTO 1011
 105: IF MID$(T$, qww, 1) = "W" THEN DRAW "C0BU3U6D6F3E3F3E3U6BD9BR3": GOTO 1011
 106: IF MID$(T$, qww, 1) = "X" THEN DRAW "C0U2E5U2BD9U2H5U2BR8BD9": GOTO 1011
 107: IF MID$(T$, qww, 1) = "Y" THEN DRAW "C0BR4U5H4F4E4G4D5BR6": GOTO 1011
 108: IF MID$(T$, qww, 1) = "Z" THEN DRAW "C0BU7U2R5D2G5D2R5U2D2BR3": GOTO 1011
 109: IF MID$(T$, qww, 1) = "*" THEN DRAW "C0BRE8G4L4R8L4H4F8H4E4G8E4U4D8BR6": GOTO 1011
 110: IF MID$(T$, qww, 1) = "1" THEN DRAW "C0BR2R5L3U9G2E2D9BR7": GOTO 1011
 111: IF MID$(T$, qww, 1) = "2" THEN DRAW "C0BU8ER6FD2GL6GD3FR6UDRUDBR3": GOTO 1011
 112: IF MID$(T$, qww, 1) = "3" THEN DRAW "C0BU8ER6FD2GL2R2FD3GL6HFBR10": GOTO 1011
 113: IF MID$(T$, qww, 1) = "4" THEN DRAW "C0BU5E4D4L3R4LD5BR4": GOTO 1011
 114: IF MID$(T$, qww, 1) = "5" THEN DRAW "C0BUFR5EU3HL6U4R7BD9BR3": GOTO 1011
 115: IF MID$(T$, qww, 1) = "6" THEN DRAW "C0BUU6E3G3D2R6FD3GL5HBDBR9": GOTO 1011
 116: IF MID$(T$, qww, 1) = "7" THEN DRAW "C0BU8UR7D3G2D4BR5": GOTO 1011
 117: IF MID$(T$, qww, 1) = "8" THEN DRAW "C0BUU3BU2U2ER5FD2GL5R5FD3GL5R5BR4": GOTO 1011
 118: IF MID$(T$, qww, 1) = "9" THEN DRAW "C0BR2R4E2U6HL5GD3FR5BD4BR3": GOTO 1011
 119: IF MID$(T$, qww, 1) = "0" THEN DRAW "C0BUU7E1R4F1D7G1L4H1F1BR8": GOTO 1011
 120: 
 121: DRAW "C0BRE8G4L4R8L4H4F8H4E4G8E4U4D8BR6"
 122: 1011 NEXT qww
 123: END SUB
 124: 
 125: SUB SCapt (FIL$)
 126: OPEN FIL$ FOR OUTPUT AS #1 LEN = 10000
 127: FOR X = 0 TO 639
 128: FOR Y = 0 TO 479
 129: vv$ = CHR$(POINT(X, Y) + 32)
 130: PRINT #1, vv$; : PSET (X, Y), 15
 131: IF INKEY$ = "" THEN  ELSE CLOSE 1: EXIT SUB
 132: NEXT Y
 133: NEXT X
 134: CLOSE 1
 135: END SUB
 136: 
 137: SUB Sleep2 (T)
 138: A = TIMER
 139: DO UNTIL TIMER >= A + T: LOOP
 140: 
 141: 
 142: END SUB
 143: 
 144: SUB SLoad (FIL$)
 145: OPEN FIL$ FOR RANDOM AS #1
 146: FOR X = 0 TO 639
 147: FOR Y = 0 TO 479
 148: GET #1, Y + 1 * (X + 1), clr$
 149: IF INKEY$ = "" THEN  ELSE CLOSE 1: EXIT SUB
 150: IF EOF(1) THEN CLOSE 1: PSET (X, Y), clr%: EXIT SUB
 151: PSET (X, Y), ASC(clr$) - 32
 152: 10 NEXT Y
 153: NEXT X
 154: END SUB
 155: 
 156: SUB Textbx (SX, SY, EX, EY, T$, r, l, PW$)
 157: T$ = ""
 158: IF LEN(PW$) > 1 THEN PW$ = LEFT$(PW$, 1)
 159: LINE (SX - 1, SY - 1)-(EX + 1, EY + 1), 0, B
 160: LINE (SX, SY)-(EX, EY), 15, BF
 161: MX$ = "M" + STR$(SX + 2) + "," + STR$(EY - 2)
 162: DRAW "BX" + VARPTR$(MX$)
 163: IF r = 1 THEN  ELSE EXIT SUB
 164: 12 A$ = INKEY$
 165: IF A$ = "" GOTO 12
 166: IF A$ = CHR$(8) THEN IF LEN(T$) = 0 THEN BEEP: 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
 167: IF A$ = CHR$(13) THEN EXIT SUB
 168: IF W = l THEN BEEP: GOTO 12
 169: T$ = T$ + A$: W = W + LEN(A$)
 170: B$ = UCASE$(A$)
 171: IF PW$ = "" THEN Font B$ ELSE Font PW$
 172: GOTO 12
 173: END SUB
 174: 
 175: SUB Window2 (length, height, row, column)
 176: LINE (column, row)-(column + length, row + height), 0, B
 177: FOR i% = 1 TO 2
 178: row = row + 1: column = column + 1: height = height - 1: length = length - 1
 179: LINE (column, row)-(column + length, row), 7
 180: LINE (column, row)-(column, row + height), 7
 181: NEXT i%
 182: row = row + 1: column = column + 1: height = height - 1: length = length - 1
 183: LINE (column, row)-(column + length, row), 0
 184: LINE (column, row)-(column, row + height), 0
 185: LINE (column, row)-(column + 18, row + 18), 7, BF
 186: LINE (column, row)-(column + 18, row + 18), 0, B
 187: LINE (column + 18, row - 2)-(column + 18, row + 5), 0
 188: LINE (column - 2, row + 18)-(column + 5, row + 18), 0
 189: LINE (column + 5, row + 7)-(column + 13, row + 9), 15, BF: LINE (column + 5, row + 7)-(column + 13, row + 9), 0, B
 190: LINE (column + 14, row + 7)-(column + 14, row + 9), 8
 191: LINE (column + 6, row + 10)-(column + 14, row + 10), 8, B
 192: LINE (column + 18, row)-(column + length, row + 18), 9, BF
 193: LINE (column + 18, row)-(column + length, row + 18), 0, B
 194: LINE (column + length, row - 3)-(column + length + 2, row + height), 7, BF
 195: LINE (column + length, row - 3)-(column + length + 3, row + height), 0, B
 196: LINE (column + length, row - 2)-(column + length, row - 1), 7
 197: LINE (column + length - 18, row - 2)-(column + length - 18, row - 1), 0
 198: LINE (column + length, row + 18)-(column + length + 2, row + 18), 0
 199: LINE (column, row + height - 3)-(column + length, row + height - 3), 0, B
 200: LINE (column, row + height - 2)-(column + length + 2, row + height), 7, BF
 201: LINE (column - 2, row + height)-(column + length + 2, row + height), 0, B
 202: LINE (column - 2, row + height - 18)-(column, row + height - 18), 0
 203: LINE (column + length - 2, row + height - 18)-(column + length + 2, row + height - 18), 0
 204: LINE (column + 18, row + height)-(column + 18, row + height - 2), 0
 205: LINE (column + length - 18, row + height)-(column + length - 18, row + height - 2), 0
 206: LINE (column + 1, row + 19)-(column + length - 1, row + height - 4), 7, BF
 207: END SUB
 208: 
5748368 [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:48