Files
harbour-core/harbour/website/samples/mouse.prg.html
Viktor Szakats 13aa09f395 2013-03-11 12:07 UTC+0100 Viktor Szakats (harbour syenar.net)
* utils/hbmk2/hbmk2.prg
    + added help and Markdown output for hbrun mode,
      using same options as in hbmk2 mode, run 'hbrun -help'
    + documented how to disable hbrun history
    + documented script search and and script autodetection details
    + documented opening .dbf files
    + documented how to paste text into shell prompt
    + documented limitation that in script INIT PROCEDUREs,
      automatic selection of interactive GT doesn't work
    + __Accept(), __Wait() to trigger interactive GT in scripts

  * src/rtl/objfunc.prg
    ! __objGetMsgList(): fixed to not rely on any assumption
      about the collation. In UTF8EX mode it was always
      returning empty array.
      Plus cleanup/optimizations

  * contrib/xhb/hbxml.c
    ! fix to a memory double free
      Thanks to Jose F. Gimenez for the patch.

  * contrib/hbtest/core.prg
  * contrib/hbtest/tests/test.prg
  * contrib/hbamf/tests/test.prg
    + added support and tests for tests returning
      array, hash and object types
    * changed zero byte to be escaped to \0 (was \000)
    + added memo tests and related engine cleanups

  * src/rtl/valtoexp.prg
    + hb_ValToExp(): output for objects changed to use double
      quotes for strings instead of a mixture of double/single
      ones, to make it easier stringifying the result

  * src/rtl/hbfilehi.prg
    % hb_DirSepDel(): minor optimization

  * tests/fixcase.hb
    + correct casing of EXTERN/REQUEST references

  * contrib/hbwin/tests/olesrv4.prg
  * contrib/hbxpp/hbxpp.ch
  * contrib/xhb/hterrsys.prg
  * contrib/xhb/xhb.ch
  * extras/httpsrv/uhttpd.prg
  * src/rdd/dbdelim.prg
  * src/rtl/tgetint.prg
  * src/rtl/tpersist.prg
  * tests/ppapi.prg
  * tests/set.prg
    ! run fixcase.hb to format REQUEST/EXTERNs

  * contrib/hbmisc/spd.c
  * contrib/hbmisc/hbnf.hbx
    ! missing casing for one function

  + tests/extend1.hbp
  * tests/extend1.prg
  * tests/extend2.c
    ! fixed to build and run again under Harbour

  * tests/debug.prg
  * tests/dynobj.prg
  * tests/for2.prg
  * tests/memvar.prg
  * tests/ppapi.prg
  * tests/scroll.prg
  * tests/set.prg
  * tests/str.prg
    * __Accept() changed to WAIT or Inkey( 0 )

  - contrib/hbrun/hbrun.1
  * config/postinst.hb
    * deleted hbrun's (outdated) man doc.
      Now built into hbmk2.prg as hbrun help.

  * contrib/hbmisc/hb_f.c
  * contrib/xhb/tests/xml1.prg
  * tests/hrbext.prg
    * comment/minor update

  * tests/hrb.prg
  * tests/hrbext.prg
    + hrb.prg to create .hrb file if it doesn't exist
    + added INIT PROCEDURE

  * contrib/gtwvg/*.h
  * contrib/gtwvg/gtwvgd.c
  * contrib/hbnf/fttext.c
  * contrib/hbwin/hbwinole.h
  * contrib/rddads/adsfunc.c
  * contrib/rddbm/bmdbfx.c
  * doc/c_std.txt
  * extras/gtwvw/docs/funclist.txt
  * extras/gtwvw/wvwpush.c
  * include/*.h
  * src/codepage/cp_utf8.c
  * src/common/*.c
  * src/compiler/*.c
  * src/rdd/dbfcdx/dbfcdx1.c
  * src/rdd/dbffpt/dbffpt1.c
  * src/rdd/dbfnsx/dbfnsx1.c
  * src/rdd/dbfntx/dbfntx1.c
  * src/rdd/hsx/hsx.c
  * src/rdd/usrrdd/rdds/arrayrdd.prg
  * src/rdd/*.c
  * src/rtl/*.c
  * src/rtl/gtsln/gtsln.h
  * src/rtl/gttrm/gttrm.c
  * src/rtl/gtwvt/gtwvt.c
  * src/vm/*.c
    * ! operator synced with uncrustify format
    * minor corrections in comment/text

  * tests/codebl.prg
  * tests/codebloc.prg
  * tests/dates3.prg
  * tests/foreach.prg
  * tests/macro.prg
  * tests/mouse.prg
  * tests/onidle.prg
  * tests/tbrowse.prg
  * tests/vmasort.prg
  * tests/wvtext.prg
  * website/samples/codebl.prg.html
  * website/samples/codebloc.prg.html
  * website/samples/dates3.prg.html
  * website/samples/foreach.prg.html
  * website/samples/macro.prg.html
  * website/samples/mouse.prg.html
  * website/samples/onidle.prg.html
  * website/samples/tbrowse.prg.html
    % local functions marked STATIC

  * contrib/hbmisc/spd.c
  * contrib/hbnf/clrsel.prg
  * contrib/hbnf/doc/en/*.txt
  * contrib/hbnf/popadder.prg
  * contrib/hbnf/tests/clrsel.prg
  * contrib/hbwin/win_tprn.prg
  * doc/en/datetime.txt
  * doc/en/set.txt
  * doc/oldnews.txt
  * extras/gfspell/spell.prg
  * extras/gtwvw/docs/gtwvw.txt
  * extras/gtwvw/hbgtwvw.h
  * extras/gtwvw/tests/ebtest7.prg
  * extras/gtwvw/wvwdraw.c
  * extras/gtwvw/wvwpush.c
  * tests/clsscope.prg
  * tests/extend1.prg
    ! few more dates converted to ISO format
2013-03-11 11:14:16 +00:00

274 lines
6.3 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
STATIC FUNCTION MUPDATE()
@ MaxRow() - 1, 4 SAY MRow() PICTURE "9999"
@ MaxRow() - 1, 12 SAY MCol() PICTURE "9999"
RETURN 0
STATIC 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
STATIC 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
STATIC 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
STATIC PROCEDURE CHECKEXIT()
IF ! MINRECT( MaxRow() - 2, MaxCol() - 11, MaxRow(), MaxCol() )
RETURN
ENDIF
SET CURSOR ON
CLS
? "MOUSE TEST FINISH!"
?
QUIT
]]></script>
</body>
</html>