home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / basic / library / qb_pds / screen / gauge / gaugebar.bas next >
Encoding:
BASIC Source File  |  1994-04-06  |  8.9 KB  |  317 lines
  1. '*****************************GAUGEBAR.BAS********************************
  2. '
  3. 'JRD NOTE:
  4. '
  5. 'Makes a gauge bar, similar to Norton's Utilities Format gauge bar.
  6. 'Not identical as this is written in QuickBASIC and I didn't spend a lot
  7. 'of time verifying that all numbers work.
  8. 'Since floating point numbers (single and double precision) are slower
  9. 'and take more memory; made the BarGraph SUB with LONG integers. That
  10. 'means that for some graph lengths "100%" will fall short or long of the
  11. 'bar length... but, GAUGEBAR.BAS is better than nothing... which is
  12. 'why I made this program. I needed it and there was nothing out there.
  13. '
  14. 'First attempt with this weirdness was in my file ADDNUM.BAS
  15. 'The correct way is to include the BarGraph SUB as part of loop that does
  16. 'the work. See ADDNUM.BAS, a classic use of this little trick.
  17. '
  18. 'Another program I had to make 'cause  I couldn't find it anywhere...
  19. '
  20. 'Can use to makes a "File Read" or any other kind of gauge bar
  21. '
  22. 'Can simulate a process by using the Pause2 time delay
  23. '
  24. '
  25. 'John De Palma on CompuServe 76076,571
  26. '
  27. '4/6/94
  28. '
  29. DEFINT A-Z
  30. ' $INCLUDE: 'qb.bi'
  31. DECLARE SUB Pause2 ()
  32. DECLARE SUB Pause (Seconds!)
  33. DECLARE SUB BarGraph (Counter&, LineNum&, BarLength%, Row%, Col%)
  34. DECLARE SUB DrawBarGraph (Row%, Col%, BarLength%)
  35. DECLARE SUB TimedBarGraph (Seconds!, BarLength%, Row%, Col%)
  36. DECLARE SUB LocateIt (Row%, Text$)
  37. DECLARE SUB WaitKey ()
  38. DECLARE SUB CursorOff ()
  39. DECLARE SUB CursorOn ()
  40.  
  41. DECLARE FUNCTION Center% (Text$)
  42. DECLARE FUNCTION BufferedKeyInput$ (n%)
  43.  
  44. DIM SHARED Regs AS RegType
  45. 'CONST False = 0                   'these are in QB.BI
  46. 'CONST True = -1
  47.  
  48.     Copyright$ = "■Copyright (c) 1994 LearnWare (c) ■ John De Palma■"
  49.     Counter& = 1000          'using LONG on purpose
  50.     LineNum& = 1             'see ADDNUM.BAS
  51.     BarLength% = 33          'default
  52.     Row% = 14
  53.     Col% = 0                 'centers on screen, I did =NOT= check code for
  54.     COLOR 15, 1              'non centered placement of the gauge-bar
  55.     SCREEN 0                 'this was tough enough
  56.     WIDTH 80, 25
  57.     CLS
  58.  
  59.     Text$ = "How Long a Gauge-Bar? (15 to 50)"
  60.     CALL LocateIt(4, Text$)
  61.     Text$ = SPACE$(2)
  62.     COLOR 11, 0
  63.     CALL LocateIt(6, Text$)
  64.     CursorOn
  65.     LOCATE 6, Center%(Text$)
  66.     Bar$ = BufferedKeyInput$(2)
  67.     CursorOff
  68.     BarLength% = VAL(Bar$)
  69.     IF BarLength% > 50 THEN BarLength% = 50
  70.  
  71.     Text$ = "How Many SECONDS to Run (1 to 30)"
  72.     COLOR 14, 1
  73.     CALL LocateIt(10, Text$)
  74.     Text$ = SPACE$(2)
  75.     COLOR 11, 0
  76.     CALL LocateIt(12, Text$)
  77.     CursorOn
  78.     LOCATE 12, Center%(Text$)
  79.     Seconds$ = BufferedKeyInput$(2)
  80.     CursorOff
  81.     Seconds! = VAL(Seconds$)
  82.    
  83.     CALL TimedBarGraph(Seconds!, BarLength%, Row%, Col%)
  84.     
  85.     Text$ = "Now to see a 'File Read' Version"
  86.     CALL LocateIt(18, Text$)
  87.     Text$ = "press a Key.... or <Esc> to EXIT"
  88.     CALL LocateIt(19, Text$)
  89.     WaitKey
  90.  
  91.     CLS
  92.     Text$ = "How Long a Gauge-Bar? (15 to 50)"
  93.     CALL LocateIt(4, Text$)
  94.     Text$ = SPACE$(2)
  95.     COLOR 11, 0
  96.     CALL LocateIt(6, Text$)
  97.     CursorOn
  98.     LOCATE 6, Center%(Text$)
  99.     Bar$ = BufferedKeyInput$(2)
  100.     CursorOff
  101.     'STOP
  102.     BarLength% = VAL(Bar$)
  103.     IF BarLength% > 50 THEN BarLength% = 50
  104.  
  105.     Text$ = "FAST(1)  Medium(2) or Slow(3) (1, 2, or 3)"
  106.     COLOR 14, 1
  107.     CALL LocateIt(10, Text$)
  108.     Text$ = SPACE$(1)
  109.     COLOR 11, 0
  110.     CALL LocateIt(12, Text$)
  111.     CursorOn
  112.     LOCATE 12, Center%(Text$)
  113.     Seconds$ = BufferedKeyInput$(1)
  114.     IF Seconds$ = "" THEN Seconds$ = "2"
  115.     CursorOff
  116.     Seconds! = VAL(Seconds$)
  117.     Col% = 0
  118.  
  119.         'this next piece simulates a file read. You call the BarGraph
  120.         'SUB each time you read a file line... After first finding out
  121.         'how many lines are in the file and setting that to Counter&
  122.         'see ADDNUM.BAS for this code example
  123.  
  124.         FOR i = 1 TO Counter&
  125.          CALL BarGraph(Counter&, LineNum&, BarLength%, Row%, Col%)
  126.          LineNum& = LineNum& + 1    'simulates reading a file in a loop
  127.                  IF Seconds! = 1 THEN       'no pause, just loops and runs
  128.                  ELSEIF Seconds! = 2 THEN   'these time pauses are here for demo only!
  129.                         PLAY "p64"          'the shortest pause of .015625 seconds
  130.          ELSE
  131.                         Pause2              'pauses for about .054945 seconds or less
  132.          END IF
  133.     NEXT
  134.          Pause (2)
  135.          COLOR 11, 0
  136.          LOCATE Row% + 4, 40: PRINT "DONE!"
  137.          WaitKey
  138.          COLOR 7, 0
  139.  
  140. SUB BarGraph (Counter&, LineNum&, BarLength%, Row%, Col%)
  141. STATIC Fraction&, Num%, PerCent&, DrawFlag%, SaveRow%, SaveCol%
  142.    
  143.         IF DrawFlag% = True THEN GOTO SkipDraw
  144.             SaveRow% = CSRLIN
  145.             SaveCol% = POS(0)
  146.             CALL DrawBarGraph(Row%, Col%, BarLength%)
  147.             DrawFlag% = True
  148.             IF BarLength% >= Counter& THEN EXIT SUB
  149.             Fraction& = Counter& / BarLength%
  150.             PerCent& = Fraction&
  151.             Num% = 1
  152.        
  153. SkipDraw:  
  154.  
  155.                 IF Fraction& = LineNum& THEN
  156.                     COLOR 15, 4
  157.                     LOCATE Row% + 1, Col% + 2
  158.                     PRINT STRING$(Num%, " ")
  159.                     LOCATE Row% + 1, Col% + (BarLength% \ 2) + 1
  160.                     COLOR 15, 4
  161.                     PRINT LEFT$(LTRIM$(STR$(Fraction& / 10)), 2) + "%"
  162.                     Num% = Num% + 1
  163.                     Fraction& = Fraction& + PerCent&
  164.                 IF Fraction& >= Counter& - 1 THEN
  165.                     LOCATE Row% + 1, Col% + (BarLength% \ 2) + 1
  166.                     PRINT "100%"
  167.                     LOCATE SaveRow%, SaveCol%
  168.                  END IF
  169.                 COLOR 15, 1
  170.         END IF
  171.  
  172. END SUB
  173.  
  174. FUNCTION BufferedKeyInput$ (n%) STATIC
  175.  
  176.      'DIM Regs AS RegType
  177.      b$ = CHR$(n% + 1) + SPACE$(n% + 1) + CHR$(13)   'see EXPLANATION
  178.  
  179.      Regs.ax = &HA00                     'BufferkeyInput MS-DOS Function
  180.      Regs.ds = VARSEG(b$)                'segment of string b$
  181.      Regs.dx = SADD(b$)                  'offset of string b$
  182.      'using qb.bi INCLUDE file
  183.      CALL INTERRUPTX(&H21, Regs, Regs)
  184.      count% = ASC(MID$(b$, 2, 1))        'length of the string b$
  185.  
  186.      'EXPLANATION of b$ command
  187.      'byte one of b$ contains the working -size- of the string.
  188.      'byte two is the -actual size- of the string that MS-DOS uses.
  189.      'last byte is a carriage return which is needed to prevent
  190.      'a STRING SPACE CORRUPT Run Time error when you use this
  191.      'so the return string starts at byte three (3), and does NOT
  192.      'include the carriage return
  193.      'see below
  194.      BufferedKeyInput$ = MID$(b$, 3, count%)
  195.  
  196. END FUNCTION
  197.  
  198. FUNCTION Center% (Text$)
  199.     Center% = 41 - LEN(Text$) \ 2
  200. END FUNCTION
  201.  
  202. SUB CursorOff
  203.     LOCATE , , 0
  204. END SUB
  205.  
  206. SUB CursorOn
  207.     LOCATE , , 1, 4, 7
  208. END SUB
  209.  
  210. SUB DrawBarGraph (Row%, Col%, BarLength%)
  211.  
  212.         'SaveRow% = CSRLIN
  213.         'SaveCol% = POS(0)
  214.         'got to have the next to display "Percent Completed"
  215.         IF BarLength% <= 15 THEN BarLength% = 15
  216.         BackGround$ = STRING$(BarLength%, 176)
  217.         IF Col% = 0 THEN
  218.             Col% = 41 - ((BarLength% + 4) \ 2)
  219.         END IF
  220.             'single line box
  221.             LOCATE Row%, Col%
  222.             PRINT "┌Percent Completed" + STRING$(BarLength% - 15, "─") + "┐"
  223.             LOCATE Row% + 1, Col%
  224.             PRINT "│" + SPACE$(BarLength% + 2) + "│"
  225.             LOCATE Row% + 2, Col%
  226.             PRINT "└" + STRING$(BarLength% + 2, "─") + "┘"
  227.             LOCATE Row% + 1, Col% + 2
  228.             COLOR 15, 0
  229.             PRINT BackGround$
  230.             COLOR 15, 1
  231.             'LOCATE SaveRow%, SaveCol%
  232.  
  233. END SUB
  234.  
  235. SUB LocateIt (Row%, Text$)
  236.      LOCATE Row%, Center(Text$)
  237.      PRINT Text$;
  238. END SUB
  239.  
  240. SUB Pause (Seconds!)
  241.  
  242.     Synch! = TIMER
  243.     DO                          'looping changes the Start! time to
  244.                 Start! = TIMER      'synchronize to the system timer
  245.     LOOP WHILE Start! = Synch!  'Seconds! must be SINGLE to get fractions
  246.                                     'of a second
  247.     DO
  248.         kee$ = INKEY$
  249.     LOOP UNTIL TIMER > (Start! + Seconds!) OR LEN(kee$)
  250.                           
  251.                                     'put Kee$ in just in case we pass midnight
  252.     WHILE INKEY$ <> "": WEND    'delete that key stroke
  253. END SUB
  254.  
  255. SUB Pause2
  256.  
  257.     Synch! = TIMER
  258.     DO                              'looping changes the Start! time to
  259.                 Start! = TIMER      'synchronize to the system timer
  260.     LOOP WHILE Start! = Synch!      'Seconds! must be SINGLE to get fractions
  261.                                     'normally used to synch a timer
  262.                                     'in this case, the briefest pause
  263. END SUB                             'about .054945 seconds or less
  264.  
  265. SUB TimedBarGraph (Seconds!, BarLength%, Row%, Col%)
  266. STATIC Fraction!, Num%, PerCent!, DrawFlag%, SaveRow%, SaveCol%
  267.   
  268.         IF DrawFlag% = True THEN GOTO SkipDraw2
  269.             SaveRow% = CSRLIN
  270.             SaveCol% = POS(0)
  271.             CALL DrawBarGraph(Row%, Col%, BarLength%)
  272.             DrawFlag% = True
  273.             'STOP
  274.             BarLength! = BarLength%
  275.             Fraction! = Seconds! / BarLength%
  276.             PerCent! = Fraction!
  277.             Number! = 100 / BarLength!
  278.             AddPerCent! = Number!
  279.             Num% = 1
  280.       
  281. SkipDraw2:
  282.             DO
  283.  
  284.                 Start! = TIMER      'synchronize to the system timer
  285.                 DO
  286.         
  287.                 LOOP UNTIL TIMER >= (Start! + PerCent!)
  288.                           
  289.                     COLOR 15, 4
  290.                     LOCATE Row% + 1, Col% + 2
  291.                     PRINT STRING$(Num%, " ")
  292.                     LOCATE Row% + 1, Col% + (BarLength% \ 2)
  293.                     COLOR 15, 4
  294.                     PRINT LEFT$(LTRIM$(STR$(Number!)), 2) + "%"
  295.                     Num% = Num% + 1
  296.                     Number! = Number! + AddPerCent!
  297.                     Fraction! = Fraction! + PerCent!
  298.                         IF Fraction! >= Seconds! THEN
  299.                             LOCATE Row% + 1, Col% + (BarLength% \ 2)
  300.                             PRINT " 100% "
  301.                             LOCATE SaveRow%, SaveCol%
  302.                         END IF
  303.                     COLOR 15, 1
  304.              LOOP WHILE Fraction! < Seconds!
  305. END SUB
  306.  
  307. SUB WaitKey
  308.  
  309.     WHILE INKEY$ <> "": WEND
  310.     DO
  311.         kee$ = INKEY$
  312.     LOOP UNTIL LEN(kee$)
  313.     IF kee$ = CHR$(27) THEN END
  314.  
  315. END SUB
  316.  
  317.