5748391 [rkeene@sledge /home/rkeene/devel/archive/quickbasic]$ cat -n mswndow4.bas
   1: DECLARE SUB Interrupt (intnum%, regs AS ANY)
   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!)
   6: DECLARE SUB Button1 (X!, Y!, S!, P!, tle$)
   7: TYPE regtype
   8: ax AS INTEGER
   9: bx AS INTEGER
  10: cx AS INTEGER
  11: dx AS INTEGER
  12: bp AS INTEGER
  13: si AS INTEGER
  14: di AS INTEGER
  15: flags AS INTEGER
  16: ds AS INTEGER
  17: es AS INTEGER
  18: END TYPE
  19: DIM SHARED regs AS regtype
  20: REDIM SHARED intrpt(1 TO 50) AS INTEGER
  21: CLS
  22: SCREEN 12
  23: 
  24: BackGround 1
  25: '          ³
  26: '         Color
  27: '
  28: ' Color - Color of Background
  29: '+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
  30: 
  31: Sleep2 1.2
  32: 
  33: Window2 350, 426, 10, 20
  34: '        ³    ³    ³  ÀÄÄÄ¿
  35: '        ³    ³    ÀÄÄÄ¿  ÀÄÄÄÄ¿
  36: '    Length  Height  StartX  StartY
  37: '
  38: ' Length - How long (left to right) the window is
  39: ' Heigth - How tall (up and down) the window is
  40: ' StartX - Starting X position (pixels down from top)
  41: ' StartY - Starting Y position (pixels right of top)
  42: '
  43: '+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
  44: Textbx 40, 40, 290, 55
  45: '       ³   ³   ³    ÀÄÄÄ¿
  46: '       ³   ÀÄ¿ ÀÄÄÄÄÄ¿  ÀÄÄ¿
  47: '   StartX  StartY  EndX   EndY
  48: '
  49: ' StartX - Starting X position (pixels down from top)
  50: ' StartY - Starting Y position (pixels right of top)
  51: ' EndX   - Ending X position (pixels down from top)
  52: ' EndY   - Ending Y position (pixels right of top)
  53: '
  54: '+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
  55: Button1 50, 100, 36, 0, "   G"
  56: '        ³   ³    ³  ÀÄÄÄ¿  ÀÄÄÄ¿
  57: '        ³   ÀÄ¿  ÀÄÄÄÄÄ¿ÀÄÄ¿   ÀÄ¿
  58: '     StartY  StartX  Size Press Title
  59: '
  60: ' StartX - Starting X position (pixels down from top)
  61: ' StartY - Starting Y position (pixels right of top)
  62: ' Size   - Size Of Button
  63: ' Press  - 1 or 0 (1 if pressed ,0 if not pressed)
  64: ' Title  - Text on Button
  65: '+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
  66: 
  67: DO UNTIL INKEY$ = CHR$(13)
  68: Sleep2 .2
  69: Button1 50, 100, 36, 1, "   G"
  70: Sleep2 .2
  71: Button1 50, 100, 36, 0, "   G"
  72: LOOP
  73: 
  74: SUB BackGround (C)
  75: LINE (-1, -1)-(640, 480), C, BF
  76: END SUB
  77: 
  78: SUB Button1 (X, Y, S, P, tle$)
  79: IF P = 0 THEN clr1 = 15: clr2 = 8 ELSE clr1 = 8: clr2 = 15
  80: EX = X + S: EY = Y + S
  81: LINE (X, Y)-(EX, EY), 7, BF
  82: LINE (X, Y)-(EX, EY), 0, B
  83: LINE (X + 5, Y + 5)-(EX - 5, EY - 5), 7, BF
  84: LINE (X + 4, Y + 4)-(EX - 4, EY - 4), 0, B
  85: LINE (X, EY)-(X + 4, EY - 4), 0
  86: LINE (EX, Y)-(EX - 4, Y + 4), 0
  87: PAINT (X + 1, Y + 1), clr1, 0
  88: PAINT (EX - 1, EY - 1), clr2, 0
  89: END SUB
  90: 
  91: SUB Interrupt (intnum%, regs AS regtype)
  92: 
  93:     DEF SEG = VARSEG(intrpt(1))
  94:     address = VARPTR(intrpt(1))
  95:     POKE address + 51, intnum%
  96: 
  97:     CALL absolute(regs, address)
  98: END SUB
  99: 
 100: SUB MicePressed (buttonPress%, numTimes%, xMouse%, yMouse%)
 101: ' if buttonPress% passed as 0 then info returned applies to left button
 102: ' if buttonPress% passed as 1 then info returned applies to right button
 103: 
 104: 
 105:     regs.ax = 5
 106:     regs.bx = buttonPress%
 107:     regs.cx = 0
 108:     regs.dx = 0
 109: 
 110:     CALL Interrupt(&H33, regs)
 111: 
 112:     buttonPress% = regs.ax 'if 1 returned left pressed since last call
 113:                            'if 2 returned right pressed since last call
 114:                            'if 3 returned both pressed since last call
 115: 
 116:     numTimes% = regs.bx   'depends on buttonPress% passed as 0 (left) or
 117:                           '1 (right)
 118:  
 119:     xMouse% = regs.cx     ' see ^
 120:     yMouse% = regs.dx     ' see ^
 121: 
 122: END SUB
 123: 
 124: SUB MiceShow
 125: END SUB
 126: 
 127: SUB Sleep2 (T)
 128: A = TIMER
 129: DO UNTIL TIMER >= A + T: LOOP
 130: 
 131: 
 132: END SUB
 133: 
 134: SUB Textbx (sx, sy, EX, EY)
 135: LINE (sx - 1, sy - 1)-(EX + 1, EY + 1), 0, B
 136: LINE (sx, sy)-(EX, EY), 15, BF
 137: END SUB
 138: 
 139: SUB Window2 (length, height, row, column)
 140: LINE (column, row)-(column + length, row + height), 0, B
 141: FOR i% = 1 TO 2
 142: row = row + 1: column = column + 1: height = height - 1: length = length - 1
 143: LINE (column, row)-(column + length, row), 7
 144: LINE (column, row)-(column, row + height), 7
 145: NEXT i%
 146: row = row + 1: column = column + 1: height = height - 1: length = length - 1
 147: LINE (column, row)-(column + length, row), 0
 148: LINE (column, row)-(column, row + height), 0
 149: LINE (column, row)-(column + 18, row + 18), 7, BF
 150: LINE (column, row)-(column + 18, row + 18), 0, B
 151: LINE (column + 18, row - 2)-(column + 18, row + 5), 0
 152: LINE (column - 2, row + 18)-(column + 5, row + 18), 0
 153: LINE (column + 5, row + 7)-(column + 13, row + 9), 15, BF: LINE (column + 5, row + 7)-(column + 13, row + 9), 0, B
 154: LINE (column + 14, row + 7)-(column + 14, row + 9), 8
 155: LINE (column + 6, row + 10)-(column + 14, row + 10), 8, B
 156: LINE (column + 18, row)-(column + length, row + 18), 9, BF
 157: LINE (column + 18, row)-(column + length, row + 18), 0, B
 158: LINE (column + length, row - 3)-(column + length + 2, row + height), 7, BF
 159: LINE (column + length, row - 3)-(column + length + 3, row + height), 0, B
 160: LINE (column + length, row - 2)-(column + length, row - 1), 7
 161: LINE (column + length - 18, row - 2)-(column + length - 18, row - 1), 0
 162: LINE (column + length, row + 18)-(column + length + 2, row + 18), 0
 163: LINE (column, row + height - 3)-(column + length, row + height - 3), 0, B
 164: LINE (column, row + height - 2)-(column + length + 2, row + height), 7, BF
 165: LINE (column - 2, row + height)-(column + length + 2, row + height), 0, B
 166: LINE (column - 2, row + height - 18)-(column, row + height - 18), 0
 167: LINE (column + length - 2, row + height - 18)-(column + length + 2, row + height - 18), 0
 168: LINE (column + 18, row + height)-(column + 18, row + height - 2), 0
 169: LINE (column + length - 18, row + height)-(column + length - 18, row + height - 2), 0
 170: LINE (column + 1, row + 19)-(column + length - 1, row + height - 4), 7, BF
 171: END SUB
 172: 
5748392 [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:43