CD Actual 15/CDACTUAL15.iso/cdactual/program/basic/QBSCR20.ZIP/PC.BAS

BASIC Source File | 1992-07-08 | 9.0 KB | 286 lines

' ──────────────────────────────────────────────────────────────────────────
'
'                                P C . B A S
'
'            A Companion Utility for the QBSCR Screen Routines
'
'      Executable, source code, and documentation copyright (c) 1992 by
'                                Tony Martin
' --------------------------------------------------------------------------
'
' This program allows you to experiment with EGA/VGA palette colors, and to
' determine the exact Red, Green, and Blue color values that are required to
' make the colors you want.  Simply adjust the R, G, and B values up and down
' until you see the color(s) you desire.  Use the R, G, B values that are
' then displayed in your own programs, with the QBSCR rgbRGB% function.
'
' This program was provided primarily as an example of the use of the QBSCR
' 3D and palette routines.  It weighs in at considerably less than 300 lines,
' including white space and commentary.  It fully supports the mouse as well
' as the keyboard.  It took only about an hour and a half to write.
'
' To load this source code and recompile it, use this command:
'
'                            QB PC /L QBSCR20
'
' Once loaded and compiled, this will result in a compiled EXE file of about
' 120K.  That's because it will compile-in the entire QBSCR library.  Notice
' that the EXE included with the QBSCR Screen Routines is less than 37K. You
' can make an EXE this size as well by using the Source Builder program to
' make a QBSCR source file that contains only the QBSCR routines that PC
' needs.  These routines are:
'
'    EgaPresent%, DepressedBox, RaisedBox, DrawButton, PressedButton,
'    PressButton, Center, OffCenter, rgbRGB%, MouseInit%, MouseShow,
'    MouseHide, GetEvent%
'
' Once you create this source file, load PC into QB like this:
'
'                              QB PC /L QB
'
' making sure that the files QB.QLB and QB.LIB are available (they come with
' QuickBASIC).  The File/Load the file you created with Source Builder and
' compile to an EXE.  You should get an EXE about 36.5K.
' ──────────────────────────────────────────────────────────────────────────


'$INCLUDE: 'qbscr.inc'
'$INCLUDE: 'mouse.bi'
'$INCLUDE: 'colconst.bas'

CONST PSLOT = 6    ' The palette slot we'll be changing.

' ***
' *** Check to see if an EGA or VGA card is present.  If not, then exit.
' ***
IF EgaPresent% = FALSE THEN
    PRINT "This program requires and EGA or VGA card, and one was not detected."
    END
END IF


' ***
' *** Clear the screen and draw the interface.
' ***
COLOR WHITE, BLACK
CLS
COLOR BLACK, WHITE  ' Draw a grey background mat.
FOR i% = 2 TO 23
    LOCATE i%, 9, 0: PRINT SPACE$(64);
NEXT i%

' *** Various windows and boxes
DepressedBox SINGLEBORDER, 10, 2, 71, 23, 0, 7, STYLE3D   ' Main window.
RaisedBox SINGLEBORDER, 13, 3, 68, 5, 0, 7, STYLE3D       ' Title bar.
RaisedBox SINGLEBORDER, 13, 6, 38, 18, 0, 7, STYLE3D      ' Color box, pt 1.
DepressedBox SINGLEBORDER, 15, 7, 36, 17, 0, 7, STYLE3D   ' Color box, pt 2.
DepressedBox SINGLEBORDER, 42, 6, 68, 18, 0, 7, STYLE3D   ' Controls box.

' *** Control Buttons
DrawButton SINGLEBORDER, 44, 8, 50, 10, 0, 7, "+", STYLE3D  ' Red + button.
DrawButton SINGLEBORDER, 52, 8, 58, 10, 0, 7, "+", STYLE3D  ' Green + button.
DrawButton SINGLEBORDER, 60, 8, 66, 10, 0, 7, "+", STYLE3D  ' Blue + button.
DrawButton SINGLEBORDER, 44, 14, 50, 16, 0, 7, "-", STYLE3D  ' Red - button.
DrawButton SINGLEBORDER, 52, 14, 58, 16, 0, 7, "-", STYLE3D  ' Green - button.
DrawButton SINGLEBORDER, 60, 14, 66, 16, 0, 7, "-", STYLE3D  ' Blue - button.

' *** RGB Value Windows
PressedButton SINGLEBORDER, 44, 11, 50, 13, 0, 7, "0", STYLE3D  ' Red.
PressedButton SINGLEBORDER, 52, 11, 58, 13, 0, 7, "0", STYLE3D  ' Green.
PressedButton SINGLEBORDER, 60, 11, 66, 13, 0, 7, "0", STYLE3D  ' Blue.

' *** The DONE Button
DrawButton SINGLEBORDER, 35, 20, 45, 22, 0, 7, "Done!", STYLE3D

' *** Text Labels
COLOR blue, WHITE
Center "The QBSCR Screen Routines ∙ Palette Calculator", 4
COLOR BRIGHT + CYAN, WHITE
OffCenter "Color Display", 19, 13, 38
OffCenter "Palette Controls", 19, 42, 68
LOCATE 7, 47, 0: PRINT "R       G       B";
LOCATE 17, 47, 0: PRINT "r       g       b";

' ***
' *** Initialize the palette slot we'll be using for the color display.  The
' *** color 6 (brown) has always appalled me, so we'll use that one.  Our
' *** initial setting will be R=0, G=0, B=0, or black.  Once the palette for
' *** this is set, draw in the color square.
' ***
r% = 0
G% = 0
b% = 0
PALETTE PSLOT, rgbRGB%(r%, G%, b%)
COLOR 6, 0
FOR i% = 8 TO 16
    LOCATE i%, 17, 0: PRINT STRING$(18, 219);
