home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / xbase / library / clipper / mouse / u_mouse / u_mousep.prg < prev    next >
Encoding:
Text File  |  1990-09-14  |  25.0 KB  |  993 lines
  1. ********************
  2. ********************
  3. **
  4. **   Source File ... U_MouseP.PRG
  5. **
  6. **   Application ...
  7. **                   Copyright (c) 1989 Philip de Lisle Associates
  8. **                   All Rights Reserved
  9. **
  10. **   Author ........ Philip de Lisle
  11. **   Last Update ... 15 September 1990 at 12:16 AM
  12. **   Purpose ....... High level Mouse UDFs
  13. **
  14. ********************
  15. ********************
  16.  
  17. *|
  18. *|  MUST BE COMPILED WITH /N SWITCH
  19. *|
  20.  
  21.  
  22. #include 'inkey.ch'
  23. #include 'object.ch'
  24. #include 'mouse.ch'
  25.  
  26. #define Keypressed()  (nextkey() # 0)
  27.  
  28. static _Is_Mouse := .f.
  29.  
  30.  
  31. function MouseNew
  32. **
  33. **  Syntax ..... MOUSENEW()
  34. **
  35. **  Purpose .... Create a new Instance of a Mouse Object
  36. **
  37. **  Argument ... None
  38. **
  39. **  Returns .... Object/Array
  40. **
  41.  
  42. ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  43. ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  44. //                                                                            \\
  45. //  Mouse Object Structure                                                    \\
  46. //                                                                            \\
  47. //  [1] Object Name                                                           \\
  48. //  [2] Instance Vars:- Y Coordinate,                                         \\
  49. //                      X     "                                               \\
  50. //                      Button No,                                            \\
  51. //                      Cursor visible,                                       \\
  52. //                        "    Character,                                     \\
  53. //                        "    Colour,                                        \\
  54. //                      Time to wait between clicks (for double clicks etc),  \\
  55. //                      No. of Clicks,                                        \\
  56. //                      Inkey() value of key press,                           \\
  57. //                      Cargo                                                 \\
  58. //                                                                            \\
  59. //  [3] Methods:- Activate (Respond to mouse/keyboard activity),              \\
  60. //                Info (refresh data in mouse object),                        \\
  61. //                Initialise (check mouse driver loaded etc),                 \\
  62. //                Wait (wait for mouse movement, keystroke etc),              \\
  63. //                Goto (position mouse to specific place on screen),          \\
  64. //                Show mouse                                                  \\
  65. //                Hide mouse,                                                 \\
  66. //                Set/Assign Exported Instance Variables                      \\
  67. //                                                                            \\
  68. ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  69. ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  70.  
  71. local oM[3]
  72.  
  73. oM[OBJ_NAME] := 'Mouse'
  74. oM[OBJ_INSTANCE] := {;
  75.                       -1, ;         //  Y Coordinate (assume no mouse)
  76.                       -1, ;         //  X     "         "    "    "
  77.                       -1, ;         //  Button #
  78.                       .f., ;        //  Cursor Visible
  79.                       0, ;          //    "    Character ASCII Code
  80.                       nil, ;        //    "    Colour
  81.                       0.2, ;        //  Time to wait
  82.                       0, ;          //  # of Clicks
  83.                       nil, ;        //  Inkey() value
  84.                       nil  ;        //  Cargo
  85.                     }
  86. oM[OBJ_METHOD] := {;
  87.                     {|o| Activate(o)}, ;
  88.                     {|o| Info(o)}, ;
  89.                     {|o| Init(o)}, ;
  90.                     {|o, cArg| Wait(o, cArg)}, ;
  91.                     {|o| Goto(o)}, ;
  92.                     {|o| Show(o)}, ;
  93.                     {|o| Hide(o)}, ;
  94.                     {|o, cArg, lSet| InstanceVar(o, MI_Y, cArg, lSet)}, ;
  95.                     {|o, cArg, lSet| InstanceVar(o, MI_X, cArg, lSet)}, ;
  96.                     {|o, cArg, lSet| InstanceVar(o, MI_BUTTON, cArg, lSet)}, ;
  97.                     {|o, cArg, lSet| InstanceVar(o, MI_VISIBLE, cArg, lSet)}, ;
  98.                     {|o, cArg, lSet| InstanceVar(o, MI_CHAR, cArg, lSet)}, ;
  99.                     {|o, cArg, lSet| InstanceVar(o, MI_COLOR, cArg, lSet)}, ;
  100.                     {|o, cArg, lSet| InstanceVar(o, MI_DELAY, cArg, lSet)}, ;
  101.                     {|o, cArg, lSet| InstanceVar(o, MI_CLICKS, cArg, lSet)}, ;
  102.                     {|o, cArg, lSet| InstanceVar(o, MI_ASCII, cArg, lSet)}, ;
  103.                     {|o, cArg, lSet| InstanceVar(o, MI_CARGO, cArg, lSet)} ;
  104.                   }
  105.  
  106. return ( oM )
  107. *| EOF MouseNew
  108.  
  109. *|----------------------------------------------------------------------------|*
  110.  
  111. function EvalMouse(oM, cMsg, cArg, lSet)
  112. **
  113. **  Syntax ..... EVALMOUSE(<A>, <C>, <exp>, <L>)
  114. **
  115. **  Purpose .... Evaluate a Mouse Object
  116. **
  117. **  Argument ... <A>   = Mouse Array/Object
  118. **               <C>   = Message
  119. **               <exp> = Expression of some sort/Argument for Message
  120. **               <L>   = Assign Instance Variable?
  121. **
  122. **  Returns .... Expression
  123. **
  124.  
  125. local xRet
  126.  
  127. do case
  128.    case cMsg == 'ACTIVATE'
  129.         xRet := eval(oM[OBJ_METHOD, MM_ACTIVATE], oM)
  130.    case cMsg == 'INFO'
  131.         xRet := eval(oM[OBJ_METHOD, MM_INFO], oM)
  132.    case cMsg == 'INSTALL'
  133.         xRet := eval(oM[OBJ_METHOD, MM_INSTALL], oM)
  134.    case cMsg == 'WAIT'
  135.         xRet := eval(oM[OBJ_METHOD, MM_WAIT], oM, cArg)
  136.    case cMsg == 'GOTO'
  137.         xRet := eval(oM[OBJ_METHOD, MM_GOTO], oM)
  138.    case cMsg == 'SHOW'
  139.         xRet := eval(oM[OBJ_METHOD, MM_SHOW], oM)
  140.    case cMsg == 'HIDE'
  141.         xRet := eval(oM[OBJ_METHOD, MM_HIDE], oM)
  142.    case cMsg == 'YPOS'
  143.         xRet := eval(oM[OBJ_METHOD, MM_YPOS], oM, cArg, lSet)
  144.    case cMsg == 'XPOS'
  145.         xRet := eval(oM[OBJ_METHOD, MM_XPOS], oM, cArg, lSet)
  146.    case cMsg == 'BUTTON'
  147.         xRet := eval(oM[OBJ_METHOD, MM_BUTTON], oM, cArg, lSet)
  148.    case cMsg == 'SHAPE'
  149.         xRet := eval(oM[OBJ_METHOD, MM_CHAR], oM, cArg, lSet)
  150.    case cMsg == 'VISIBLE'
  151.         xRet := eval(oM[OBJ_METHOD, MM_VISIBLE], oM, cArg, lSet)
  152.    case cMsg == 'COLOR'
  153.         xRet := eval(oM[OBJ_METHOD, MM_COLOR], oM, cArg, lSet)
  154.    case cMsg == 'DELAY'
  155.         xRet := eval(oM[OBJ_METHOD, MM_DELAY], oM, cArg, lSet)
  156.    case cMsg == 'CLICKS'
  157.         xRet := eval(oM[OBJ_METHOD, MM_CLICKS], oM, cArg, lSet)
  158.    case cMsg == 'ASCII'
  159.         xRet := eval(oM[OBJ_METHOD, MM_ASCII], oM, cArg, lSet)
  160.    case cMsg == 'CARGO'
  161.         xRet := eval(oM[OBJ_METHOD, MM_CARGO], oM, cArg, lSet)
  162. endcase
  163.  
  164. return (xRet)
  165. *| EOF EvalMouse
  166.  
  167. *|----------------------------------------------------------------------------|*
  168.  
  169. static function Activate(oM)
  170. **
  171. **  Syntax ..... ACTIVATE(<A>)
  172. **
  173. **  Purpose .... Activate Mouse
  174. **
  175. **  Argument ... <A> = Mouse Object
  176. **
  177. **  Returns .... Nothing
  178. **
  179.  
  180. local nM_Y, nM_X, nButton, nClick, nDelay, nOldButton, ;
  181.       nASCII, nY, nX, nTime
  182.  
  183. SEND oM:Delay TO nDelay
  184.  
  185. nButton := -1         //  Assume keyboard will be hit
  186. nClick  := 0
  187.  
  188. if nextkey() = K_CTRL_LEFT
  189.    nASCII := 19
  190.    inkey()
  191. else
  192.    nY := nM_Y
  193.    nX := nM_X
  194.  
  195.    do while .t.
  196.       if Keypressed()
  197.          nASCII := inkey()             //  see if user pressed a key
  198.          nM_Y   := row()
  199.          nM_X   := col()
  200.          exit
  201.       elseif _Is_Mouse
  202.          SEND oM:Info()
  203.          SEND oM:Button TO nButton
  204.  
  205.          if nButton # 0
  206.             SEND oM:YPos TO nM_Y
  207.             SEND oM:XPos TO nM_X
  208.  
  209.             nASCII := nil
  210.  
  211.             Pause(0.02)                //  Necessary to stop (nY = nM_Y) etc
  212.  
  213. *|
  214. *|  The F1=Help Horizontal Menu Button
  215. *|
  216.             if (nButton == LEFT_BUTTON) .and. ;
  217.                  RadioButtonPress(oM, 0, (maxcol()-8), maxcol())
  218.                keyboard chr(K_F1)
  219.                loop
  220.             endif
  221. *|
  222. *|  Both "heavy handed blocks are necessary - they check for different types
  223. *|  of clicks which can not be joined into one block - I've tried!!
  224. *|
  225.             if nClick = 1
  226.                nClick := 0
  227.                do while M_ButtonHold(nButton)              //  for the
  228.                enddo                                       //  heavy-handed!
  229.             endif
  230.  
  231.             if (nY = nM_Y) .and. (nX = nM_X) .and. (nClick # 0)
  232.                do while M_ButtonHold(nButton)              //  for the
  233.                enddo                                       //  heavy-handed!
  234.  
  235.                nTime := seconds()
  236.                nClick := 0
  237.                nY := 0
  238.                nX := 0
  239.                do while nClick < 2
  240.                   SEND oM:Info()
  241.                   SEND oM:Button TO nOldButton
  242.  
  243.                   if nOldButton = nButton
  244.                      SEND oM:YPos TO nM_Y
  245.                      if (nY == nM_Y)
  246.                         nClick++
  247.                         M_ClearButton(nButton)
  248.                      endif
  249.                   endif
  250.  
  251.                   if StopWatch(nTime, seconds()) > nDelay
  252.                      exit
  253.                   endif
  254.                enddo
  255.             endif
  256.  
  257.             exit
  258.          endif
  259.       endif
  260.    enddo
  261. endif
  262.  
  263. SEND oM:YPos   := nM_Y
  264. SEND oM:XPos   := nM_X
  265. SEND oM:Button := nButton
  266. SEND oM:ASCII  := nASCII
  267. SEND oM:Clicks := nClick
  268.  
  269. return (nil)
  270. *| EOF Activate
  271.  
  272. *|----------------------------------------------------------------------------|*
  273.  
  274. static function Info(oM)
  275. **
  276. **  Syntax ..... INFO(<A>)
  277. **
  278. **  Purpose .... Refresh Mouse object with Button No and Coordinates
  279. **
  280. **  Argument ... <A> = Mouse Object
  281. **
  282. **  Returns .... Nothing
  283. **
  284.  
  285. if _Is_Mouse
  286.    SEND oM:YPos   := (m_Func3Y() / 8)
  287.    SEND oM:XPos   := (m_Func3X() / 8)
  288.    SEND oM:Button := m_Func3B()
  289. endif
  290.  
  291. return (nil)
  292. *| EOF M_Info
  293.  
  294. *|----------------------------------------------------------------------------|*
  295.  
  296. static function Init(oM)
  297. **
  298. **  Syntax ..... INIT(<A>)
  299. **
  300. **  Purpose .... Initialise Mouse
  301. **
  302. **  Argument ... <A> = Mouse Object
  303. **
  304. **  Returns .... Nothing
  305. **
  306.  
  307. local cShape, cColor
  308.  
  309. #ifdef DEBUG
  310.        if type('oMouse') = 'U'
  311.           Bell()
  312.           cls
  313.           ?
  314.           ?  'No PUBLIC declaration for "oMouse"'
  315.           ?
  316.           quit
  317.        endif
  318. #endif
  319.  
  320. _Is_Mouse := (m_Func0() = -1)          //  File-wide Statics
  321.  
  322. if _Is_Mouse
  323.    SEND oM:Visible := .f.
  324.  
  325.    SEND oM:Shape TO cShape
  326.    SEND oM:Color TO cColor
  327.  
  328.    M_CursType(oM, cShape, cColor)
  329. endif
  330.  
  331. return (nil)
  332. *| EOF Init
  333.  
  334. *|----------------------------------------------------------------------------|*
  335.  
  336. static function Wait(oM, nWait)
  337. **
  338. **  Syntax ..... WAIT(<A>[, <N>])
  339. **
  340. **  Purpose .... Wait for Mouse/Keyboard Activity/timeout
  341. **
  342. **  Argument ... <A> = Mouse Object
  343. **               <N> = Time to Wait    [OPTIONAL]
  344. **
  345. **  Returns .... Nothing
  346. **
  347.  
  348. local nSecs, nButton
  349.  
  350. nSecs := seconds()
  351.  
  352. if _Is_Mouse
  353.    M_ClearButton(LEFT_BUTTON)
  354.    M_ClearButton(RIGHT_BUTTON)
  355.    M_ClearButton(BOTH_BUTTONS)
  356.    pause(.1)
  357. endif
  358.  
  359. nButton := 0
  360. keyboard ''
  361. do while .t.
  362.    if _Is_Mouse
  363.       SEND oM:Info()
  364.       SEND oM:Button TO nButton
  365.    endif
  366.  
  367.    if (nButton = 0) .and. ;
  368.           (iif(nWait = nil, .t., StopWatch(nSecs, seconds()) < nWait))
  369. *|
  370. *|  BUG !!!
  371. *|
  372. *      if SOS_Inkey() # 0
  373.       if inkey() # 0
  374.          exit
  375.       endif
  376.    else
  377.       exit
  378.    endif
  379. enddo
  380.  
  381. if _Is_Mouse
  382.    M_ClearButton(LEFT_BUTTON)
  383.    M_ClearButton(RIGHT_BUTTON)
  384.    M_ClearButton(BOTH_BUTTONS)
  385. endif
  386. keyboard ''
  387.  
  388. return (nil)
  389. *| EOF Wait
  390.  
  391. *|----------------------------------------------------------------------------|*
  392.  
  393. static function Goto(oM)
  394. **
  395. **  Syntax ..... GOTO(<A>)
  396. **
  397. **  Purpose .... Position Mouse Cursor
  398. **
  399. **  Argument ... <A> = Mouse Object
  400. **
  401. **  Returns .... Nothing
  402. **
  403.  
  404. local nY, nX
  405.  
  406. if _Is_Mouse
  407.    SEND oM:YPos TO nY
  408.    SEND oM:XPos TO nX
  409.    m_Func4(((nY % 25) * 8), ((nX % 80) * 8))
  410. endif
  411.  
  412. return (nil)
  413. *| EOF Goto
  414.  
  415. *|----------------------------------------------------------------------------|*
  416.  
  417. static function Show(oM)
  418. **
  419. **  Syntax ..... SHOW(<A>)
  420. **
  421. **  Purpose .... Display Mouse Cursor
  422. **
  423. **  Argument ... <A> = Mouse Object
  424. **
  425. **  Returns .... Nothing
  426. **
  427.  
  428. return ( M_Cursor(oM, .t.) )
  429. *| EOF Show
  430.  
  431. *|----------------------------------------------------------------------------|*
  432.  
  433. static function Hide(oM)
  434. **
  435. **  Syntax ..... HIDE(<A>)
  436. **
  437. **  Purpose .... Display Mouse Cursor
  438. **
  439. **  Argument ... <A> = Mouse Object
  440. **
  441. **  Returns .... Nothing
  442. **
  443.  
  444. return ( M_Cursor(oM, .f.) )
  445. *| EOF Hide
  446.  
  447. *|----------------------------------------------------------------------------|*
  448.  
  449. static function M_Cursor(oM, bShow)
  450. **
  451. **  Syntax ..... M_CURSOR(<A>, <L>)
  452. **
  453. **  Purpose .... Set Cursor ON/OFF for the MOUSE only
  454. **
  455. **  Argument ... <O> = Mouse object
  456. **               <L> = .T. for ON and .F. for OFF
  457. **
  458. **  Returns .... Nothing
  459. **
  460.  
  461. local bCursor
  462.  
  463. if _Is_Mouse
  464.    SEND oM:Visible TO bCursor
  465.  
  466.    if bShow
  467.       if ! bCursor
  468.          SEND oM:Visible := .t.
  469.          m_Func1()
  470.       endif
  471.    else
  472.       if bCursor
  473.          SEND oM:Visible := .f.
  474.          m_Func2()
  475.       endif
  476.    endif
  477. endif
  478.  
  479. return (nil)
  480. *| EOF M_Cursor
  481.  
  482. *|----------------------------------------------------------------------------|*
  483.  
  484. static function M_CursType(oM, nShape, cColor)
  485. **
  486. **  Syntax ..... M_CURSTYPE(<A>, <N>[, <C>])
  487. **
  488. **  Purpose .... Set the mouse Text cursor shape and colour
  489. **
  490. **  Argument ... <A> = Mouse Object
  491. **               <N> = ASCII code for Mouse cursor
  492. **               <C> = Colour for Mouse Cursor     [OPTIONAL]
  493. **
  494. **  Returns .... Nothing
  495. **
  496. **  Usage ...... Colour is combined with Cursor character and passed down to
  497. **               MFUNC10() as an integer
  498. **
  499.  
  500. if _Is_Mouse
  501.    if cColor = nil
  502.       cColor := strtran(setcolor(), ',')
  503.       SEND oM:Color := cColor
  504.    endif
  505.  
  506.    cColor := asc(Color2Bin(cColor))
  507.    nShape := (cColor * 256) + nShape
  508.    m_Func10(nShape)
  509. endif
  510.  
  511. return (nil)
  512. *| EOF M_CursType
  513.  
  514. *|----------------------------------------------------------------------------|*
  515.  
  516. static function M_ButtonHold(nButton)
  517. **
  518. **  Syntax ..... M_BUTTONHOLD(<N>)
  519. **
  520. **  Purpose .... Check if Button is continuously Pressed
  521. **
  522. **  Argument ... <N> = Button No.
  523. **
  524. **  Returns .... Logical
  525. **
  526.  
  527. return (m_Func3B() = nButton)
  528. *| EOF M_ButtonHold
  529.  
  530. *|----------------------------------------------------------------------------|*
  531. *|----------------------------------------------------------------------------|*
  532. *|--------------------------  END OF OBJECT STUFF  ---------------------------|*
  533. *|----------------------------------------------------------------------------|*
  534. *|----------------------------------------------------------------------------|*
  535.  
  536. function M_ClearButton(nButton)
  537. **
  538. **  Syntax ..... M_CLEARBUTTON(<N>)
  539. **
  540. **  Purpose .... Clear Mouse Button Buffer
  541. **
  542. **  Argument ... <N> = Button No
  543. **
  544. **  Returns .... Nothing
  545. **
  546.  
  547. if _Is_Mouse
  548.    --nButton
  549.    M_Func5C(nButton)
  550.    SEND oMouse:Button := -1
  551. endif
  552.  
  553. return (nil)
  554. *| EOF M_ClearButton
  555.  
  556. *|----------------------------------------------------------------------------|*
  557.  
  558. function M_OnHotSpot(oM, nY, nXMin, nXMax)
  559. **
  560. **  Syntax ..... M_ONHOTSPOT(<N1>, <N2>, <N3>, <N4>, <N5>)
  561. **
  562. **  Purpose .... Check if Mouse Positioned on a Hot Spot
  563. **
  564. **  Argument ... <A>  = Mouse Object
  565. **               <N1> = Y Coordinate of Button
  566. **               <N2> = Minimum X Coordinate for Hot Spot
  567. **               <N3> = Maximum "     "       "   "   "
  568. **
  569. **  Returns .... Logical
  570. **
  571.  
  572. local nM_Y, nM_X
  573.  
  574. SEND oM:YPos TO nM_Y
  575. SEND oM:XPos TO nM_X
  576.  
  577. return ( ((nM_Y = nY) .and. BUTTON_POS) )
  578. *| EOF M_OnHotSpot
  579.  
  580. *|----------------------------------------------------------------------------|*
  581.  
  582. function RadioButtonPress(oM, nY, nXMin, nXMax)
  583. **
  584. **  Syntax ..... RADIOBUTTONPRESS(<A>, <N1>, <N2>, <N3>)
  585. **
  586. **  Purpose .... Check if Mouse Clicked on a Button and Depress It
  587. **
  588. **  Argument ... <A>  = Mouse Object
  589. **               <N1> = Y Coordinate of Button
  590. **               <N2> = Minimum X Coordinate for Button
  591. **               <N3> = Maximum "     "       "    "
  592. **
  593. **  Returns .... Logical
  594. **
  595.  
  596. local i, bOk, cMap, cButton, cAttrib, cNewAttrib, nDelay, ;
  597.       nButton
  598.  
  599. bOk := M_OnHotSpot(oM, nY, nXMin, nXMax)
  600. SEND oM:Button TO nButton
  601.  
  602. if bOk  .and. (nButton = LEFT_BUTTON)
  603.    SEND oM:Hide()
  604.    SEND oM:Delay TO nDelay
  605.  
  606.    cButton := cMap := MSaveScreen(nY, nXMin, nY, nXMax)
  607.  
  608.    cAttrib := substr(cMap, 2, 1)
  609.    cNewAttrib := Color2Bin(ReverseColor(Bin2Color(cAttrib)))
  610.  
  611.    for i := 2 to len(cMap) step 2
  612.        cButton := stuff(cButton, i, 1, cNewAttrib)
  613.    next
  614.  
  615.    MRestScreen(nY, nXMin, nY, nXMax, cButton)
  616.    Pause(nDelay * 1.5)
  617.  
  618.    MRestScreen(nY, nXMin, nY, nXMax, cMap)
  619.  
  620.    SEND oM:Show()
  621. endif
  622.  
  623. return (bOk)
  624. *| EOF RadioButtonPress
  625.  
  626. *|----------------------------------------------------------------------------|*
  627.  
  628. function MSavescreen(nY1,nX1,nY2,nX2)
  629. **
  630. **  Syntax ..... MSAVESCREEN(<N1>, <N2>, <N3>, <N4>)
  631. **
  632. **  Purpose .... Save screen portion turning Mouse on and off
  633. **
  634. **  Argument ... <N1>..<N4> = screen coordinates
  635. **
  636. **  Returns .... Character
  637. **
  638.  
  639. local cScn, bOff, bCursor, nM_X, nM_Y
  640.  
  641. SEND oMouse:Info()
  642.  
  643. SEND oMouse:YPos TO nM_Y
  644. SEND oMouse:XPos TO nM_X
  645.  
  646. if (nM_Y >= nY1) .and. (nM_X >= nX1) .and. (nM_Y <= nY2) .and. (nM_X <= nX2)
  647.    bOff := .t.
  648.    SEND oMouse:Visible TO bCursor
  649.    SEND oMouse:Hide()
  650. else
  651.    bOff := .f.
  652. endif
  653.  
  654. cScn := savescreen(ny1,nX1,nY2,nX2)
  655.  
  656. if bOff .and. bCursor
  657.    SEND oMouse:Show()
  658. endif
  659.  
  660. return (cScn)
  661. *| EOF MSavescreen
  662.  
  663. *|----------------------------------------------------------------------------|*
  664.  
  665. function MRestscreen(nY1,nX1,nY2,nX2, cScn)
  666. **
  667. **  Syntax ..... MSAVESCREEN(<N1>, <N2>, <N3>, <N4>, <C>)
  668. **
  669. **  Purpose .... Restore screen portion turning Mouse on and off
  670. **
  671. **  Argument ... <N1>..<N4> = screen coordinates
  672. **               <C>        = Screen map
  673. **
  674. **  Returns .... Nothing
  675. **
  676.  
  677. local bOff, bCursor, nM_X, nM_Y
  678.  
  679. SEND oMouse:Info()
  680.  
  681. SEND oMouse:YPos TO nM_Y
  682. SEND oMouse:XPos TO nM_X
  683.  
  684. if (nM_Y >= nY1) .and. (nM_X >= nX1) .and. (nM_Y <= nY2) .and. (nM_X <= nX2)
  685.    bOff := .t.
  686.    SEND oMouse:Visible TO bCursor
  687.    SEND oMouse:Hide()
  688. else
  689.    bOff := .f.
  690. endif
  691.  
  692. restscreen(ny1,nX1,nY2,nX2, cScn)
  693.  
  694. if bOff .and. bCursor
  695.    SEND oMouse:Show()
  696. endif
  697.  
  698. return (nil)
  699. *| EOF MRestscreen
  700.  
  701. *|----------------------------------------------------------------------------|*
  702.  
  703.  
  704. *|----------------------------------------------------------------------------|*
  705. *|----------------------------------------------------------------------------|*
  706. *|----------------------------------------------------------------------------|*
  707. *|-----------------  Non-Mouse User Defined Functions  -----------------------|*
  708. *|----------------------------------------------------------------------------|*
  709. *|----------------------------------------------------------------------------|*
  710.  
  711. function StopWatch(nStart, nStop)
  712. **
  713. **  Syntax ..... STOPWATCH<N1>, <N2>)
  714. **
  715. **  Purpose .... Give difference between 2 times in seconds and 1/100ths
  716. **
  717. **  Argument ... <N1> = Start time in seconds
  718. **               <N2> = Stop time in seconds
  719. **
  720. **  Returns .... Numeric
  721. **
  722.  
  723. if nStart > nStop
  724.    nStop := nStop + 86400
  725. endif
  726.  
  727. return (nStop - nStart)
  728. *| EOF StopWatch
  729.  
  730. *|----------------------------------------------------------------------------|*
  731.  
  732. function Pause(nTime)
  733. **
  734. **  Syntax ..... PAUSE(<N>)
  735. **
  736. **  Purpose .... Uninterrupible time delay
  737. **
  738. **  Argument ... <N> = Time in seconds
  739. **
  740. **  Returns .... Nothing
  741. **
  742. **  See Also ... STOPWATCH()
  743. **
  744.  
  745. local nSecs
  746.  
  747. if nTime > 0
  748.    nSecs := seconds()
  749.    do while StopWatch(nSecs, seconds()) <= nTime
  750.    enddo
  751. endif
  752.  
  753. return (nil)
  754. *| EOF Pause
  755.  
  756. *|----------------------------------------------------------------------------|*
  757.  
  758. function ReverseColor(cColor)
  759. **
  760. **  Syntax ..... REVERSECOLOR(<C>)
  761. **
  762. **  Purpose .... Reverse a colour, ie "n/w" -> "w/n"
  763. **
  764. **  Argument ... <C> = Colour map
  765. **
  766. **  Returns .... Character
  767. **
  768.  
  769. cColor := alltrim(left(cColor, at(',', cColor+',')-1))
  770. *|
  771. *|                                            ^
  772. *|                   ensure at least 1 comma -+
  773. *|
  774.  
  775. return ( strtran(cColor, left(cColor, at('/', cColor)-1) + '/' , '') + '/' + ;
  776.          left(cColor, at('/', cColor)-1) )
  777. *| EOF ReverseColor
  778.  
  779. *|----------------------------------------------------------------------------|*
  780.  
  781. function Color2Num(cColor)
  782. **
  783. **  Syntax ..... COLOR2NUM(<C>)
  784. **
  785. **  Purpose .... Return number of Colour (0-15)
  786. **
  787. **  Argument ... <C> := Colour to convert
  788. **
  789. **  Returns .... Numeric
  790. **
  791.  
  792. local nNo
  793.  
  794. cColor := upper(trim(cColor))
  795.  
  796. do case
  797.    case cColor == 'N'
  798.         nNo := 0
  799.    case cColor == 'B'
  800.         nNo := 1
  801.    case cColor == 'G'
  802.         nNo := 2
  803.    case cColor == 'BG'
  804.         nNo := 3
  805.    case cColor == 'R'
  806.         nNo := 4
  807.    case cColor == 'RB'
  808.         nNo := 5
  809.    case cColor == 'GR'
  810.         nNo := 6
  811.    case cColor == 'W'
  812.         nNo := 7
  813.    case (cColor == 'N+') .or. (cColor == '+N')
  814.         nNo := 8
  815.    case cColor == ('B+') .or. (cColor == '+B')
  816.         nNo := 9
  817.    case cColor == ('G+') .or. (cColor == '+G')
  818.         nNo := 10
  819.    case cColor == ('BG+') .or. (cColor == '+BG')
  820.         nNo := 11
  821.    case cColor == ('R+') .or. (cColor == '+R')
  822.         nNo := 12
  823.    case cColor == ('RB+') .or. (cColor == '+RB')
  824.         nNo := 13
  825.    case cColor == ('GR+') .or. (cColor == '+GR')
  826.         nNo := 14
  827.    case cColor == ('W+') .or. (cColor == '+W')
  828.         nNo := 15
  829.    otherwise
  830.         nNo := ''+.f.           //  create artificial error
  831. endcase
  832.  
  833. return (nNo)
  834. *| EOF Color2Num
  835.  
  836. *|----------------------------------------------------------------------------|*
  837.  
  838. function Num2Color(nNo)
  839. **
  840. **  Syntax ..... NUM2COLOR(<N>)
  841. **
  842. **  Purpose .... Convert Colour No. to Colour String
  843. **
  844. **  Argument ... <N> := Colour No.
  845. **
  846. **  Returns .... Character
  847. **
  848.  
  849. local cColor
  850.  
  851. do case
  852.    Case nNo == 0
  853.         cColor := 'N'
  854.    Case nNo == 1
  855.         cColor := 'B'
  856.    Case nNo == 2
  857.         cColor := 'G'
  858.    Case nNo == 3
  859.         cColor := 'BG'
  860.    Case nNo == 4
  861.         cColor := 'R'
  862.    Case nNo == 5
  863.         cColor := 'RB'
  864.    Case nNo == 6
  865.         cColor := 'GR'
  866.    Case nNo == 7
  867.         cColor := 'W'
  868.    Case nNo == 8
  869.         cColor := '+N'
  870.    Case nNo == 9
  871.         cColor := '+B'
  872.    Case nNo == 10
  873.         cColor := '+G'
  874.    Case nNo == 11
  875.         cColor := '+BG'
  876.    Case nNo == 12
  877.         cColor := '+R'
  878.    Case nNo == 13
  879.         cColor := '+RB'
  880.    Case nNo == 14
  881.         cColor := '+GR'
  882.    Case nNo == 15
  883.         cColor := '+W'
  884.    otherwise
  885.         cColor := ''+.f.        //  create artificial error
  886. endcase
  887.  
  888. return (cColor)
  889. *| EOF Num2Color
  890.  
  891. *|----------------------------------------------------------------------------|*
  892.  
  893. function Color2Bin(cColor)
  894. **
  895. **  Syntax ..... COLOR2BIN(<C>)
  896. **
  897. **  Purpose .... Convert Colour to Binary
  898. **
  899. **  Argument ... <C> := Colour to Convert
  900. **
  901. **  Returns .... Character
  902. **
  903. **  Usage ...... Binary := (background * 16) + foreground [+ 128 for Blinking]
  904. **
  905.  
  906. local bBlink, cClr, nFore, nBack
  907.  
  908. cColor := upper(alltrim(cColor))
  909. bBlink := at('*', cColor) # 0
  910. cColor := strtran(cColor, "*", "")          &&  Remove blinking attribute
  911.  
  912. *|
  913. *|  Work out colour received, working from RIGHT to LEFT
  914. *|
  915. *|
  916. *|  BACKGROUND COLOUR
  917. *|
  918. cClr := right(cColor, (len(cColor)-at('/',cColor)))
  919. cClr := strtran(cClr, '+')
  920.  
  921. do case
  922.    case "BR" $ cClr
  923.         cClr := strtran(cClr, "BR", "RB")
  924.    case "RG" $ cClr
  925.         cClr := strtran(cClr, "RG", "GR")
  926.    case "GB" $ cClr
  927.         cClr := strtran(cClr, "GB", "BG")
  928. endcase
  929.  
  930. nBack := Color2Num(cClr)
  931.  
  932. *|
  933. *|  FOREGROUND COLOUR
  934. *|
  935. cClr := alltrim(left(cColor, (at('/',cColor)-1)))
  936. if at('+', cClr) = 1
  937.    cClr := stuff(cClr, 1, 1, '') + '+'
  938. endif
  939.  
  940. do case
  941.    case "BR" $ cClr
  942.         cClr := strtran(cClr, "BR", "RB")
  943.    case "RG" $ cClr
  944.         cClr := strtran(cClr, "RG", "GR")
  945.    case "GB" $ cClr
  946.         cClr := strtran(cClr, "GB", "BG")
  947. endcase
  948.  
  949. nFore := Color2Num(cClr)
  950.  
  951. cClr := (nBack * 16) + nFore + iif(bBlink, 128, 0)
  952.  
  953. return ( chr(cClr) )
  954. *| EOF Color2Bin
  955.  
  956. *|----------------------------------------------------------------------------|*
  957.  
  958. function Bin2Color(cBin)
  959. **
  960. **  Syntax ..... BIN2COLOR(<C>)
  961. **
  962. **  Purpose .... Convert Binary Number to Clipper Colour String
  963. **
  964. **  Argument ... <C> := Number to Convert
  965. **
  966. **  Returns .... Character
  967. **
  968. **  Usage ...... Binary := (background * 16) + foreground [+ 128 for Blinking]
  969. **
  970.  
  971. local bBlink, nFore, nBack, nBin
  972.  
  973. nBin := asc(cBin)
  974.  
  975. *|
  976. *|  Is colour blinking?
  977. *|
  978. bBlink := (nBin > 127)
  979. if bBlink
  980.    nBin := nBin - 128
  981. endif
  982.  
  983. *|
  984. *|  Work out colour received, working from RIGHT to LEFT
  985. *|
  986. nBack := int(nBin / 16)
  987. nFore := (nBin % 16)
  988.  
  989. return ( iif(bBlink, "*", "") + Num2Color(nFore) + "/" + Num2Color(nBack) )
  990. *| EOF Bin2Color
  991.  
  992. *|----------------------------------------------------------------------------|*
  993.