' MOUSE.BAS ' Wouter Bergmann Tiest ' December 1994 ' ' This is an example of how to use the mouse in QuickBasic 4.5 ' It draws a number of buttons on the screen and a arrow which is movable ' with the mouse. When a mouse button is pressed with the mouse cursor is on a ' button on the screen, the button will be drawn pushed-in. ' ' To get this program working, you'll need to start QuickBasic with the ' command ' ' QB /L QB ' DECLARE SUB ButtonPressed (number%) 'Draws a pushed-in button DECLARE SUB CursorOn () 'Puts the mouse cursor on the screen DECLARE SUB CursorOff () 'Takes the mouse cursor off the screen DECLARE FUNCTION CursorOnButton% (number%) 'Returns -1 if mouse cursor on specified button DECLARE SUB CheckPressed (number%) 'Checks if specified button is pressed DECLARE SUB CheckReleased (number%) 'Checks if specified button is released DECLARE SUB Initmouse () 'Initialises mouse DECLARE SUB Initarrow () 'Initialises the arrow DECLARE SUB InitCursor () 'Initialises the mouse cursor DECLARE SUB ButtonReleased (number%) 'Draws a released button '$INCLUDE: 'QB.BI' DEFINT A-Z TYPE buttontype x AS INTEGER 'Column and row positions y AS INTEGER text AS STRING * 20 active AS INTEGER '-1 if 'pressable', 0 if not END TYPE DIM SHARED inreg AS RegTypeX, outreg AS RegTypeX, button(10) AS buttontype, numberButtonPressed CONST mouse = 51, userfont = 16, true = -1, false = 0 Initmouse Initarrow InitCursor COLOR , 7: CLS 'Init buttons button(0).x = 10 button(0).y = 5 button(0).text = "Click Here!" button(0).active = true button(1).x = 20 button(1).y = 10 button(1).text = "Exit" button(1).active = true ButtonReleased 0 ButtonReleased 1 CursorOn DO CheckPressed 0 IF outreg.bx THEN IF CursorOnButton(0) THEN ButtonPressed 0 LOCATE 1, 1 PRINT "Hi!" ELSEIF CursorOnButton(1) THEN ButtonPressed 1 COLOR 7, 0 CLS EXIT DO END IF END IF CheckReleased 0 IF outreg.bx THEN ButtonReleased numberButtonPressed LOOP ' data for arrow DATA 128,192,192,224,240,240,248,252,252,254,255,252,216,24,12,12 SUB ButtonPressed (number) 'Draws button CursorOff text$ = RTRIM$(button(number).text) COLOR 8: LOCATE button(number).y, button(number).x: PRINT "É"; STRING$(LEN(text$) + 4, "Í"); COLOR 15: PRINT "¸" COLOR 8: LOCATE button(number).y + 1, button(number).x: PRINT "º"; IF button(number).active THEN COLOR 0 ELSE COLOR 8 PRINT " "; text$; " "; COLOR 15: PRINT "³" COLOR 8: LOCATE button(number).y + 2, button(number).x: PRINT "Ó"; COLOR 15: PRINT STRING$(LEN(text$) + 4, "Ä"); "Ù" CursorOn numberButtonPressed = number END SUB SUB ButtonReleased (number) 'Draws button text$ = RTRIM$(button(number).text) CursorOff COLOR 15: LOCATE button(number).y, button(number).x: PRINT "Ú"; STRING$(LEN(text$) + 4, "Ä"); COLOR 8: PRINT "·" COLOR 15: LOCATE button(number).y + 1, button(number).x: PRINT "³"; IF button(number).active THEN COLOR 0 ELSE COLOR 8 PRINT " "; text$; " "; COLOR 8: PRINT "º" COLOR 15: LOCATE button(number).y + 2, button(number).x: PRINT "Ô"; COLOR 8: PRINT STRING$(LEN(text$) + 4, "Í"); "¼" CursorOn END SUB SUB CheckPressed (number) 'returns x-position in outreg.cx, 'y-position in outreg.dx inreg.ax = 5 inreg.bx = number CALL INTERRUPTX(mouse, inreg, outreg) END SUB SUB CheckReleased (number) inreg.ax = 6 inreg.bx = number CALL INTERRUPTX(mouse, inreg, outreg) END SUB SUB CursorOff inreg.ax = 2 CALL INTERRUPTX(mouse, inreg, outreg) END SUB SUB CursorOn inreg.ax = 1 CALL INTERRUPTX(mouse, inreg, outreg) END SUB FUNCTION CursorOnButton (number) mx = outreg.cx / 8 + 1 my = outreg.dx / 8 + 1 CursorOnButton = ((mx >= button(number).x) AND (mx <= button(number).x + LEN(RTRIM$(button(number).text)) + 5) AND (my >= button(number).y) AND (my <= button(number).y + 2)) END FUNCTION SUB Initarrow FOR counter = 1 TO 16 READ byte arrow$ = arrow$ + CHR$(byte) NEXT counter DIM cursor AS STRING * 16 cursor = arrow$ inreg.ax = 17 * 256 inreg.bx = 16 * 256 inreg.cx = 1 inreg.dx = 64 inreg.es = VARSEG(cursor) inreg.bp = VARPTR(cursor) CALL INTERRUPTX(userfont, inreg, outreg) END SUB SUB InitCursor inreg.ax = 10 inreg.bx = 0 inreg.cx = 0 inreg.dx = (7 * 16 + 15) * 256 + 64 CALL INTERRUPTX(mouse, inreg, outreg) END SUB SUB Initmouse inreg.ax = 0 CALL INTERRUPTX(mouse, inreg, outreg) IF NOT outreg.ax THEN PRINT "Mousedriver not installed.": END END SUB