home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 8 / CDASC08.ISO / VRAC / STATWIN.ZIP / STATWIN.PRG < prev    next >
Encoding:
Text File  |  1993-09-01  |  8.0 KB  |  271 lines
  1. *
  2. *    StatWin v2.5
  3. *
  4. *    Original STAWIN.PRG by Jim Schaffner
  5. *
  6. *    This version, STATWIN.PRG, with modifications by Cai Campbell
  7. *    (Compuserve ID 72622,1771)
  8. *   
  9. *    Displays a status bar across the screen when performing a long
  10. *    running task, such as indexing or reporting.  This is a Clipper 5
  11. *    version of the Foxpro STATWIN function, originally written by
  12. *    Duane Keeling of Keeling Consulting.
  13. *   
  14. *    To use this, first call StatInit() with the desired top/left
  15. *    coordinates of the display "window".  Coordinates are optional.
  16. *    Then call StatWin() from within your processing loop, passing
  17. *    the total to be processed, and the current process count.  There
  18. *    are optional parameters for a display message, a logical for
  19. *    displaying estimated completion time, window color, percentage bar
  20. *    "template" color, and percentage bar "fill" color.
  21. *   
  22. *    Here's an example:
  23. *   
  24. *    StatInit()
  25. *    DO WHILE .NOT. EOF()
  26. *       StatWin ( LASTREC(), RECNO(), "Percent processed:", .T. )
  27. *       SKIP
  28. *    END DO
  29. *    StatExit()
  30. *   
  31. *    If you fail to call StatExit(), you will get some strange display results
  32. *    after the process is finished.
  33. *   
  34. *    Compile with /a/m/n.
  35. *   
  36. *    Enjoy!
  37. *
  38.  
  39. // "borrowed" from Clipper 5.2 COMMON.CH (allows compile in 5.01)
  40.  
  41. #xcommand DEFAULT <v1> TO <x1> [, <vn> TO <xn> ]                        ;
  42.       =>                                                            ;
  43.       IF <v1> == NIL ; <v1> := <x1> ; END                           ;
  44.       [; IF <vn> == NIL ; <vn> := <xn> ; END ]
  45.  
  46.  
  47. #include "setcurs.ch"
  48. #include "box.ch"
  49.  
  50. MEMVAR nStatCounter, cStatMsg
  51.  
  52. // Static variables:
  53.  
  54. //  ?Sav???         -> save video attributes, screen, etc.
  55. //  nTop ... nRight -> screen coordinates for display
  56. //  lFirst          -> denotes first pass through routine
  57. //  cEstMessage     -> "estimated time left" message
  58. //  lWinSize        -> logical for window size, defaults to .F., small window
  59.  
  60. STATIC cSavWin,cSavClr,nSavCsr
  61. STATIC nSavRow,nSavCol
  62. STATIC nTop,nLeft,nBottom,nRight
  63. STATIC lFirst
  64. STATIC cEstMessage := "Hours Left:  "
  65. STATIC lWinSize
  66.  
  67. *
  68. *   StatInit() - initialize the status display
  69. *
  70.  
  71. FUNCTION StatInit ( nT, nL, lSize )
  72.  
  73.    PUBLIC nStatCounter := 0  // Public variables needed for keeping track of
  74.    PUBLIC cStatMsg           // "internal" processes, and allowing for 
  75.                  // dynamic Status Window header changes.
  76.  
  77.    nTop := IF ( nT == NIL, 0, nT )
  78.    lFirst := .T.
  79.  
  80.    IF lSize == NIL
  81.       lWinSize := .F.
  82.    ELSE
  83.       lWinSize := lSize
  84.    END IF
  85.  
  86.    IF nTop > MAXROW() - 5
  87.       nTop := MAXROW() - 5
  88.    END IF
  89.  
  90.    nLeft := IF ( nL == NIL, 0, nL )
  91.    
  92.    IF nLeft > MAXCOL() - IF ( lWinSize, 54, 29 )
  93.       nLeft := MAXCOL() - IF ( lWinSize, 54, 29 )
  94.    END IF
  95.       
  96.    nRight := nLeft + IF ( lWinSize, 53, 28 )
  97.    nBottom := nTop + 4
  98.  
  99.    cSavWin := SAVESCREEN ( nTop, nLeft, nBottom+1, nRight+1 )
  100.  
  101.    cSavClr := SETCOLOR()
  102.    nSavCsr := SETCURSOR()
  103.    nSavRow := ROW()
  104.    nSavCol := COL()
  105.  
  106.    SETCURSOR(SC_NONE)
  107.  
  108. RETURN NIL
  109.  
  110. *
  111. *   StatWin() - display the status bar
  112. *
  113.  
  114. FUNCTION StatWin ( nTotal,;        // Size of data being processed
  115.            nCurrent,;      // Current position in data
  116.            cStatMsg,;      // Header message for window
  117.            lEstimate,;     // If true, display estimated time left
  118.            cMenuColor,;    // Color of menu
  119.            cBeforeColor,;  // Color of percentage bar template
  120.            cBarColor )     // Color of percentage bar, filling template
  121.  
  122.    LOCAL nWidth, nBlock, nBlocks, nEst, nPct
  123.    LOCAL nBtm, nPctPos, c1stQuarter, c2ndQuarter, c3rdQuarter , cHalf, cFull
  124.  
  125.    STATIC nStart
  126.    
  127.    nStatCounter += 1  // Counter for "internal" processes
  128.  
  129.    // Characters for both the "long" and "short" percent bar.
  130.  
  131.    c1stQuarter := CHR ( 176 )  //  ░
  132.    c2ndQuarter := CHR ( 177 )  //  ▒
  133.    c3rdQuarter := CHR ( 178 )  //  ▓
  134.    cHalf       := CHR ( 221 )  //  ▌
  135.    cFull       := CHR ( 219 )  //  █
  136.  
  137.    DEFAULT cStatMsg to ""           // Default to NULL display message
  138.    DEFAULT lEstimate to .F.         // Default to NO estimating
  139.    DEFAULT cBeforeColor to "B/B"    // Default bar template color Blue
  140.    DEFAULT cBarColor to "GR+/B"     // Default bar color Yellow on Blue
  141.    DEFAULT cMenuColor to "B/W"      // Default color to Blue on White
  142.  
  143.    nWidth := IF ( lWinSize, 50, 25 )
  144.    
  145.    nPct := IF ( nTotal > 0, ROUND ( ( nCurrent * 100 ) / nTotal, 0 ), 100 )
  146.    
  147.    // This will prevent screen overrun and percentages > 100
  148.    nPct := IF ( nPct > 100, 100, nPct )  
  149.  
  150.    IF .NOT. ( cStatMsg == "" )
  151.       IF LEN ( cStatMsg ) > IF ( lWinSize, 46, 20 )
  152.      cStatMsg := LEFT ( cStatMsg, IF ( lWinSize, 46, 20 ) )
  153.       END IF
  154.       nPctPos := nLeft + IF ( lWinSize, 24, 12 ) + LEN ( cStatMsg ) / 2 + 1
  155.    ELSE
  156.       nPctPos := nLeft + IF ( lWinSize, 24, 12 )
  157.    END IF
  158.  
  159.    IF lFirst
  160.     
  161.       IF .NOT. lEstimate          // If not displaying estimated time
  162.      nBtm := nBottom - 1      // decrease the size of the display.
  163.       ELSE
  164.      nBtm := nBottom
  165.      nStart := SECONDS()
  166.      cEstMessage := "Hours Left:  "
  167.       END IF
  168.       
  169.       SETCOLOR ( "B/N" )          // Draw Shadow
  170.       @ (nTop + 1), (nLeft + 1) CLEAR TO (nBtm + 1), (nRight + 1)
  171.       SETCOLOR ( cMenuColor )
  172.       @ nTop, nLeft, nBtm, nRight BOX B_DOUBLE_SINGLE + SPACE(1)
  173.       SETCOLOR ( cBeforeColor )
  174.       @ nTop + 2, nLeft + 2 SAY REPLICATE ( cFull, nWidth )
  175.       SETCOLOR ( cMenuColor )
  176.       
  177.       IF .NOT. empty(cStatMsg)            // If we have a message then
  178.      @ nTop+1, nLeft + ( IF ( lWinSize, 52, 26 ) - LEN ( cStatMsg ) ) / 2 SAY cStatMsg
  179.       END IF
  180.  
  181.       lFirst := .F.
  182.  
  183.    ELSE
  184.  
  185.       IF lEstimate
  186.      ShowTimeLeft ( nPct, nStart )
  187.       END IF
  188.  
  189.    END IF
  190.  
  191.    nBlock  := INT ( 100 / nWidth )
  192.  
  193.    nBlocks := INT ( nPct / nBlock )        // How many blocks do I need?
  194.  
  195.    @ nTop+1, nPctPos SAY STR ( nPct, 3 ) + "%"       // Display percentage
  196.  
  197.    SETCOLOR ( cBarColor )
  198.    IF lWinSize
  199.       DO CASE
  200.      CASE nPct / 2 # INT ( nPct / 2 )  // Add a 1/2 block if needed
  201.         @ nTop + 2, nLeft + 2 SAY REPLICATE ( cFull, nBlocks ) + cHalf
  202.      OTHERWISE                         // and display the bar...
  203.         @ nTop + 2, nLeft + 2 SAY REPLICATE ( cFull, nBlocks )
  204.       END CASE
  205.    ELSE
  206.       DO CASE
  207.      CASE nPct % 4 == 1       // Add a 1/4 block if needed
  208.         @ nTop + 2, nLeft + 2 SAY REPLICATE ( cFull, nBlocks ) + c1stQuarter
  209.      CASE nPct % 4 == 2       // Add a 1/2 block if needed
  210.         @ nTop + 2, nLeft + 2 SAY REPLICATE ( cFull, nBlocks ) + c2ndQuarter
  211.      CASE nPct % 4 == 3       // Add a 3/4 block if needed
  212.         @ nTop + 2, nLeft + 2 SAY REPLICATE ( cFull, nBlocks ) + c3rdQuarter
  213.      OTHERWISE                // and display the bar...
  214.         @ nTop + 2, nLeft + 2 SAY REPLICATE ( cFull, nBlocks )
  215.       END CASE
  216.    END IF
  217.    SETCOLOR ( cMenuColor )
  218.  
  219. RETURN " "
  220.      
  221. *
  222. *   Calculate method in which to display time left then display it.
  223. *
  224.  
  225. PROCEDURE ShowTimeLeft ( nPercent, nBegin )
  226.  
  227.    LOCAL nUnits
  228.  
  229.    nUnits := ( ( SECONDS() - nBegin ) * 100 ) / nPercent
  230.    nUnits := ROUND ( nUnits - nUnits * nPercent * .01, 2 )
  231.       
  232.    IF cEstMessage == "Hours Left:  " .AND. nUnits < 3600
  233.       cEstMessage := "Minutes Left:"
  234.    END IF
  235.    IF cEstMessage == "Minutes Left:" .AND. nUnits < 60
  236.       cEstMessage := "Seconds Left:"
  237.    END IF
  238.    IF cEstMessage == "Seconds Left:" .AND. nUnits >= 60
  239.       cEstMessage := "Minutes Left:"
  240.    END IF
  241.  
  242.    DO CASE
  243.       CASE cEstMessage == "Hours Left:  "
  244.      nUnits /= 3600
  245.       CASE cEstMessage == "Minutes Left:"
  246.      nUnits /= 60
  247.    END CASE
  248.  
  249.    // Display estimated units left.  Maximum display = 999.99
  250.  
  251.    @ nTop + 3, nLeft + IF ( lWinSize, 16, 4 ) SAY cEstMessage
  252.    @ nTop+3, nLeft + IF ( lWinSize, 32, 20 ) SAY PADR ( LTRIM ( STR ( nUnits ) ), 6 )
  253.  
  254. RETURN
  255.  
  256. *
  257. *   StatExit() - exit from the status display & restore attributes
  258. *
  259.  
  260. FUNCTION StatExit()
  261.  
  262.    RESTSCREEN ( nTop, nLeft, nBottom + 1, nRight + 1, cSavWin )
  263.  
  264.    SETCOLOR ( cSavClr )
  265.    SETCURSOR ( nSavCsr )
  266.    SETPOS ( nSavRow, nSavCol )
  267.  
  268.    cSavWin := ""
  269.  
  270. RETURN NIL
  271.