home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 24 / CD_ASCQ_24_0995.iso / vrac / homonlib.zip / PROGRESS.BAS < prev    next >
BASIC Source File  |  1995-04-13  |  5KB  |  136 lines
  1. DEFINT A-Z
  2.  
  3. ' $INCLUDE: 'PARM.INC'
  4. ' $INCLUDE: 'SETCURS.INC'
  5. ' $INCLUDE: 'TRUEFALS.INC'
  6.  
  7. DECLARE SUB Progress (cur, msg$(), parm())
  8.  
  9.  
  10. 'External procedures:
  11.  
  12. DECLARE SUB BoxCalc (t, l, b, r, tall, wide)
  13. DECLARE SUB PopBox (t, l, b, r, wide, msg$(), parm())
  14. DECLARE SUB RestScreen (f$)
  15. DECLARE SUB SaveScreen (f$)
  16. DECLARE SUB SetView (t, b, parm())
  17. DECLARE FUNCTION TempName$ (p$)
  18. DECLARE FUNCTION VPage (p)
  19.  
  20. SUB Progress (cur, msg$(), parm()) STATIC
  21. '****************************************************************************
  22. 'Displays a percentage progress bar in a pop-up box.  The actual numeric
  23. ' progress is also shown.  The progress bar is updated in 5% increments.
  24. '
  25. '    parm(1) = top left row  0=Center
  26. '    parm(2) = top left column  0=Center
  27. '    parm(3) = box border type 1-4.  See SUB Panes() for numeric boxtypes.
  28. '    parm(4) = message justification  <0=Left  0=Center  >0=Right
  29. '    parm(5) = maximum: (cur/maximum)*100 = percentage complete
  30. '
  31. 'The function has three different uses.  The first will draw the box on the
  32. ' screen.  The second usage will update the progress bar in the currently
  33. ' displayed box.  The third will remove the box from the screen.
  34. '
  35. 'The cur argument is used to indicate what you want Progress() to do:
  36. '
  37. '    0 = New box
  38. '   >0 = Update current box  (cur/maximum)*100 = %
  39. '   <0 = Remove box
  40. '
  41. 'Only one box may be on screen at any one time.  If you specify an operation
  42. ' that conflicts with the current status of the sub (like requesting a new
  43. ' box when there's already one up) nothing will happen.
  44. '
  45. 'Once the box is on screen, you should not do any PRINTing.  This should not
  46. ' be a problem, as the main usage for this function is for when some major
  47. ' processing is going on and you want the user to know that their computer
  48. ' is actually doing something.
  49. '
  50. 'Another feature of Progress() is the fact that it will always appear for at
  51. ' least 1.5 seconds.  Have you ever used a program & had some message flash
  52. ' by before you got a chance to read it?  Pretty annoying, isn't it.
  53. '
  54. '****************************************************************************
  55.  
  56. STATIC oldrow                           'These must be kept to restore the
  57. STATIC oldcol                           'screen when finished.
  58. STATIC oldcursor
  59. STATIC savepage
  60. STATIC savefile$
  61.  
  62. STATIC onscreen                         'Is there already a box on screen?
  63. STATIC pstart!                          'When was the box put up?
  64.  
  65. STATIC brow                             'These must be kept to avoid
  66. STATIC bcol                             'recalculating them every update.
  67.  
  68. STATIC bar$                             'Might as well keep this too.
  69.  
  70. SELECT CASE cur                                        'What are we doing?
  71.      CASE 0                                  'A new box:
  72.           IF onscreen THEN EXIT SUB
  73.           bar$ = "└┴┴┴┴┴┴┴┴┴┴┴┴┴┴┴┴┴┴┘"
  74.           wide = LEN(bar$) + 2
  75.           tall = 3
  76.           FOR x = LBOUND(msg$) TO UBOUND(msg$)         'For comments on this
  77.                l = LEN(msg$(x))                        'section, see the
  78.                IF l > wide THEN wide = l               'other box functions.
  79.                tall = tall + 1
  80.           NEXT x
  81.           row1 = parm(1)
  82.           col1 = parm(2)
  83.           BoxCalc row1, col1, row2, col2, tall, wide
  84.           l = LEN(bar$) + 2
  85.           IF wide = l THEN
  86.                bcol = col1 + 1
  87.           ELSE
  88.                bcol = col1 + 1 + ((wide - l) \ 2)
  89.           END IF
  90.           brow = row2 - 2
  91.           oldrow = CSRLIN
  92.           oldcol = POS(0)
  93.           oldcursor = SetCursor(SCNONE)
  94.           savepage = VPage(0)
  95.           IF savepage = 0 THEN
  96.                savefile$ = TempName$("")
  97.                SaveScreen savefile$
  98.           ELSE
  99.                PCOPY 0, savepage
  100.           END IF
  101.           PopBox row1, col1, row2, col2, wide, msg$(), parm()
  102.           onscreen = TRUE
  103.           pstart! = TIMER
  104.  
  105.      CASE IS > 0                             'Update the current box:
  106.           IF NOT onscreen THEN EXIT SUB
  107.           COLOR parm(FGWT), parm(BGWT)
  108.           p = INT((cur / parm(5)) * 100)
  109.           LOCATE brow + 1, bcol + 8
  110.           PRINT USING "###"; p;
  111.           p = p \ 5
  112.           LOCATE brow, bcol
  113.           PRINT STRING$(p, 223); MID$(bar$, p + 1);
  114.  
  115.      CASE ELSE                               'Remove the box:
  116.           IF NOT onscreen THEN EXIT SUB
  117.           DO WHILE TIMER < pstart! + 1.5     'Make sure the box appears for
  118.           LOOP                               'at least 1.5 seconds.
  119.           IF savepage = 0 THEN
  120.                RestScreen savefile$
  121.                KILL savefile$
  122.           ELSE
  123.                PCOPY savepage, 0
  124.                x = VPage(savepage)
  125.           END IF
  126.           x = SetCursor(oldcursor)
  127.           COLOR parm(FGN), parm(BGN)
  128.           SetView -1, -1, parm()
  129.           LOCATE oldrow, oldcol
  130.           onscreen = FALSE
  131.  
  132. END SELECT
  133.  
  134. END SUB
  135.  
  136.