'===========================================================================
' Subject: COLOURFUL PERCENTAGE BAR DEMO      Date: 06-16-96 (16:34)       
'  Author: Jason Laviska                      Code: QB, QBasic, PDS        
'  Origin: jason.laviska@outdoor.com        Packet: MISC.ABC
'===========================================================================
'Percentage Bar by Jason Laviska.
'LaserArts' Library Function P-02-F
'--- Public Domain --- Use at your own risk ---

'    This is the percentage bar indicator as found in all the
'LaserCompare programs.  I had a few requests by internet email asking
'for this little code, however, I simply responded with "It's quite easy,
'just think about it."  Well, for those who never bothered, here it is.
'Its a simple subprogram that displays the percentage bar starting where
'your cursor is located.  You may have to modify it if you will be
'transmitting integers for the Current! or Total! parameters.

Delay& = 15000    ' <<<  Change delay, if needed (from 0 to 2147483647).

CLS
ScrnMsg 1, 1, 15, "LaserArts Percentage Bar Demo"
ScrnMsg 2, 1, 11, "  Programmer: Jason Laviska"
ScrnMsg 3, 1, 8, "------------------------------"
ScrnMsg 12, 1, 7, "Press any key for next demo."
VIEW PRINT 5 TO 11   'To prevent above lines from clearing on CLS

CLS
ScrnMsg 5, 1, 11, "The percentage bar can do both + and - numbers."
Temp% = 100
DO
  FOR Temp = 100 TO -100 STEP -1
    LOCATE 7, 1
    GOSUB Delays
    Percent Temp, 100, 50, 15, 7, 8
    IF Temp$ <> "" THEN EXIT DO
  NEXT Temp
  FOR Temp = -100 TO 100
    LOCATE 7, 1
    GOSUB Delays
    Percent Temp, 100, 50, 15, 7, 8
    IF Temp$ <> "" THEN EXIT DO
  NEXT Temp
LOOP

CLS
ScrnMsg 5, 1, 11, "You can use a different maximum values."
Delay& = INT(Delay& / 2)
DO
  FOR Temp = 0 TO 100
    FOR Temp2 = 7 TO 10
      LOCATE Temp2, 1
      Temp% = (Temp2 - 6) * 25
      GOSUB Delays
      Percent Temp, INT(Temp%), 50, 15, 7, 8
      IF Temp$ <> "" THEN EXIT DO
    NEXT Temp2
  NEXT Temp
LOOP

CLS
ScrnMsg 5, 1, 11, "You can have different lengths."
Temp% = 100
DO
  FOR Temp = 0 TO 100
    FOR Temp2 = 7 TO 10
      LOCATE Temp2, 1
      GOSUB Delays
      Percent Temp, 100, (Temp2 - 6) * 10, 15, 7, 8
      IF Temp$ <> "" THEN EXIT DO
    NEXT Temp2
  NEXT Temp
LOOP

CLS
ScrnMsg 5, 1, 11, "You can use different colors."
Delay& = Delay& * 2
DO
  FOR Temp = 1 TO 100
    LOCATE 7, 1
    GOSUB Delays
    IF Temp / 20 = Temp \ 20 OR Temp = 1 THEN
      FOR K% = 1 TO 3: Kr%(K%) = INT(RND * 14 + 1): NEXT K%
    END IF
    Percent Temp, 100, 50, Kr%(1), Kr%(2), Kr%(3)
    IF Temp$ <> "" THEN EXIT DO
  NEXT Temp
LOOP

VIEW PRINT
CLS
COLOR 7, 0
END

Delays:
COLOR 10
PRINT USING "#### of"; Temp;
PRINT Temp%,
'PRINT USING "####% "; Temp / Temp% * 100;  'UnRem this line to show %
FOR Paws& = 1 TO Delay&: NEXT Paws&
Temp$ = INKEY$
RETURN

SUB Percent (Current, Total, NumBlocks%, Kolor1%, Kolor2%, Kolor3%)

'Current ...... Number of X that are completed.
'Total ........ Maximum number of X that can be accomplished.
'NumBlocks% ... Length of the percentage bar.
'Kolor1% ...... Color of the blocks filled.
'Kolor2% ...... Color of the half block.
'Kolor3% ...... Color of the remaining/unused blocks.

Temp = ABS(Current) / Total            'Simply solve for percentage.
Temp% = Kolor1%                        'To make sure they are swapped
                                       'back, incase used later on as
                                       'variables.
IF Temp > 1 THEN
  Temp = 1                             'If > 100% then make it 100%
ELSE
  IF Current < 0 THEN
    SWAP Kolor1%, Kolor3%              'Swap colors if negative.
    Temp = ABS(1 - Temp)
  END IF
END IF
NumBlocks% = ABS(NumBlocks%)
Primary% = INT(Temp * NumBlocks%)         'Determine # of filled blocks
Secondary = Temp * NumBlocks% - Primary%  'Determine if 1/2 block needed
IF Primary% > 0 THEN                      'Display % of filled blocks
  COLOR Kolor1%
  PRINT STRING$(Primary%, "*");
' FOR X% = 1 TO Primary%               'UnRemark lines if percentage
'   PRINT "*";                         'bar will be crossing over to
' NEXT X%                              'the next line.  Rem line before
END IF                                 'this for-next loop.
IF Secondary >= .5 THEN                'Display half block, if needed.
  COLOR Kolor2%
  PRINT "*";
  Primary% = Primary% + 1
END IF
COLOR Kolor3%
IF Temp% <> Kolor1% THEN SWAP Kolor1%, Kolor3%   'Swap back if needed.
PRINT STRING$(NumBlocks% - Primary%, "*");       'Display remaining.
'FOR X% = 1 TO NumBlocks% - Primary%   'UnRemark lines if percentage
'  PRINT "*";                          'bar will be crossing over to
'NEXT X%                               'the next line.  Rem line before
                                       'this for-next loop.

END SUB

SUB ScrnMsg (X%, Y%, Kolor%, Message$)

LOCATE X%, Y%, 0
COLOR Kolor%, 0
PRINT Message$;

END SUB