First step is to get QB 4.5 and better because you'll need to have access to the supporting libraries. As well as, the use of INTERRUPT(x) commands.
Or, you could do it the hard way and write & compile your own assembly code. BUT! then you'd still have to link it to your program. "The world shrinks more and more with every new user online."
I wrote this a few years ago for some students to perform mouse functions without QB45. I like to start with this program TEMPLATE.BAS and rename it when starting new projects. Copy the following program and save it to a file called template.bas. Run the program and move the mouse. Have fun!
'***********************************************************
'
' T E M P L A T E . B A S - Written by Chuck B, May 1998
'
' email: cbolin@dycon.com
' This file contains mouse controls as well as few DOS interrupts.
'
'***********************************************************
DECLARE FUNCTION DOSInterupt% (intINT AS INTEGER, intAX AS INTEGER, intBX AS INTEGER, intCX AS INTEGER, intDX AS INTEGER)
DECLARE FUNCTION GetFreeDiskSpace& (intDX%)
DECLARE FUNCTION GetDOSVersion! ()
DECLARE SUB WarmBoot ()
DECLARE SUB CenterText (strText AS STRING, intRow AS INTEGER, intFColor AS INTEGER, intBColor AS INTEGER)
DECLARE SUB DisableMouse ()
DECLARE SUB EnableMouse ()
DECLARE SUB ReadMousePosition ()
DECLARE SUB ShowMouseCursor ()
DECLARE SUB HideMouseCursor ()
DECLARE SUB SetMouseYLimits (intMaxY%, intMinY%)
DECLARE SUB SetMouseXLimits (intMaxX%, intMinX%)
DECLARE SUB SetMousePosition (intX%, intY%)
DIM SHARED aASM(50) AS INTEGER
DIM SHARED intReturn AS INTEGER
DIM SHARED lngFreeBytes AS LONG
DIM SHARED strDOSVersion AS STRING
DIM SHARED lngReturn AS LONG
DIM SHARED intMB AS INTEGER
DIM SHARED intMX AS INTEGER
DIM SHARED intMY AS INTEGER
DIM strByte AS STRING
DIM strKey AS STRING
DIM strLeft AS STRING
DIM strRight AS STRING
DIM strUp AS STRING
DIM strDown AS STRING
DIM strPgUp AS STRING
DIM strPgDown AS STRING
DIM strHome AS STRING
DIM strEnd AS STRING
DIM strEsc AS STRING
'loads assembler routine into aASM() array
DEF SEG = VARSEG(aASM(0))
FOR x = 0 TO 50
READ strByte
POKE VARPTR(aASM(0)) + x, VAL("&H" + strByte)
NEXT x
'waits for D key
IF UCASE$(strKey) = "D" THEN
SHELL
END IF
'left cursor
IF strKey = strLeft THEN
END IF
IF strKey = strRight THEN
END IF
IF strKey = strUp THEN
END IF
IF strKey = strDown THEN
END IF
IF strKey = strPgUp THEN
END IF
IF strKey = strPgDown THEN
END IF
IF strKey = strHome THEN
END IF
IF strKey = strEnd THEN
END IF
LOOP UNTIL strKey = strEsc
END
'************************************************************
' A S S E M B L E R C O D E
' Reference: Que's 'DOS Programmers Reference - 4th Edition'
' Waite Group's 'Microsoft Quickbasic Bible'
' Osborne 'Assembler - Inside & Out'
'************************************************************
DATA 55
DATA 8b,ec
DATA 56
DATA 57
DATA 8b,76,0c
DATA 8b,04
DATA 8b,76,0a
DATA 8b,1c
DATA 8b,76,08
DATA 8b,0c
DATA 8b,76,06
DATA 8b,14
DATA cd,21
DATA 8b,76,0c
DATA 89,04
DATA 8b,76,0a
DATA 89,1c
DATA 8b,76,08
DATA 89,0c
DATA 8b,76,06
DATA 89,14
DATA 5f
DATA 5e
DATA 5d
DATA ca,08,00
FUNCTION DOSInterupt% (intINT AS INTEGER, intAX AS INTEGER, intBX AS INTEGER, intCX AS INTEGER, intDX AS INTEGER)
DEF SEG = VARSEG(aASM(0))
POKE VARPTR(aASM(0)) + 26, intINT
CALL absolute(intAX, intBX, intCX, intDX, VARPTR(aASM(0)))
DOSInterupt% = intAX
END FUNCTION
SUB EnableMouse
intReturn = DOSInterupt%(&H33, 0, intBX%, intCX%, intDX%)
END SUB
SUB HideMouseCursor
intReturn = DOSInterupt%(&H33, 2, intBX%, intCX%, intDX%)
END SUB
SUB ReadMousePosition
intReturn = DOSInterupt%(&H33, 3, intMB, intMX, intMY)
END SUB
SUB SetMousePosition (intX%, intY%)
intReturn = DOSInterupt%(&H33, 4, intBX%, intX%, intY%)
END SUB
SUB SetMouseXLimits (intMaxX%, intMinX%)
intReturn = DOSInterupt%(&H33, 7, intBX%, intMinX%, intMaxX%)
END SUB
SUB SetMouseYLimits (intMaxY%, intMinY%)
intReturn = DOSInterupt%(&H33, 8, intBX%, intMinY%, intMaxY%)
END SUB
SUB ShowMouseCursor
intReturn = DOSInterupt%(&H33, 1, intBX%, intCX%, intDX%)
END SUB
these guys that have answered b4 don't know what they are talking about - mouse programs are easy. I've built one in qbasic 1.0. Here it is:
DECLARE SUB Mousestat (lb%,rb%,xmouse%,ymouse%)
DECLARE SUB Mousedriver (ax%,bx%,cx%,dx%)
DECLARE SUB Mouseshow ()
DECLARE FUNCTION Mouseinit% ()
DIM SHARED mouse$
Mouse$ = SPACE$(57)
FOR i% = 1 to 57
READ a$
h$ = CHR$(VAL("&h"+a$))
MID$(Mouse$,i%,1)=h$
NEXT i%
DATA 55,89,e5,8b,5e,0c,8b,07,50,8b,5e,0a,8b,07,50,8b
DATA 5e,08,8b,0f,8b,5e,06,8b,17,5b,58,1e,07,cd,33,53
DATA 8b,5e,0c,89,07,58,8b,5e,0a,89,07,8b,5e,08,89,0f
DATA 8b,5e,06,89,17,5d,ca,08,00
CLS
ms% = Mouseinit%
IF NOT ms% THEN PRINT "Mouse Not Found": END
mouseshow
PRINT "Right Click to Exit"
DO
Mousestat lb%, rb%,x%,y%
PRINT lb%,rb%,x%,y%
LOOP UNTIL rb% = -1
SUB Mousedriver (ax%,bx%,cx%,dx%,Mouse%)
DEF SEG = VARSEG(Mouse$)
Mouse% = SADD(Mouse$)
CALL Absolute (ax%,bx%,cx%,dx%,Mouse%)
END SUB
FUNCTION Mouseinit%
ax% = 0
Mousedriver ax%,0,0,0
Mouseinit% = ax%
END FUNCTION
SUB Mouseshow
ax% = 1
Mousedriver ax%,0,0,0
END SUB
SUB Mousestat (lb%,rb%,xmouse%,ymouse%)
ax% = 3
Mousedriver ax%,bx%,cx%,dx%
lb% = ((bx% AND 1)<>0)
rb% = ((bx% AND 1)<>0)
ymouse% = dx%
xmouse% = cx%
END SUB
sorry about that - i screwed something up when i types it. In the sub - then first line
SUB Mousedriver (ax%,bx%,cx%,dx%,mouse%)
the mouse% part should NOT be there, that was giving you the error
but it should be in the CALL Absolute i must have been looking at that the entire sub should look like this:
SUB Mousedriver (ax%,bx%,cx%,dx%)
DEF SEG = VARSEG (Mouse$)
Mouse% = SADD(mouse$)
CALL Absolute (ax%,bx%,cx%,dx%,Mouse%)
ENS SUB
sorry about that, lemme know if i can help you with anything else.
Good stuff. Ever think of being a member of Tek-Tips? It's FREE. I wanted to give you a Tip-Master of the Week Vote but I can't unless you're a member.
If you choose not to then here's a little star for you: *
--MiggyD It's better to have two heads to solve a problem from different angles than to have tunnel vision to a dead end.
This site uses cookies to help personalise content, tailor your experience and to keep you logged in if you register.
By continuing to use this site, you are consenting to our use of cookies.