NEXT i%


' ***
' *** Now check to see if a mouse is available.  If so, turn it on.
' ***
mouseExists% = MouseInit%
IF mouseExists% THEN
    MouseShow
END IF


' ***
' *** Sit in a loop waiting for events. The following events are significant:
' ***
' ***    Event           Causes this action
' ***    ------------------------------------------------------------------
' ***    R key           Increase red value
' ***    r key           Decrease red value
' ***    G key           Increase green value
' ***    g key           Decrease green value
' ***    B key           Increase blue value
' ***    b key           Decrease blue value
' ***    D, d keys       Done - quit program
' ***    Esc key                 "
' ***    Left mouse      Depends on location
' ***    Right mouse     Done - Quit program
' ***
done% = FALSE
WHILE done% = FALSE

    ' ***
    ' *** This update% flag will tell the program whether or not we actually
    ' *** need to update the palette display.
    ' ***
    update% = FALSE

    ' ***
    ' *** Now we wait on an event from the user.  The QBSCR routine GetEvent
    ' *** will do very nicely here.
    ' ***
    event% = getEvent%(mouseExists%, theKey%, mx%, my%)

    ' ***
    ' *** At this point, we definitely have an event of some kind, so we must
    ' *** decide what to do with it.
    ' ***
    SELECT CASE event%
    CASE EMpressedLeft
        IF (mx% >= 44) AND (mx% <= 50) AND (my% >= 8) AND (my% <= 10) THEN
            PressButton SINGLEBORDER, 44, 8, 50, 10, 0, 7, "+", STYLE3D
            IF r% < 3 THEN
                r% = r% + 1      ' Increase red.
                update% = TRUE
            END IF
        END IF
        IF (mx% >= 44) AND (mx% <= 50) AND (my% >= 14) AND (my% <= 16) THEN
            PressButton SINGLEBORDER, 44, 14, 50, 16, 0, 7, "-", STYLE3D
            IF r% > 0 THEN
                r% = r% - 1      ' Decrease red.
                update% = TRUE
            END IF
        END IF
        IF (mx% >= 52) AND (mx% <= 58) AND (my% >= 8) AND (my% <= 10) THEN
            PressButton SINGLEBORDER, 52, 8, 58, 10, 0, 7, "+", STYLE3D
            IF G% < 3 THEN
                G% = G% + 1      ' Increase green.
                update% = TRUE
            END IF
        END IF
        IF (mx% >= 52) AND (mx% <= 58) AND (my% >= 14) AND (my% <= 16) THEN
            PressButton SINGLEBORDER, 52, 14, 58, 16, 0, 7, "-", STYLE3D
            IF G% > 0 THEN
                G% = G% - 1      ' Decrease green.
                update% = TRUE
            END IF
        END IF
        IF (mx% >= 60) AND (mx% <= 66) AND (my% >= 8) AND (my% <= 10) THEN
            PressButton SINGLEBORDER, 60, 8, 66, 10, 0, 7, "+", STYLE3D
            IF b% < 3 THEN
                b% = b% + 1      ' Increase blue.
                update% = TRUE
            END IF
        END IF
        IF (mx% >= 60) AND (mx% <= 66) AND (my% >= 14) AND (my% <= 16) THEN
            PressButton SINGLEBORDER, 60, 14, 66, 16, 0, 7, "-", STYLE3D
            IF b% > 0 THEN
                b% = b% - 1      ' Decrease blue.
                update% = TRUE
            END IF
        END IF
        IF (mx% >= 35) AND (mx% <= 45) AND (my% >= 20) AND (my% <= 22) THEN
            PressButton SINGLEBORDER, 35, 20, 45, 22, 0, 7, "Done!", STYLE3D
            done% = TRUE
        END IF
    CASE EMpressedRight
        done% = TRUE
    CASE EKpressed

        ' ***
        ' *** If we're here, a key was pressed.  If that is the case, then we
        ' *** must act based on which key was pressed.
        ' ***
        SELECT CASE theKey%
        CASE 82      ' R - Increase red
            IF r% < 3 THEN
                r% = r% + 1
                update% = TRUE
            END IF
        CASE 114     ' r - Decrease red
            IF r% > 0 THEN
                r% = r% - 1
                update% = TRUE
            END IF
        CASE 71      ' Increase green
            IF G% < 3 THEN
                G% = G% + 1
                update% = TRUE
            END IF
        CASE 103     ' Decrease green
            IF G% > 0 THEN
                G% = G% - 1
                update% = TRUE
            END IF
        CASE 66      ' Increase blue
            IF b% < 3 THEN
                b% = b% + 1
                update% = TRUE
            END IF
        CASE 98      ' Decrease blue
            IF b% > 0 THEN
                b% = b% - 1
                update% = TRUE
            END IF
        CASE 68, 100 ' D, d - Quit
            done% = TRUE
        CASE 27      ' Esc - Quit
            done% = TRUE
        CASE ELSE
        END SELECT
    CASE ELSE
    END SELECT

    ' ***
    ' *** If our update% flag is TRUE, we must update the palette display, as
    ' *** well as our numerical display.
    ' ***
    IF update% THEN
        IF mouseExists% THEN
            MouseHide
        END IF
        PALETTE PSLOT, rgbRGB%(r%, G%, b%)
        COLOR 0, 7
        LOCATE 12, 47, 0: PRINT LTRIM$(STR$(r%));
        LOCATE 12, 55, 0: PRINT LTRIM$(STR$(G%));
        LOCATE 12, 63, 0: PRINT LTRIM$(STR$(b%));
        IF mouseExists% THEN
            MouseShow
        END IF
    END IF

WEND

IF mouseExists% THEN
    MouseHide
END IF
COLOR 7, 0
CLS