home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / clipper / sup35s / s3mouse.prg < prev    next >
Encoding:
Text File  |  1992-08-18  |  5.7 KB  |  224 lines
  1.  
  2. proc main
  3. local cInScreen := savescreen(0,0,24,79)
  4. local nSelected := 1
  5. local aOptions := { ;
  6.                  {6,28 ,  'Simple Mouse Test'},;
  7.                  {7,28 ,  'Read with mouse'},;
  8.                  {8,28 ,  'Menu To with mouse'},;
  9.                  {9,28 ,  'Event handler'},;
  10.                  {10,28 , 'Quit'}}
  11.  
  12. *- set some sets
  13. SET TALK OFF
  14. SET ECHO OFF
  15. SET CONFIRM OFF
  16. SET BELL OFF
  17. SET SAFETY OFF
  18. SET SCOREBOARD OFF
  19. slsf_color("S3COLOR")
  20. initsup(.F.)
  21. rat_reset()
  22. setcolor(sls_normcol())
  23. dispbox(0,0,24,79,"┌─┐│┘─└│▓")
  24. makebox(5,24,12,51)
  25.  
  26.  
  27. IF RAT_EXIST()
  28.   while .t.
  29.    nSelected := RAT_MENU2(aOptions,nSelected,.t.)
  30.    do case
  31.    case nSelected == 1
  32.      ratbasic()
  33.    case nSelected == 2
  34.      readrat()
  35.    case nSelected == 3
  36.      RAT_MSG("You're in RAT_MENU2()","right now...")
  37.    case nSelected == 4 // event handler
  38.      event()
  39.    case nSelected == 5 .or. nSelected == 0
  40.      exit
  41.    endcase
  42.   end
  43. else
  44.   msg("Could not find a mouse")
  45. endif
  46. ss_split(0,0,24,79,cInscreen)
  47.  
  48.  
  49.  
  50. //-----------------------------------------------------------------
  51. //--- mouse basics - on/off, location on the screen, button presses
  52. proc ratbasic
  53. local cInscreen := savescreen(0,0,24,79)
  54. local nOldMrow := 0
  55. local nOldMCol := 0
  56. local nMrow    := 0
  57. local nMCol    := 0
  58. local nMLeftpR := 0
  59. local nMLeftpC := 0
  60. local nmRightpR := 0
  61. local nMRightpC := 0
  62. makebox(7,19,17,66,sls_normcol())
  63. @7,20 say "Simple mouse usage..."
  64. @ 9,22 SAY "Mouse row             :"
  65. @ 10,22 SAY "Mouse col             :"
  66. @ 12,22 SAY "Mouse left pressed at :"
  67. @ 13,22 SAY "Mouse right pressed at:"
  68. @ 16,58 say " Quit" color sls_popcol()
  69.  
  70.  
  71. rat_on()
  72. nOldMRow := rat_row()+1
  73. nOldMCol := rat_col()+1
  74. while .t.
  75.    nMRow := rat_row()
  76.    nMCol := rat_col()
  77.    if nOldMRow#nMRow .or. nOldMCol#nMCol
  78.      nOldMRow := nMRow
  79.      nOldMCol := nMCol
  80.      rat_off()
  81.      @9,47  say nMRow  pict "999"
  82.      @10,47 say nMCol  pict "999"
  83.      rat_on()
  84.    elseif rat_leftb()
  85.      nMLeftpR := rat_rowl()
  86.      nMLeftpc := rat_coll()
  87.      @12,47 say nMLeftpR  pict "999"
  88.      @12,50 say ","
  89.      @12,51 say nMLeftpC  pict "999"
  90.      if nMLeftpR == 16 .and. nMLeftpC >= 58 .and. nMLeftpC <= 62 // on "Quit"
  91.        exit
  92.      endif
  93.    elseif rat_rightb()
  94.      nMRightpR := rat_rowr()
  95.      nMRightpc := rat_colr()
  96.      @13,47 say nMRightpR  pict "999"
  97.      @13,50 say ","
  98.      @13,51 say nMRightpC  pict "999"
  99.    endif
  100. end
  101. rat_off()
  102. ss_fold(0,0,24,79,cInscreen)
  103.  
  104. //-----------------------------------------------------------------
  105. //--- mouse READ test
  106. static proc readrat()
  107.  local cBox := makebox(9,9,15,62)
  108.  local v1 := padr("This is a test of the ",50)
  109.  local v2 := padr("Mouse reader in SuperLib",50)
  110.  local v3 := padr("which allows mouse action ",50)
  111.  memvar getlist
  112.  @14,10 say "Use mouse to change gets - right button escapes"
  113.  @10,10 get v1
  114.  @11,10 get v2
  115.  @12,10 get v3
  116.  RAT_READ(getlist,1,.T.,27)
  117.  unbox(cBox)
  118. return
  119.  
  120.  
  121. //-----------------------------------------------------------------
  122. //--- EVENT
  123. static proc event()
  124. local cBox := makebox(10,10,15,70)
  125. local nEvent
  126.  
  127. @11,12 say "Do something..."
  128. @12,12 say "(click the mouse, press a key, etc...)"
  129. @14,12 say "(Press ESCAPE to exit)"
  130. @14,65 say "Quit" color sls_popcol()
  131. while .t.
  132.    nEvent := rat_event(5)
  133.    scroll(11,11,13,69,0)
  134.    do case
  135.    case nEvent == 0
  136.      @11,12 say "Timed out after 5 seconds"
  137.    case nEvent < 400
  138.      @11,12 say "Key press with inkey() value of :"
  139.      ??nEvent
  140.      if nEvent == 27
  141.        exit
  142.      endif
  143.    case nEvent == 400
  144.      @11,12 say "Left mouse button pressed at :"
  145.      ?? trans(rat_eqmrow(),"999"),",", trans(rat_eqmcol(),"999")
  146.      if rat_elbhd(.5)
  147.        ?? " and held down!"
  148.      endif
  149.      if rat_eqmrow() == 14 .and. rat_eqmcol() >= 65 .and. ;
  150.         rat_eqmcol() <= 68 // on "Quit"
  151.        exit
  152.      endif
  153.    case nEvent == 500
  154.      @11,12 say "Right mouse button pressed at :"
  155.      ?? trans(rat_eqmrow(),"999"),",", trans(rat_eqmcol(),"999")
  156.      if rat_erbhd(.5)
  157.        ?? " and held down!"
  158.      endif
  159.    endcase
  160.    @12,12 say "do something else..."
  161.  
  162. end
  163. unbox(cBox)
  164. return
  165.  
  166. //--------------MSG() function RATified
  167. FUNCTION rat_msg(cMsg1,cMsg2,cMsg3,cMsg4,cMsg5,cMsg6,cMsg7,cMsg8,cMsg9)
  168. local nMessageLines,nIterator,nTop,nLeft,nBottom
  169. local nRight,cUnderScreen,nOldCursor
  170. LOCAL nTimeout,lIsTimer,nLongest
  171. LOCAL aMessages
  172.  
  173. *- save cursor status, set cursor off
  174. nOldCursor = setcursor(0)
  175.  
  176. *- how many paramaters passed (maximum 9)
  177. IF VALTYPE(cMsg1) == "N"
  178.   lIsTimer      := .T.
  179.   nTimeout      := cMsg1
  180.   nMessageLines := MIN(Pcount()-1,8)
  181.   aMessages     := {cMsg2,cMsg3,cMsg4,cMsg5,cMsg6,cMsg7,cMsg8,cMsg9}
  182. ELSE
  183.   lIsTimer      := .F.
  184.   nTimeout      := 0
  185.   nMessageLines := MIN(Pcount(),9)
  186.   aMessages     := {cMsg1,cMsg2,cMsg3,cMsg4,cMsg5,cMsg6,cMsg7,cMsg8,cMsg9}
  187. ENDIF
  188. asize(aMessages,nMessagelines)
  189.  
  190. *- whats the longest string
  191. nLongest = MAX(bigelem(aMessages)+1,16)
  192.  
  193. *- figure the window coordinates
  194. nTop            := 8
  195. * if no lIsTimer value, leave blank line before "Press a key...", else no space
  196. nBottom         := IIF(nTimeout=0,nTop+nMessageLines+3,nTop+nMessageLines+1)
  197. nLeft           := INT((79-nLongest)/2 - 1)
  198. nRight          := nLeft+nLongest+2
  199.  
  200. *- draw a box
  201. cUnderScreen = makebox(nTop,nLeft,nBottom,nRight,sls_popcol())
  202.  
  203. * display the message
  204. FOR nIterator = 1 TO nMessageLines
  205.   @8+nIterator,nLeft+2 SAY aMessages[nIterator]
  206. NEXT
  207. * now the results of the lIsTimer value
  208. IF nTimeout = 0
  209.   @ nBottom-1,nLeft+2 SAY "Press a key..."
  210.   *- wait
  211.   RAT_EVENT(0)
  212. ELSE
  213.   RAT_EVENT(nTimeout)
  214. ENDIF (nTimeout = 0
  215. *- leave
  216. unbox(cUnderScreen)
  217.  
  218. *- set cursor on, if that's where it was
  219. SETCURSOR(nOldCursor)
  220. RETURN ''
  221.  
  222.  
  223.  
  224.