SUB Frame (TopRow%, leftCol%, botRow%, rightCol%, boxType%, boxFg%, boxBg%, filFg%, filBg%, fillChar%, shadow%, header$) STATIC

'                     +******************************+    message 2 of 4
'                     *          FRAME.BAS           *
'                     *                              *
'                     *   by: Lawrence Stone, 1990   *
'                     +******************************+
'
'+**************************************************************************+
'*   boxType% 1 = ÚÄÄÄÄ¿  2 = ÉÍÍÍÍ»  3 = ÖÄÄÄÄ·  4 = ÕÍÍÍ͸                *
'*                ³    ³      º    º      º    º      ³    ³                *
'*                ÀÄÄÄÄÙ      ÈÍÍÍͼ      ÓÄÄÄĽ      ÔÍÍÍ;                *
'*   header tees =  ´Ã          µÆ          ´Ã          µÆ                  *
'*                                                                          *
'*   If filFg% = 0 *AND* filBg% = 0 then the box does not clear the middle  *
'*   otherwise, the box clears the middle with the colors called for.       *
'*                                                                          *
'*   fillChar% is the ASCII number for the character to fill the box with.  *
'*   Example: fillChar% = 32 is " " or fillChar% = 176 is "°"               *
'*                                                                          *
'*   shadow% if true, computes the character and color attribute along the  *
'*   right and bottom side of the box and prints the appropriate shadow.    *
'*                                                                          *
'*   If header$ <> "" then box centers this message at the top and inside   *
'*   of the appropriate ´ Ã characters.  Otherwise, if header$ = "" then    *
'*   the box is a non-titled box.                                           *
'*                                                                          *
'*   SPECIAL NOTE:  This subprogram is STATIC.  By making it STATIC, QB     *
'*   doesn't have to re-initialize variables after it is CALLed the first   *
'*   time.  This produces faster execution.  If your program is going to    *
'*   need all the memory it can grab then, remove the STATIC keyword from   *
'*   the top line of this subprogram.                                       *
'+**************************************************************************+
    DEFINT A-Z                       'message 3 of 4
 
    GOSUB InitiateBox

    '*** Is the box titled? If so then print it centered on top line of box.
    IF LEN(header$) THEN
        temp$ = leftT$ + " " + header$ + " " + rightT$

        '*** How long should horz$ be to left and right of the header$?
        portion = ((boxWide - LEN(temp$)) \ 2)

        '*** Print top-left side of box, as well as, the header string.
        PRINT topLeft$; STRING$(portion, horz$); temp$;

        '*** Adjust the right side if it isn't the same length as the left.
        IF ((boxWide - LEN(temp$)) MOD 2) THEN
            PRINT STRING$(portion + 1, horz$); topRight$;

        '*** No adjustments are needed if left and right side are equal length
        ELSE
            PRINT STRING$(portion, horz$); topRight$;
        END IF
  
    '*** If the box is untitled then draw the top line of box sans header
    ELSE
        PRINT topLeft$; STRING$(boxWide, horz$); topRight$;
    END IF
 
    '*** Draw the sides of the box
    FOR boxRow = TopRow + 1 TO botRow - 1
        COLOR boxFg, boxBg
        LOCATE boxRow, leftCol
        PRINT vert$;                            ' Draw left side of box
        IF clearBox THEN                        ' Do we clear the box?
            COLOR filFg, filBg
            PRINT STRING$(boxWide, fillChar);   ' Clear box with the fillChar
            COLOR boxFg, boxBg
        END IF
        LOCATE boxRow, rightCol
        PRINT vert$;                            ' Draw the right side of box
        IF shadow THEN                          ' Do we draw a shadow?
            FOR B = 1 TO 2
                csrPos = rightCol + B           ' Calculate the cursor column
                GOSUB ConfigShadow              ' Calculate and draw shadow
            NEXT
        END IF
    NEXT
   
    COLOR boxFg, boxBg: LOCATE botRow, leftCol
    PRINT botLeft$; STRING$(boxWide, horz$); botRight$;   ' Draw box bottom
  
    IF shadow THEN                              ' Do we draw the shadow?
        boxRow = botRow
        FOR B = 1 TO 2
            csrPos = rightCol + B               ' Finish bottom-right shadow
            GOSUB ConfigShadow
        NEXT
        boxRow = botRow + 1
        FOR csrPos = leftCol + 2 TO leftCol + boxWide + 3
            IF csrPos < 81 THEN LOCATE boxRow, csrPos   ' Prevent's an error
            GOSUB ConfigShadow                  ' Draw shadow below box
        NEXT
    END IF
    IF clearBox THEN COLOR filFg, filBg         ' Reset fill colors
    EXIT SUB
' message 4 of 4
'           +***************************************************+
'           *                     Subroutines                   *
'           +***************************************************+

InitiateBox:
    IF boxType = 1 THEN
        topLeft$ = "Ú"
        topRight$ = "¿"
        botLeft$ = "À"
        botRight$ = "Ù"
        vert$ = "³"
        horz$ = "Ä"
        leftT$ = "´"
        rightT$ = "Ã"
    ELSEIF boxType = 2 THEN
        topLeft$ = "É"
        topRight$ = "»"
        botLeft$ = "È"
        botRight$ = "¼"
        vert$ = "º"
        horz$ = "Í"
        leftT$ = "µ"
        rightT$ = "Æ"
    ELSEIF boxType = 3 THEN
        topLeft$ = "Ö"
        topRight$ = "·"
        botLeft$ = "Ó"
        botRight$ = "½"
        vert$ = "º"
        horz$ = "Ä"
        leftT$ = "´"
        rightT$ = "Ã"
    ELSEIF boxType = 4 THEN
        topLeft$ = "Õ"
        topRight$ = "¸"
        botLeft$ = "Ô"
        botRight$ = "¾"
        vert$ = "³"
        horz$ = "Í"
        leftT$ = "µ"
        rightT$ = "Æ"
    END IF

    boxWide = rightCol - leftCol - 1
    IF (filFg = 0 AND filBg = 0) THEN clearBox = 0 ELSE clearBox = -1
    COLOR boxFg, boxBg
    LOCATE TopRow, leftCol
RETURN

ConfigShadow:
    IF ((csrPos < 81) AND (boxRow < 26)) THEN   ' Prevent an illegal function
        attribute = SCREEN(boxRow, csrPos, -1)  ' Obtain the color attribute
        char = SCREEN(boxRow, csrPos)           ' Obtain the charcter
        fg = attribute AND 15                   ' Calculate forground color.
        fg = fg - 8                             ' Remove bright from the color
        IF fg < 1 THEN fg = 8                   ' In case color wasn't bright
        COLOR fg, 0: PRINT CHR$(char);          ' Color and print shadow char
    END IF
RETURN

END SUB