'===========================================================================
' Subject: PERCENT BOX                        Date: 06-22-96 (00:00)       
'  Author: Charles Godard                     Code: QB, QBasic, PDS        
'  Origin: FidoNet QUIK_BAS Echo            Packet: TEXT.ABC
'===========================================================================
'Percent.bas by Charles Godard 06/22/96
'Opens, maintains, then closes a popup box to be used when
'copying a file or performing other task, to pacify the user
'while he waits.

'Switch% = 0 turns it on
'Switch% = 1 maintains it
'Switch% = 2 closes it
'Pass to it, a number between 1 and 100 and the proper switch
'PercentBox 0, 0  'you must 1st open the box
'PercentBox 1, (Percent%) 'maintain it with this.  Percent%
'    MUST be in parenthesis or else MUST be a numeric value.
'PercentBox 2, 0 'close it with this
'give it a number between 0 and 100, and increment it as needed
'the delay's, STEP, and for/next are for demo only

'I haven't tested this except in this program.  It could need some
'modification when run in a real program. <Oh well> :)

'inspired by reading in the conference.. Wellerstein to Goldbloom
'BTW, Alex, I liked yours, never got James' to run. PB, I guess :)

'I feel like the shipwrecked sailor, sending messages in a bottle.
'If anyone sees this message in a bottle, I sure would like to
'hear about it.  I've been posting messages since feb, and the
'only response that I have gotten was the one the other day from
'Joe.  I'm hoping that I am now making the trip! :)

DEFINT A-Z
DECLARE SUB printScreen (Tr, Lc, H, W, Fg, Bg)
DECLARE SUB copyScreen (Tr, Lc, H, W)
DECLARE SUB PercentBox (Switch%, Percent%)

TYPE Sdata
   Char  AS STRING * 1
   Attr AS STRING * 1
END TYPE
REDIM SHARED x(25, 80) AS Sdata
DIM SHARED Bg, Fg
CLS
SCREEN 0
'put stuff on screen
COLOR &H7, 1: FOR i = 292 TO 678: PRINT i; : NEXT i

PercentBox 0, 0

Dly = 1: GOSUB delay
   FOR Percent% = 1 TO 100 STEP 9
      PercentBox 1, (Percent%)  'you can change the name of
      GOSUB delay               'Percent% and remove the ()
   NEXT Percent%
GOSUB delay

PercentBox 2, 0

END

delay:
T& = TIMER: DO WHILE (ABS(T& - TIMER) < Dly) AND INKEY$ = "": LOOP
RETURN

SUB copyScreen (Tr, Lc, H, W)

'Attr = SCREEN(Tr + 1, Lc + 1, 1)
'Fg = Attr AND &HF
'Bg = Attr \ &H10

FOR cr = Tr TO Tr + H
   FOR cc = Lc TO Lc + W
      x(cr, cc).Char = CHR$(SCREEN(cr, cc))
      x(cr, cc).Attr = CHR$(SCREEN(cr, cc, 1))
   NEXT cc
NEXT cr

END SUB

SUB PercentBox (Switch%, Percent%)
Tr = 11: Lc = 20: W = 43: H = 4: 'Fg = &H4: Bg = &H4:

STATIC boxOpen

SELECT CASE Switch%
  CASE IS = 0  'open the box
      'read data from the screen
      CALL copyScreen(Tr, Lc, H, W)
      'put popup on screen
      FOR cr = Tr TO Tr + H
            LOCATE cr, Lc
            COLOR 4, 4
            PRINT STRING$(W, " ")
      NEXT cr
     
      boxOpen = 1
        
            'set up border styles
            BDRtl = 218: BDRtr = 191: BDRlc = 192: BDRrc = 217: 'corners
            BDRv = 179: BDRh = 196:          'horizontal, vertical sides

         'Bdr top left
         COLOR &HE, 4
         LOCATE Tr, Lc: PRINT CHR$(BDRtl);  'top lt corner BDR
         'top BDR top horizontal
         FOR i = Tr TO Tr + W - 2: PRINT CHR$(BDRh); : NEXT i
         'top BDR Rt corner
         LOCATE Tr, Lc + W: PRINT ; CHR$(BDRtr);
         'Lt BDR vertical
         FOR i = Tr + 1 TO Tr + H - 1: LOCATE i, Lc: PRINT CHR$(BDRv); : LOCATE i, Lc + W: PRINT CHR$(BDRv); : NEXT i
         'bottom rt corner
         LOCATE Tr + H, Lc + W: PRINT CHR$(BDRrc);
         'left corner
         LOCATE Tr + H, Lc: PRINT CHR$(BDRlc)
         'right horizontal
         LOCATE Tr + H, Lc + 1: FOR i = Lc TO Lc + W - 2:
         PRINT CHR$(BDRh); : NEXT

  CASE IS = 1 'maintain box
         IF boxOpen = 1 THEN
             LOCATE Tr, Lc + 19: PRINT STR$(Percent%); "%"
             Percent% = (Percent% / 100) * 40
             LOCATE Tr + 2, Lc + 2: PRINT STRING$(Percent%, "Û")
         END IF
 
  CASE IS = 2
      'Close PercentBox
      IF boxOpen = 1 THEN
       boxOpen = 0
       CALL printScreen(Tr, Lc, H, W, Fg, Bg)
      END IF
  CASE ELSE
END SELECT

END SUB

SUB printScreen (Tr, Lc, H, W, Fg, Bg)

COLOR Fg, Bg

FOR cr = Tr TO Tr + H
   FOR cc = Lc TO Lc + W
      LOCATE cr, cc
      Attr = ASC(x(cr, cc).Attr)
      Fg = Attr AND &HF
      Bg = Attr \ &H10
      COLOR Fg, Bg
      PRINT x(cr, cc).Char;
   NEXT cc
NEXT cr

END SUB