Files
harbour-core/harbour/website/samples/mouse.prg.html
Viktor Szakats c0eadc80eb 2013-02-27 19:12 UTC+0100 Viktor Szakats (harbour syenar.net)
* tests/*
  * website/*
    * dropped 'tst'/'ts'/'test' from most
      filenames inside main 'tests' dir. 8 chars will
      allow for more descriptive names than 4-5.
      Some renamed to use the new space.
      Similar ones will now be much close together
      and easier to lookup in alphabetical order.
    ; NOTE: Perhaps a new distinction would be useful,
            for those which are indeed tests for the
            compiler or PP, f.e. these:
               declare.prg, dupvars.prg, keywords.prg, linecont.prg,
               lnlenli1.prg, lnlenli2.prg, pp.prg, pragma.prg, warnings.prg
    ; List of changes:
      tests/ac_test.prg  -> achoice.prg
      tests/ac_test2.prg -> achoice2.prg
      tests/adirtest.prg -> adir.prg
      tests/ainstest.prg -> ains.prg
      tests/tstalias.prg -> aliasrt.prg
      tests/altdtest.prg -> altd.prg
      tests/atest.prg    -> array.prg
      tests/tstasort.prg -> asort.prg
      tests/boxtst2.prg  -> box2.prg
      tests/boxtest.prg  -> box3.prg
      tests/testbrdb.prg -> browse.prg
      tests/tstblock.prg -> cblock.prg
      tests/testcdx.prg  -> cdx.prg
      tests/tstchbx.prg  -> checkbox.prg
      tests/testcls.prg  -> cls.prg
      tests/tscmdarg.c   -> cmdarg.c
      tests/tstcolor.prg -> color.prg
      tests/testcom1.prg -> com.prg
      tests/cursrtst.prg -> cursor.prg
      tests/dttest.prg   -> datetime.prg
      tests/dbevalts.prg -> dbeval.prg
      tests/testdbf.prg  -> dbf.prg
      tests/tstdbi.prg   -> dbi.prg
      tests/debugtst.prg -> debug.prg
      tests/testdecl.prg -> declare.prg
      tests/testid.prg   -> define.prg
      tests/delimtst.prg -> delim.prg
      tests/devtest.prg  -> dev.prg
      tests/dirtest.prg  -> directry.prg
      tests/tstdspac.prg -> diskspac.prg
      tests/disptest.prg -> disp.prg
      tests/testdyn.c    -> dyn.c
      tests/testdyn1.prg -> dyn.prg
      tests/testdyn.prg  -> dynwin.prg
      tests/testerro.prg -> errsys.prg
      tests/exittest.prg -> exit.prg
      tests/iotest.prg   -> fileio.prg
      tests/iotest2.prg  -> fileio2.prg
      tests/fortest.prg  -> for.prg
      tests/testfor.prg  -> for2.prg
      tests/testget.prg  -> get.prg
      tests/tstgtapi.c   -> gtapi.c
      tests/gtstdtst.prg -> gtstd.prg
      tests/hbdoctst.prg -> hbdoc.prg
      tests/testhrb.prg  -> hrb.prg
      tests/hsxtest.prg  -> hsx.prg
      tests/testhtml.prg -> html.prg
      tests/testidle.prg -> idle.prg
      tests/testinit.prg -> initproc.prg
      tests/inkeytst.prg -> inkey.prg
      tests/testlbl.prg  -> lbl.prg
      tests/tstmacro.prg -> macro.prg
      tests/mathtest.prg -> math.prg
      tests/testmem.prg  -> mem.prg
      tests/memtst.prg   -> memmgr.prg
      tests/menutest.prg -> menuto.prg
      tests/testmny.prg  -> money.prg
      tests/mousetst.prg -> mouse.prg
      tests/testntx.prg  -> ntx.prg
      tests/testop.prg   -> op.prg
      tests/testpers.prg -> persist.prg
      tests/testpp.prg   -> pp.prg
      tests/testpre.prg  -> ppapi.prg
      tests/tstprag.prg  -> pragma.prg
      tests/testprof.prg -> profiler.prg
      tests/testrdd.prg  -> rdd.prg
      tests/testrdd2.prg -> rdd2.prg
      tests/testread.prg -> read.prg
      tests/regextst.prg -> regex2.prg
      tests/testrpt.prg  -> rpt.prg
      tests/sbartest.prg -> sbar.prg
      tests/sdf_test.prg -> sdf.prg
      tests/set_test.prg -> set.prg
      tests/videotst.prg -> setmode.prg
      tests/testsha1.prg -> sha1.prg
      tests/testsha2.prg -> sha2.prg
      tests/teststr.prg  -> str.prg
      tests/testbrw.prg  -> tbrowse.prg
      tests/transtst.prg -> transfrm.prg
      tests/tstuse.prg   -> use.prg
      tests/testvars.prg -> vars.prg
      tests/vidtest.prg  -> video.prg
      tests/testwarn.prg -> warnings.prg

  * tests/read.prg
    * use K_* value
2013-02-27 18:18:46 +00:00

274 lines
6.2 KiB
HTML

<!DOCTYPE html>
<html xmlns="http://www.w3.org/1999/xhtml" lang="en">
<head>
<meta charset="utf-8">
<script type="text/javascript" src="http://cdnjs.cloudflare.com/ajax/libs/xregexp/2.0.0/xregexp-min.js"></script>
<script type="text/javascript" src="http://cdnjs.cloudflare.com/ajax/libs/xregexp/2.0.0/backcompat.js"></script>
<script type="text/javascript" src="/js/shCore.js"></script>
<script type="text/javascript" src="/js/shBrushHarbour.js"></script>
<link href="/css/shCore.css" rel="stylesheet" type="text/css" />
<link href="/css/shThemeDefault.css" rel="stylesheet" type="text/css" />
<script type="text/javascript">SyntaxHighlighter.all()</script>
</head>
<body>
<script type="syntaxhighlighter" class="brush: harbour; light: true"><![CDATA[
/*
* Copyright 2000 Alejandro de Garate <alex_degarate hotmail com>
*
* Test mouse for Harbour
*/
#include "inkey.ch"
PROCEDURE Main()
LOCAL nR := 5, nC := 38
SET CURSOR OFF
CLS
IF ! MPresent()
? " No mouse present !"
QUIT
ENDIF
@ 0, 0 TO MaxRow(), MaxCol() DOUBLE
@ MaxRow() - 2, 0 TO MaxRow(), 18 DOUBLE
@ MaxRow() - 1, 2 SAY "Y:"
@ MaxRow() - 1, 10 SAY "X:"
@ nR, 2 SAY "Mouse Type :"
@ nR, 18 SAY "Mouse System"
@ MaxRow() - 2, 68 TO MaxRow(), MaxCol() DOUBLE
@ MaxRow() - 1, 70 SAY "Exit"
@ 10, 2 SAY " -- Checkings --"
@ 11, 2 SAY "Window Boundaries :"
@ 12, 2 SAY "Press/Release But.:"
@ 13, 2 SAY "Double Click Left :"
@ 14, 2 SAY "Double Click Right:"
TEST1()
TEST2( nR, nC )
SetPos( MaxRow(), 0 )
SET CURSOR ON
?
RETURN
FUNCTION MUPDATE()
@ MaxRow() - 1, 4 SAY MRow() PICTURE "9999"
@ MaxRow() - 1, 12 SAY MCol() PICTURE "9999"
RETURN 0
FUNCTION MINRECT( nTop, nLeft, nBott, nRight )
LOCAL lInside := .F.
IF MRow() >= nTop .AND. MRow() <= nBott
IF MCol() >= nLeft .AND. MCol() <= nRight
lInside := .T.
ENDIF
ENDIF
RETURN lInside
// First test: Check the boundaries of the main window
PROCEDURE TEST1()
LOCAL nKey
@ MaxRow() - 3, 25 SAY "Move the cursor until the UPPER side "
MUPDATE()
DO WHILE ( nKey := Inkey( 0, INKEY_ALL ) ) != K_TAB
MUPDATE()
IF nKey == K_MOUSEMOVE
IF MRow() < 1
EXIT
ENDIF
CHECKEXIT()
ENDIF
ENDDO
@ MaxRow() - 3, 25 SAY "Move the cursor until the BOTTOM side "
DO WHILE ( nKey := Inkey( 0, INKEY_ALL ) ) != K_TAB
MUPDATE()
IF nKey == K_MOUSEMOVE
IF MRow() > MaxRow() - 1
EXIT
ENDIF
CHECKEXIT()
ENDIF
ENDDO
@ MaxRow() - 3, 25 SAY "Move the cursor until the LEFT side "
DO WHILE ( nKey := Inkey( 0, INKEY_ALL ) ) != K_TAB
MUPDATE()
IF nKey == K_MOUSEMOVE
IF MCol() < 1
EXIT
ENDIF
CHECKEXIT()
ENDIF
ENDDO
@ MaxRow() - 3, 25 SAY "Move the cursor until the RIGHT side "
DO WHILE ( nKey := Inkey( 0, INKEY_ALL ) ) != K_TAB
MUPDATE()
IF nKey == K_MOUSEMOVE
IF MCol() > MaxCol() - 1
EXIT
ENDIF
CHECKEXIT()
ENDIF
ENDDO
@ MaxRow() - 3, 20 SAY Space( 50 )
@ 11, 22 SAY "Pass"
RETURN
// Second test: check the button pressing
PROCEDURE TEST2( nR, nC )
LOCAL cSkip := "", nKey, nPress := 0
@ nR + 0, nC SAY "+---------|---------+"
@ nR + 1, nC SAY "| +===+ +===+ +===+ |"
@ nR + 2, nC SAY "| | | | | | | |"
@ nR + 3, nC SAY "| | | | | | | |"
@ nR + 4, nC SAY "| +===+ +===+ +===+ |"
@ nR + 5, nC SAY "| |"
@ nR + 6, nC SAY "| Up Up Up |"
@ nR + 7, nC SAY "| |"
@ nR + 8, nC SAY "| |"
@ nR + 9, nC SAY "| Harbour |"
@ nR + 10, nC SAY "| mouse |"
@ nR + 11, nC SAY "+-------------------+"
Set( _SET_EVENTMASK, INKEY_ALL )
IF ! Empty( cSkip )
IF Upper( cSkip ) == "BREAK"
SetCancel( .T. )
ELSE
SetCancel( .F. )
ENDIF
ENDIF
MUPDATE()
WHILE ( nKey := Inkey( 0, INKEY_ALL ) ) != K_TAB
DO CASE
CASE nKey == K_MOUSEMOVE
// mouse has been moved
IF MINRECT( 19, 40, 22, 60 )
MHide()
ELSE
MShow()
ENDIF
CHECKEXIT()
MUPDATE()
CASE nKey == K_LBUTTONDOWN
// Left mouse button was pushed
@ nR + 2, nC + 3 SAY "XXX"
@ nR + 3, nC + 3 SAY "XXX"
@ nR + 6, nC + 3 SAY "Down"
nPress ++
CASE nKey == K_LBUTTONUP
// Left mouse button was released
@ nR + 2, nC + 3 SAY " "
@ nR + 3, nC + 3 SAY " "
@ nR + 6, nC + 3 SAY "Up "
CASE nKey == K_MBUTTONDOWN
// Middle mouse button was pushed
@ nR + 2, nC + 10 SAY "XXX"
@ nR + 3, nC + 10 SAY "XXX"
@ nR + 6, nC + 10 SAY "Down"
nPress ++
CASE nKey == K_MBUTTONUP
// Middle mouse button was released
@ nR + 6, nC + 10 SAY "Up "
CASE nKey == K_RBUTTONDOWN
// Right mouse button was pushed
@ nR + 2, nC + 15 SAY "XXX"
@ nR + 3, nC + 15 SAY "XXX"
@ nR + 6, nC + 15 SAY "Down"
nPress ++
CASE nKey == K_RBUTTONUP
// Right mouse button was released
@ nR + 2, nC + 15 SAY " "
@ nR + 3, nC + 15 SAY " "
@ nR + 6, nC + 15 SAY "Up "
CASE nKey == K_LDBLCLK
// "The left mouse button was double-clicked."
@ 13, 22 SAY "Pass"
CASE nKey == K_RDBLCLK
// "The right mouse button was double-clicked."
@ 14, 22 SAY "Pass"
OTHERWISE
@ MaxRow(), 20 SAY "A keyboard key was pressed:"
@ MaxRow(), 48 SAY nKey
#ifdef __HARBOUR__
@ MaxRow(), 58 SAY hb_keyChar( nKey )
#else
@ MaxRow(), 58 SAY iif( nKey >= 32 .AND. nKey <= 255, Chr( nKey ), "" )
#endif
ENDCASE
IF nPress > 6
EXIT
ENDIF
ENDDO
@ MaxRow() - 3, 20 SAY Space( 50 )
@ 12, 22 SAY "Pass"
SET CURSOR ON
@ 20, 1 SAY "MOUSE TEST FINISH!"
?
RETURN
PROCEDURE CHECKEXIT()
IF ! MINRECT( MaxRow() - 2, MaxCol() - 11, MaxRow(), MaxCol() )
RETURN
ENDIF
SET CURSOR ON
CLS
? "MOUSE TEST FINISH!"
?
QUIT
]]></script>
</body>
</html>