home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a042 / 2.ddi / DEMO / PROCLIB.PRG < prev    next >
Encoding:
Text File  |  1991-01-22  |  5.0 KB  |  187 lines
  1. * ' PROCLIB
  2. * ' 
  3. * ' Procedures for handling scrolling and clicking 
  4. * '
  5.  
  6. procedure scroll
  7. * '
  8. * ' Manages the actions associated with a scroll event
  9. * '
  10. * ' 
  11. * ' The following variables must be declared in the calling proc:
  12. * '
  13. * '     mthumb      - the current thumbwheel position
  14. * '     mscreensz   - the window size
  15. * '     mdisplines  - the window size minus 1
  16. * '     mtoprec     - the recno() of the 1st record in window
  17. * '     mplace      - the current place in the window
  18. * '     mredraw     - whether to redraw the window or not
  19. * '     
  20. * '     
  21. * ' Assumptions: 
  22. * '
  23. * '     the scrolled window is window 1
  24. * '     msfactor is calculated by the calling procedure
  25. * '         as follows:
  26. * '
  27. * '         msfactor = 1000 / (reccount() - mdisplines)
  28. * '
  29. * '                         
  30.     scrollbar = hmenu()
  31.     action = vmenu()
  32.     modif = mrow()
  33.     do scroll_win with scrollbar, action, modif
  34.     return
  35.     
  36.  
  37. procedure scroll_win
  38. parameters hm, vm, mr
  39.     *
  40.     * the following do..while clears the event.
  41.     * this was screwing up mrow() and dragging the mthumbwheel.
  42.     *
  43.     if .not. os() $ 'MSDOS'
  44.     do while .t.
  45.         if chkevent() = -1
  46.             exit
  47.         endif
  48.     enddo
  49.     endif
  50. *    if hm = 0
  51. *        return
  52. *    endif
  53.     select window 1
  54.     do case
  55.         case vm = 1            && Up Arrow
  56.             if mplace > 1
  57.                 dec mplace
  58.             else
  59.                 if reccount() <= mdisplines
  60.                   select window 0
  61.                   return
  62.                 endif
  63.                 mplace = 1
  64.                 mthumb = mthumb - msfactor
  65.                 if mthumb < 1
  66.                     mthumb = 1
  67.                 endif
  68. *                setscroll(hm,round(mthumb,0))
  69.                 skip -1
  70.                 dec mtoprec
  71.                 if bof()
  72.                     go top
  73.                     mtoprec = 1
  74.                 endif
  75.                 mredraw = .t.
  76. *                Do MySetScroll
  77.             endif
  78.         case vm = 2            && down Arrow
  79.             if mplace >= reccount()
  80.                select window 0
  81.                return
  82.             endif
  83.             if mplace < mscreensz
  84.                 inc mplace
  85.             else
  86.                 mplace = mscreensz
  87.                 mthumb = mthumb + msfactor
  88.                 if mthumb > 1000
  89.                     mthumb = 1000
  90.                 endif
  91. *                setscroll(hm,round(mthumb,0))
  92.                 skip 1
  93.                 inc mtoprec
  94.                 if mtoprec + mscreensz > reccount() + 1
  95.                     skip -1
  96.                     dec mtoprec
  97.                 endif
  98. *                Do MySetScroll
  99.                 mredraw = .t.
  100.             endif
  101.         case vm = 3            && Page Up
  102.             if reccount() <= mdisplines
  103.                 select window 0
  104.              return
  105.             endif
  106.             mthumb = mthumb - (msfactor * mdisplines)
  107.             if mthumb < 1
  108.                 mthumb = 1
  109.             endif
  110.             setscroll(hm,round(mthumb,0))
  111.             if recno() - mdisplines < 1
  112.                 go top
  113.             else
  114.                 skip -mdisplines
  115.             endif
  116.             if bof()
  117.                 go top
  118.             endif
  119.             mtoprec = recno()
  120.             mplace = 1
  121.             mredraw = .t.
  122.         case vm = 4            && Page down
  123.             if reccount() <= mdisplines
  124.               select window 0
  125.               return
  126.             endif
  127.             mthumb = mthumb + (msfactor * mdisplines)
  128.             if mthumb > 1000
  129.                 mthumb = 1000
  130.             endif
  131.             setscroll(hm,round(mthumb,0))
  132.             skip mdisplines
  133.             if recno() + mdisplines >= reccount()
  134.                 go bottom
  135.                 skip -mdisplines
  136.             endif
  137.             mtoprec = recno()
  138.             mplace = 1
  139.             mredraw = .t.
  140.         case vm = 5            && Drag mthumb
  141.             if reccount() <= mdisplines
  142.               select window 0
  143.               return
  144.             endif
  145.             mthumb = mr
  146.             setscroll(hm,mr)
  147.             y = mr / 1000
  148.             mcount = round(reccount() * y)
  149.             store iifn(mcount < 1,1,mcount) to mcount
  150.             store iifn(mcount > reccount() - mdisplines,;
  151.                 reccount() - mdisplines,mcount) to mcount
  152.             go mcount
  153.             mtoprec = recno()
  154.             mplace = 1
  155.             mredraw = .t.
  156.     endcase
  157.     select window 0
  158.  
  159.     return
  160.  
  161.  
  162. procedure click
  163.  
  164.     msaveplace = mplace
  165.     if mrow() > 0
  166.         mplace = mrow()
  167.         if mtoprec + (mplace - 1) > reccount()
  168.             ?? chr(7)
  169.             mplace = msaveplace
  170.         endif
  171.         go mtoprec + (mplace - 1)
  172.     endif
  173.  
  174.     return
  175.  
  176. ****************************
  177. procedure MySetScroll
  178. ****************************
  179. if reccount() <= mscreensz .or. mtoprec = 1
  180.   moffset = 1
  181. else
  182.  diviz = 1000.000 / (reccount() - mscreensz)
  183.  moffset = (mtoprec - 1) * diviz
  184. endif
  185. setscroll(1,round(moffset,0))
  186. return
  187.