Programmer 7500

home *** CD-ROM | disk | FTP | other *** search

/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / CLIPPER / NFSRC.ZIP / MOUSE1.PRG < prev next >

Wrap

Text File | 1991-08-17 | 22.5 KB | 863 lines

/* * File......: MOUSE1.PRG * Author....: Robert DiFalco and Leo Letendre * Date......: $Date: 17 Aug 1991 15:34:52 $ * Revision..: $Revision: 1.5 $ * Log file..: $Logfile: E:/nanfor/src/mouse1.prv $ * * This is an original work by Robert DiFalco and is placed in the * public domain. * * Modification history: * --------------------- * * $Log: E:/nanfor/src/mouse1.prv $ * * Rev 1.5 17 Aug 1991 15:34:52 GLENN * Don Caton fixed some spelling errors in the doc * * Rev 1.4 15 Aug 1991 23:06:24 GLENN * Forest Belt proofread/edited/cleaned up doc * * Rev 1.3 17 Jul 1991 22:28:40 GLENN * Leo fixed a potential bug in ft_mcursor(). * * Rev 1.2 27 May 1991 13:40:30 GLENN * Leo Letendre sent me a revision of MOUSE1.PRG where he built in support * for a three-button mouse, and revised the "double click" detection * algorithm. * * Brought in compliance with new ft_int86(). * * Rev 1.1 11 May 1991 00:16:48 GLENN * ft_mgetpos() had a bug where the x and y coordinates were reversed. * Changed x coordinate to aRegs[3] and y coordinate to aRegs[4], just * like in ft_msetpos(). * * Rev 1.0 01 Apr 1991 01:01:48 GLENN * Nanforum Toolkit * */ #include "FTINT86.CH" static nMouseX, nMouseY static nHorMcks, nVerMcks static aReg[INT86_MAX_REGS] static lCrsState #ifdef FT_TEST FUNCTION MAIN() local nX, nY, cSavClr local nButCntR:=0, nButCntL:=0 local cSavScr := savescreen( 0, 0, maxrow(), maxcol() ) if empty( FT_MRESET() ) @ maxrow(), 0 say "Mouse driver is not installed!" return "" endif * ..... Set up the screen cSavClr := setcolor( "w/n" ) @ 0,0,maxrow(),maxcol() box "░░░░░░░░░" setcolor( "GR+/RB" ) scroll( 7,2,19,63,0 ) @ 7,2 to 19,63 @ 16, 10 to 18, 40 double setcolor( "N/W" ) @ 17, 11 say " Double Click here to Quit " setcolor( "GR+/RB" ) * ..... Start the demo FT_MSHOWCRS() do while .t. nX := nY := 0 devpos( 9, 10 ) devout( "FT_MMICKEYS:" ) FT_MMICKEYS( @nX, @nY ) devout( nX ) devout( nY ) devpos( 10, 10 ) devout( "FT_MGETPOS :" ) DEVOUT( FT_MGETPOS( @nX, @nY ) ) devout( nX ) devout( nY ) devpos( 11, 10 ) devout( "FT_MGETX :" ) DEVOUT( FT_MGETX() ) devpos( 12, 10 ) devout( "FT_MGETY :") DEVOUT( FT_MGETY() ) devpos( 13, 10 ) devout( "FT_MBUTPRS :" ) DEVOUT( FT_MBUTPRS(1,@nButCntR) ) DEVOUT( FT_MBUTPRS(0,@nButCntL) ) DEVOUT( nButCntL ) DEVOUT( nButCntR ) devpos( 14, 10 ) devout( "FT_MBUTREL :" ) DEVOUT( FT_MBUTREL(1) ) if FT_MINREGION( 17, 11, 17, 39 ) if FT_MDBLCLK() exit endif endif enddo FT_MHIDECRS() setcolor( cSavClr ) restscreen( 0, 0, maxrow(), maxcol(), cSavScr ) devpos( maxrow(), 0 ) RETURN nil #endif /* * $DOC$ * $FUNCNAME$ * FT_MRESET() * $CATEGORY$ * Keyboard/Mouse * $ONELINER$ * Reset mouse driver and return status of mouse * $SYNTAX$ * FT_MRESET() -> nMouseStatus * $ARGUMENTS$ * NONE * $RETURNS$ * An integer representing the mouse status (0 == mouse not installed) * $DESCRIPTION$ * Resets the mouse driver and returns mouse status. Use FT_MSHOWCRS() * to display the mouse cursor. * $EXAMPLES$ * IF Empty( FT_MRESET() ) * ? "No mouse driver is installed" * ENDIF * $SEEALSO$ * FT_MSHOWCRS() * $END$ */ FUNCTION FT_MRESET() aReg[1] := 0 // set mouse function call 0 FT_INT86( 51, aReg ) // execute mouse interrupt RETURN aReg[1] // return status code /* $DOC$ * $FUNCNAME$ * FT_MCURSOR() * $CATEGORY$ * Keyboard/Mouse * $ONELINER$ * Set the mouse cursor * $SYNTAX$ * FT_MCURSOR( [ <lState> ] ) -> lCursorState * $ARGUMENTS$ * <lState> is a logical indicating whether to set the mouse cursor on. * .T. - set mouse cursor on * .F. - set mouse cursor off * If omitted, no change is made to cursor state * $RETURNS$ * A logical indicating the previous mouse cursor state. * $DESCRIPTION$ * This function works like most Clipper state functions. If no value * is sent to FT_MCURSOR() it will return the state of the mouse cursor. * $EXAMPLES$ * IF !( FT_MCURSOR() ) * FT_MCURSOR( .T. ) * ENDIF * $END$ */ FUNCTION FT_MCURSOR( lState ) local lSavState := lCrsState if VALTYPE(lState)="L" if ( lCrsState := lState ) FT_MSHOWCRS() else FT_MHIDECRS() endif ENDIF RETURN lSavState /* $DOC$ * $FUNCNAME$ * FT_MSHOWCRS() * $CATEGORY$ * Keyboard/Mouse * $ONELINER$ * Increment internal cursor flag and display mouse cursor * $SYNTAX$ * FT_MSHOWCRS() -> NIL * $ARGUMENTS$ * NONE * $RETURNS$ * NIL * $DESCRIPTION$ * Displays the mouse cursor. Make sure to turn the mouse cursor off * when redrawing screens. The mouse cursor dutifully saves the screen * under it, so if you draw over the mouse cursor it will create a "hole" * in your screen when you move the mouse cursor. * $EXAMPLES$ * IF Empty( FT_MRESET() ) * FT_MSHOWCRS() * ENDIF * $SEEALSO$ * FT_MHIDECRS() * $END$ */ FUNCTION FT_MSHOWCRS() aReg[1] := 1 // set mouse function call 1 FT_INT86( 51, aReg ) // execute mouse interrupt lCrsState := .t. RETURN NIL // no output from function /* * $DOC$ * $FUNCNAME$ * FT_MHIDECRS() * $CATEGORY$ * Keyboard/Mouse * $ONELINER$ * Decrement internal mouse cursor flag and hide mouse cursor * $SYNTAX$ * FT_MHIDECRS() -> NIL * $ARGUMENTS$ * NONE * $RETURNS$ * NIL * $DESCRIPTION$ * Hides the mouse cursor. Make sure to turn the mouse cursor off when * redrawing screens. The mouse cursor dutifully saves the screen * under it, so if you draw over the mouse cursor it will create a * "hole" in your screen when you move the mouse cursor. * $EXAMPLES$ * FT_MHIDECRS() * @ 10, 10 to 20, 20 * FT_MSHOWCRS() * $SEEALSO$ * FT_MSHOWCRS() * $END$ */ FUNCTION FT_MHIDECRS() // decrement internal cursor flag and hide cursor aReg[1] := 2 // set mouse function call 2 FT_INT86( 51, aReg ) // execute mouse interrupt lCrsState := .f. RETURN NIL // no output from function /* * $DOC$ * $FUNCNAME$ * FT_MGETPOS() * $CATEGORY$ * Keyboard/Mouse * $ONELINER$ * Get mouse cursor position and button status * $SYNTAX$ * FT_MGETPOS( @<nX>, @<nY> ) -> nButtonStatus * $ARGUMENTS$ * <nX> is a variable that will receive the mouse X position. It must * be passed by reference. * * <nY> is a variable that will receive the mouse Y position. It must * be passed by reference. * $RETURNS$ * an integer representing button status * * - 0 for no button pressed * - 1 for left pressed * - 2 for right pressed * - 3 for left and right pressed * - 4 for middle pressed * - 5 for left and middle pressed * - 6 for right and middle pressed * - 0 for all three buttons pressed * $DESCRIPTION$ * Loads cursor position into x and y coordinates passed by reference and * returns the button status. * $EXAMPLES$ * LOCAL nX, nY * LOCAL nButton := FT_MGETPOS( @nX, @nY ) * ? "Mouse Row :", nX * ? "Mouse Column :", nY * ? "Button Status:", nButton * $SEEALSO$ * FT_MSETPOS() FT_MDEFCRS() FT_MGETX() FT_MGETY() * $END$ */ FUNCTION FT_MGETPOS( nX, nY ) nX := if( nX == NIL, 0, nX ) nY := if( nY == NIL, 0, nX ) aReg[1] := 3 // set mouse function call 3 FT_INT86( 51, aReg ) // execute mouse interrupt nX := nMouseX := aReg[4] // store new x-coordinate nY := nMouseY := aReg[3] // store new y-coordinate RETURN aReg[2] // return button status /* $DOC$ * $FUNCNAME$ * FT_MGETX() * $CATEGORY$ * Keyboard/Mouse * $ONELINER$ * Get mouse cursor row position * $SYNTAX$ * FT_MGETX() -> nRowPos * $ARGUMENTS$ * NONE * $RETURNS$ * Row position of mouse * $DESCRIPTION$ * Retrieves mouse's row position * $EXAMPLES$ * ? FT_MGETX() * $SEEALSO$ * FT_MDEFCRS() FT_MGETPOS() FT_MGETY() * $END$ */ FUNCTION FT_MGETX() FT_MGETPOS() RETURN int( nMouseX / 8 ) /* * $DOC$ * $FUNCNAME$ * FT_MGETY() * $CATEGORY$ * Keyboard/Mouse * $ONELINER$ * Get mouse cursor column position * $SYNTAX$ * FT_MGETY() -> nColPos * $ARGUMENTS$ * NONE * $RETURNS$ * Column position of mouse. * $DESCRIPTION$ * Retrieves mouse's column position. * $EXAMPLES$ * ? FT_MGETY() * $SEEALSO$ * FT_MDEFCRS() FT_MGETPOS() FT_MGETX() * $END$ */ FUNCTION FT_MGETY() FT_MGETPOS() RETURN int( nMouseY / 8 ) /* * $DOC$ * $FUNCNAME$ * FT_MSETPOS() * $CATEGORY$ * Keyboard/Mouse * $ONELINER$ * Position the mouse cursor * $SYNTAX$ * FT_MSETPOS( <nX>, <nY> ) -> NIL * $ARGUMENTS$ * <nX> is the desired mouse row. * * <nY> is the desired mouse column. * $RETURNS$ * NIL * $DESCRIPTION$ * Positions mouse cursor on screen. * $EXAMPLES$ * FT_MSETPOS( 10, 20 ) // position mouse cursor at row 10, col 20 * $SEEALSO$ * FT_MGETPOS() FT_MDEFCRS() FT_MGETX() FT_MGETY() * $END$ */ FUNCTION FT_MSETPOS( nX, nY ) // set mouse cursor location aReg[1] := 4 // set mouse function call 4 aReg[3] := nY // assign new x-coordinate aReg[4] := nX // assign new y-coordinate FT_INT86( 51, aReg ) // execute mouse interrupt RETURN NIL // no function output /* * $DOC$ * $FUNCNAME$ * FT_MXLIMIT() * $CATEGORY$ * Keyboard/Mouse * $ONELINER$ * Set vertical bounds of mouse travel * $SYNTAX$ * FT_MXLIMIT( <nX1>, <nX2> ) -> NIL * $ARGUMENTS$ * <nX1> is the top row limit. * * <nX2> is the bottom row limit. * $RETURNS$ * NIL * $DESCRIPTION$ * Set maximum vertical bounds of mouse. * $EXAMPLES$ * FT_MXLIMIT( 10, 20 ) * $SEEALSO$ * FT_MYLIMIT() FT_MINREGION() * $END$ */ FUNCTION FT_MXLIMIT( nXMin, nXMax ) // set vertical minimum and maximum coordinates aReg[1] = 7 // set mouse function call 7 aReg[3] = nXMin // load vertical minimum parameter aReg[4] = nXMax // load vertical maximum parameter FT_INT86( 51, aReg ) // execute mouse interrupt RETURN NIL /* * $DOC$ * $FUNCNAME$ * FT_MYLIMIT() * $CATEGORY$ * Keyboard/Mouse * $ONELINER$ * Set horizontal bounds of mouse travel * $SYNTAX$ * FT_MYLIMIT( <nY1>, <nY2> ) -> NIL * $ARGUMENTS$ * <nY1> is the left column limit. * * <nY2> is the right column limit. * $RETURNS$ * NIL * $DESCRIPTION$ * Set maximum horizontal bounds of mouse. * $EXAMPLES$ * FT_MYLIMIT( 10, 20 ) * $SEEALSO$ * FT_MXLIMIT() FT_MINREGION() * $END$ */ FUNCTION FT_MYLIMIT( nYMin, nYMax ) // set horizontal minimum and maximum coordinates aReg[1] = 8 // set mouse function call 8 aReg[3] = nYMin // load horz minimum parameter aReg[4] = nYMax // load horz maximum parameter FT_INT86( 51, aReg ) // execute mouse interrupt RETURN NIL // no function output /* * $DOC$ * $FUNCNAME$ * FT_MBUTPRS() * $CATEGORY$ * Keyboard/Mouse * $ONELINER$ * Retrieve button press status * $SYNTAX$ * FT_MRESET( <nButton> [, @nButPrs [, @nX [, @nY] ] ] ) -> nButStatus * $ARGUMENTS$ * <nButton> is the mouse button number: * * 0 - Left Button * 1 - Right Button * 2 - Middle Button [if applicable] * * <nButPrs> is the number of times the specified button was pressed * since the last call to this routine. PASSED BY REFERENCE. * <nX> is the X position of the cursor when the last press occurred. PASSED * BY REFERENCE. * <nY> is the Y position of the cursor when the last press occurred. PASSED * BY REFERENCE. * * $RETURNS$ * An integer representing the button status: * * 0 - no buttons pressed * 1 - left button pressed * 2 - right button pressed * 3 - left and right pressed * 4 - middle pressed * 5 - left and middle pressed * 6 - middle and right buttons pressed * 7 - all 3 buttons pressed * $DESCRIPTION$ * Retrieves the mouse button status. * $EXAMPLES$ * IF Empty( FT_MBUTPRS(1) ) * ? "No Item selected" * ENDIF * $SEEALSO$ * FT_MBUTREL() FT_MDBLCLK() * $END$ */ FUNCTION FT_MBUTPRS( nButton, nButPrs, nX, nY ) // get button press information aReg[1] := 5 // set mouse function call 5 aReg[2] := nButton // pass parameter for left or right button FT_INT86( 51, aReg ) // execute mouse interrupt nButPrs := aReg[2] // store updated press count nX := aReg[4] // x-coordinate at last press nY := aReg[3] // y-coordinate at last press RETURN aReg[1] // return button status /* $DOC$ * $FUNCNAME$ * FT_MBUTREL() * $CATEGORY$ * Keyboard/Mouse * $ONELINER$ * Get mouse button release information * $SYNTAX$ * FT_MBUTREL( nButton [, @nButRel [, @nX [, @nY] ] ]) -> nBStat * $ARGUMENTS$ * <nButton> is the mouse button number * 0 - Left Button * 1 - Right Button * 2 - Middle Button [if applicable] * * <nButRel> is the number of times the specified button was released * since the last call to this routine. PASSED BY REFERENCE. * * <nX> is the X position of the cursor when the last release occurred. * PASSED BY REFERENCE. * * <nY> is the Y position of the cursor when the last release occurred. * PASSED BY REFERENCE. * $RETURNS$ * <nBStat> - an integer representing button release status * 0 - None * 1 - Left * 2 - Right * 3 - Middle * $DESCRIPTION$ * This function returns the release status of the mouse buttons. * $EXAMPLES$ * IF( FT_MBUTREL( 0 ) == 1 ) * ? "Left button released" * ENDIF * $SEEALSO$ * FT_MBUTPRS() FT_MDBLCLK() * $END$ */ FUNCTION FT_MBUTREL( nButton, nButRel, nX, nY ) // get button release information aReg[1] := 6 // set mouse function call 6 aReg[2] := nButton // pass parameter for left or right button FT_INT86( 51, aReg ) // execute mouse interrupt nButRel := aReg[2] // store updated release count nX := aReg[4] // x-coordinate at last release nY := aReg[3] // y-coordinate at last release RETURN aReg[1] // return button status /* * $DOC$ * $FUNCNAME$ * FT_MDEFCRS() * $CATEGORY$ * Keyboard/Mouse * $ONELINER$ * Define the mouse cursor * $SYNTAX$ * FT_MDEFCRS( <nCrsType>, <nScrMask>, <nCrsMask> ) -> NIL * $ARGUMENTS$ * <nCrsType> is the cursor type. * * <nScrMask> is the screen mask. * * <nCrsMask> is the cursor mask. * $RETURNS$ * NIL * $DESCRIPTION$ * Defines the cursor type * $END$ */ FUNCTION FT_MDEFCRS( nCurType, nScrMask, nCurMask ) // define text cursor type and masks aReg[1] = 10 // set mouse function call 10 aReg[2] = nCurType // load cursor type parameter aReg[3] = nScrMask // load screen mask value aReg[4] = nCurMask // load cursor mask value FT_INT86( 51, aReg ) // execute mouse interrupt RETURN NIL // no function output /* * $DOC$ * $FUNCNAME$ * FT_MMICKEYS() * $CATEGORY$ * Keyboard/Mouse * $ONELINER$ * Get mickeys * $SYNTAX$ * FT_MMICKEYS( @<nX>, @<nY> ) -> NIL * $ARGUMENTS$ * <nX> is a variable that will receive the vertical mickey count. * * <nY> is a variable that will receive the horizontal mickey count. * $RETURNS$ * NIL * $DESCRIPTION$ * <nX> and <nY> must be passed by reference to receive * the mouse position in Mickeys. * $EXAMPLES$ * FT_MMICKEYS( @nX, @nY ) * ? nX * ? nY * $END$ */ FUNCTION FT_MMICKEYS( nX, nY ) // read mouse motion counters aReg[1] = 11 // set mouse function call 11 FT_INT86( 51, aReg ) // execute mouse interrupt nX := nHorMcks := aReg[3] // store horizontal motion units nY := nVerMcks := aReg[4] // store vertical motion units RETURN NIL // no function output /* * $DOC$ * $FUNCNAME$ * FT_MDBLCLK() * $CATEGORY$ * Keyboard/Mouse * $ONELINER$ * Return true if a double click was detected * $SYNTAX$ * FT_MDBFCLK( [ <nClick> [, <nButton> [, <nInterval> [, <nRow> [, <nCol>; * [, <nTime> ] ] ] ] ] ] ) -> lIsDoubleClk * $ARGUMENTS$ * <nClick> is a numeric value. If it is zero FT_MDBLCLK() will not * check for the first press but rather will simply wait the * specified period for a single press. This is useful if this * routine is called from one which in turn responded to a button * press. If it is not present or not equal to 0, then FT_MDBLCLK() * will wait for two presses of the specified button. * * <nButton> is the mouse button number * 0 - Left Button * 1 - Right Button * 2 - Middle Button [if applicable] * * <nInterval> is the interval to wait for the first click if requested * and the time to wait for the second. If not present then defaults * to 0.5 second. * * <nRow> is the row number for the mouse cursor location for a double click * to be valid. If not present then the current position is taken as * the valid location. * * <nCol> is the column number for the mouse cursor location for a double * click to be valid. If not present, then the current position is * taken as the valid location. * * <nTime> is an optional start time for the waiting period for the first * click (of either one or two requested). If not given then the * time is set at entry into this routine. This is useful when this * routine is called from another routine which was called in * response to a mouse click but needs to know if a double click * has occurred * $RETURNS$ * .T. if a double click was detected. * $DESCRIPTION$ * This is a mouse meta function that checks for the presence * of a double click. * $EXAMPLES$ * IF FT_MISREGION( 10, 10, 11, 20 ) .AND.; * FT_MDBLCLK(0,1,,FT_MGETX(),FT_MGETY()) && double click, right button * && at current location with * && default interval * * MnuItem1() * ENDIF * $SEEALSO$ * FT_MBUTPRS() FT_MBUTREL() * $END$ */ FUNCTION FT_MDBLCLK( nClick, nButton, nInterval, nRow, nCol, nStart ) LOCAL nVert, nHorz // local row and col coordinates LOCAL lDouble:=.F. // double click actually occurred LOCAL lDone // loop flag LOCAL nPrs // number of presses which occurred * Initialize any empty arguments if nClick=NIL nClick=1 endif if nButton=NIL nButton=0 endif if nRow=NIL nRow=FT_MGETX() endif if nCol=NIL nCol=FT_MGETY() endif if nInterval=NIL nInterval=0.5 endif if nStart=NIL nStart=seconds() endif nVert=nRow nHorz=nCol lDouble:=lDone:=nClick==0 // Wait for first press if requested do while !lDone FT_MBUTPRS( nButton, @nPrs, @nVert, @nHorz ) nVert=INT(nVert/8) nHorz=INT(nHorz/8) lDouble=(nPrs>0) ldone= seconds() - nStart >= nInterval .or. lDouble enddo // if we have not moved then keep the preliminary double click setting lDouble=lDouble.and.(nVert=nRow.and.nHorz=nCol) // change start time if we waited for first click. nInterval is the // maximum time between clicks not the total time for two clicks if // requested. if nClick>0 nStart=seconds() endif // If we have fulfilled all of the requirements then wait for second click if lDouble lDouble:=lDone:=.F. do while !lDone FT_MBUTPRS( nButton, @nPrs, @nVert, @nHorz ) nVert=INT(nVert/8) nHorz=INT(nHorz/8) lDouble=(nPrs>0) lDone= seconds() - nStart >= nInterval .or. lDouble enddo // make sure we haven't moved lDouble=lDouble.and.(nVert=nRow.and.nHorz=nCol) endif RETURN lDouble /* * $DOC$ * $FUNCNAME$ * FT_MINREGION() * $CATEGORY$ * Keyboard/Mouse * $ONELINER$ * Test if the mouse cursor is in the passed region * $SYNTAX$ * FT_MINREGION( <nT>, <nL>, <nB>, <nR> ) -> lInRegion * $ARGUMENTS$ * <nT>, <nL> <nB> <nR> are the four corners of the screen region. * $RETURNS$ * .T. if mouse is in specified region. * $DESCRIPTION$ * This function will check to see if the mouse cursor is * within the confines of the specified region. * $EXAMPLES$ * IF FT_MINREGION( 10, 10, 11, 20 ) * nChoice := 1 * ENDIF * $SEEALSO$ * FT_MXLIMIT() FT_MYLIMIT() FT_MINREGION() * $END$ */ FUNCTION FT_MINREGION( nTR, nLC, nBR, nRC ) RETURN ( FT_MGETX() >= nTR .and. FT_MGETX() <= nBR .and. ; FT_MGETY() >= nLC .and. FT_MGETY() <= nRC )