5748333 [rkeene@sledge /home/rkeene/devel/archive/quickbasic]$ cat -n mswndow5.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 typed in 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: Textbx 40, 40, 290, 55, Txt$, 1, 16, "*"
  60: Textbx 40, 60, 290, 75, Txt$, 1, 16, "AB"
  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: IF PW$ = "" THEN S$ = t$ ELSE S$ = STRING$(LEN(t$), PW$)
  81: FOR qww = 1 TO LEN(t$)
  82: IF MID$(t$, qww, 1) = " " THEN DRAW "C0BR11": 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) = "*" THEN DRAW "C0BRE8G4L4R8L4H4F8H4E4G8E4U4D8BR6": GOTO 1011
 108: DRAW "C0BRE8G4L4R8L4H4F8H4E4G8E4U4D8BR6"
 109: 1011 NEXT qww
 110: END SUB
 111: 
 112: SUB SCapt (FIL$)
 113: OPEN FIL$ FOR OUTPUT AS #1 LEN = 10000
 114: FOR X = 0 TO 639
 115: FOR Y = 0 TO 479
 116: PRINT #1, POINT(X, Y): PSET (X, Y), 15
 117: IF INKEY$ = "" THEN  ELSE CLOSE 1: EXIT SUB
 118: NEXT Y
 119: NEXT X
 120: CLOSE 1
 121: END SUB
 122: 
 123: SUB Sleep2 (t)
 124: A = TIMER
 125: DO UNTIL TIMER >= A + t: LOOP
 126: 
 127: 
 128: END SUB
 129: 
 130: SUB SLoad (FIL$)
 131: OPEN FIL$ FOR INPUT AS #1
 132: 
 133: FOR X = 0 TO 639
 134: FOR Y = 0 TO 479
 135: INPUT #1, CLR%
 136: PSET (X, Y), CLR%
 137: IF INKEY$ = "" THEN  ELSE CLOSE 1: EXIT SUB
 138: IF EOF(1) THEN CLOSE 1: EXIT SUB
 139: NEXT Y
 140: NEXT X
 141: END SUB
 142: 
 143: SUB Textbx (SX, SY, EX, EY, t$, r, l, PW$)
 144: t$ = ""
 145: IF LEN(PW$) > 1 THEN PW$ = LEFT$(PW$, 1)
 146: LINE (SX - 1, SY - 1)-(EX + 1, EY + 1), 0, B
 147: LINE (SX, SY)-(EX, EY), 15, BF
 148: MX$ = "M" + STR$(SX + 2) + "," + STR$(EY - 2)
 149: DRAW "BX" + VARPTR$(MX$)
 150: IF r = 1 THEN  ELSE EXIT SUB
 151: 12 A$ = INKEY$
 152: IF A$ = "" GOTO 12
 153: 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 t$: GOTO 12 ELSE Font STRING$(LEN(t$), PW$): GOTO 12
 154: IF A$ = CHR$(13) THEN EXIT SUB
 155: IF W = l THEN BEEP: GOTO 12
 156: t$ = t$ + A$: W = W + 1
 157: B$ = UCASE$(A$)
 158: IF PW$ = "" THEN Font A$ ELSE Font PW$
 159: GOTO 12
 160: END SUB
 161: 
 162: SUB Window2 (length, height, row, column)
 163: LINE (column, row)-(column + length, row + height), 0, B
 164: FOR i% = 1 TO 2
 165: row = row + 1: column = column + 1: height = height - 1: length = length - 1
 166: LINE (column, row)-(column + length, row), 7
 167: LINE (column, row)-(column, row + height), 7
 168: NEXT i%
 169: row = row + 1: column = column + 1: height = height - 1: length = length - 1
 170: LINE (column, row)-(column + length, row), 0
 171: LINE (column, row)-(column, row + height), 0
 172: LINE (column, row)-(column + 18, row + 18), 7, BF
 173: LINE (column, row)-(column + 18, row + 18), 0, B
 174: LINE (column + 18, row - 2)-(column + 18, row + 5), 0
 175: LINE (column - 2, row + 18)-(column + 5, row + 18), 0
 176: LINE (column + 5, row + 7)-(column + 13, row + 9), 15, BF: LINE (column + 5, row + 7)-(column + 13, row + 9), 0, B
 177: LINE (column + 14, row + 7)-(column + 14, row + 9), 8
 178: LINE (column + 6, row + 10)-(column + 14, row + 10), 8, B
 179: LINE (column + 18, row)-(column + length, row + 18), 9, BF
 180: LINE (column + 18, row)-(column + length, row + 18), 0, B
 181: LINE (column + length, row - 3)-(column + length + 2, row + height), 7, BF
 182: LINE (column + length, row - 3)-(column + length + 3, row + height), 0, B
 183: LINE (column + length, row - 2)-(column + length, row - 1), 7
 184: LINE (column + length - 18, row - 2)-(column + length - 18, row - 1), 0
 185: LINE (column + length, row + 18)-(column + length + 2, row + 18), 0
 186: LINE (column, row + height - 3)-(column + length, row + height - 3), 0, B
 187: LINE (column, row + height - 2)-(column + length + 2, row + height), 7, BF
 188: LINE (column - 2, row + height)-(column + length + 2, row + height), 0, B
 189: LINE (column - 2, row + height - 18)-(column, row + height - 18), 0
 190: LINE (column + length - 2, row + height - 18)-(column + length + 2, row + height - 18), 0
 191: LINE (column + 18, row + height)-(column + 18, row + height - 2), 0
 192: LINE (column + length - 18, row + height)-(column + length - 18, row + height - 2), 0
 193: LINE (column + 1, row + 19)-(column + length - 1, row + height - 4), 7, BF
 194: END SUB
 195: 
5748334 [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:45