TestDrive Super Store 2.3/TESTDRIVE_2.ISO/realizer/lib/stdcolor.rlz

Text File | 1992-09-30 | 5.1 KB | 162 lines

'***********************************************************************
'    StdColor.rlz
'
'    Standard Color Function Library
'
'    Copyright ⌐ 1991-1992 Computer Associates International, Inc.
'    All rights reserved.
'
'***********************************************************************

IF QVar(%%StdColor, _Defined) THEN
    EXIT MACRO
END IF
%%StdColor = 1

RUN "StdError"
RUN "CCLib1"

ColorNames = {"Black", "White", "Gray", "Red", "Green", "Blue", "Cyan", "Magenta", "Yellow"}
ColorNames = {ColorNames, "Brick", "Evergreen", "MediumBlue", "Purple", "Turquoise", "Brown"}
ColorNames = {ColorNames, "Pale", "Cream", "GreenYellow", "MediumGreen", "PowderBlue"}
ColorNames = {ColorNames, "LightYellow", "LimeGreen", "LightGreen", "Maroon", "Pink", "Orange"}
ColorNames = {ColorNames, "LightEvergreen", "DarkBrown", "MediumBrown", "DarkGreen", "DarkGreenBlue"}
ColorNames = {ColorNames, "NavyBlue", "DarkPurple", "Tan", "GrayGreen", "LightGray", "Violet", "BlueGreen"}


'**** StdColor(rgInitColor  [, asTitle  [, asOK  [, asCancel]]])

FUNC StdColor(rgInitColor, ..)
    'OptParam(1) = asTitle
    'OptParam(2) = asOK
    'OptParam(3) = asCancel

    FUNC ColorPackedToRGB(color)
        IF QVar(color, _Array) THEN
            RETURN color
        ELSE
            RETURN QSys(_Color; color)
        END IF
    END FUNC

    PROC StdColorSetColor(color)
        LOCAL rgb

        rgb = ColorPackedToRGB(color)
        FormSetColor(rgb; _Field)
        FormModifyObject(10, _SetColor)
        FormSetColor(_White; _Field)
        rgb = rgb * 100
        FormModifyObject(31; rgb[1])
        FormModifyObject(41; rgb[2])
        FormModifyObject(51; rgb[3])
        FormModifyObject(32, _Normal, Sprint("P(0)", rgb[1]))
        FormModifyObject(42, _Normal, Sprint("P(0)", rgb[2]))
        FormModifyObject(52, _Normal, Sprint("P(0)", rgb[3]))
        %ColorRetVal = color
    END PROC

    LOCAL fdColor, fdTemp, sel, r, g, b, n
    LOCAL asTitle, asOK, asCancel
    LOCAL %ColorRetVal

    ECType(rgInitColor, _Real, 1)
    ECProto(QNOptParams, 3, "StdColor(rgInitColor [, asTitle  [, asOK  [, asCancel]]])")
    IF QVar(rgInitColor, _Scalar) THEN
        ECRange(rgInitColor, 1, 38, 1)
    ELSE
        IF StartValid(rgInitColor) <> 1 OR EndValid(rgInitColor) <> 3 THEN
            STOP USING "Expecting the valid range of rgInitColor to be 1..3", 1
        ELSE
            FOR n = 1 to 3
                ECRange(rgInitColor[n], 0.0, 1.0, 1)
            NEXT n
        END IF
    END IF
    fdTemp = FormQ(_Selected)
    asTitle = "Select a color"
    asOK = "OK"
    asCancel = "Cancel"
    IF QNOptParams >= 1 THEN
        ECType(QOptParam(1), _Alpha + _Scalar, 2)
        asTitle = QOptParam(1)
        IF QNOptParams >=2 THEN
            ECType(QOptParam(2), _Alpha + _Scalar, 3)
            asOK = QOptParam(2)
            IF QNOptParams >= 3 THEN
                ECType(QOptParam(3), _Alpha + _Scalar, 4)
                asCancel = QOptParam(3)
            END IF
        END IF
    END IF

    fdColor = FormQUnique
    FormNew(fdColor; "StdColor", _Frame)
    FormControl(_Size; _Center, _Center, 60 pct, 75 pct)
    FormSetObject(20, _CaptionCenter, asTitle, 5 pct, 5 pct, 90 pct, _Default)
    FormSetObject(10, _GroupBox, "", 5 pct, 15 pct, 43 pct, 40 pct)
    FormSetObject(21, _ListBox, "", 52 pct, 15 pct, 43 pct, 40 pct; ColorNames)

    FormSetObject(30, _CaptionLeft, "Red:", 5 pct, 60 pct)
    FormSetObject(31, _ScrollBar, "", 18 pct, 60 pct, 60 pct, _Default; 0, 0, 100)
    FormSetObject(32, _TextBox, "", 80 pct, 59 pct, 13 pct, _Default; _Notify)
    FormSetObject(33, _CaptionLeft, "%" , 94 pct, 60 pct)
    FormSetObject(40, _CaptionLeft, "Green:", 5 pct, 70 pct)
    FormSetObject(41, _ScrollBar, "", 18 pct, 70 pct, 60 pct, _Default; 0, 0, 100)
    FormSetObject(42, _TextBox, "", 80 pct, 69 pct, 13 pct, _Default; _Notify)
    FormSetObject(43, _CaptionLeft, "%" , 94 pct, 70 pct)
    FormSetObject(50, _CaptionLeft, "Blue:", 5 pct, 80 pct)
    FormSetObject(51, _ScrollBar, "", 18 pct, 80 pct, 60 pct, _Default; 0, 0, 100)
    FormSetObject(52, _TextBox, "", 80 pct, 79 pct, 13 pct, _Default; _Notify)
    FormSetObject(53, _CaptionLeft, "%" , 94 pct, 80 pct)

    FormSetObject(3, _Button, asOK, _Left, _Bottom)
    FormSetObject(2, _Button, asCancel, _Right, _Bottom)

    FormSetObject(60, _TextBox, "", 100 pct, 100 pct, 0, 0; _Notify)

    StdColorSetColor(rgInitColor)
    IF QVar(rgInitColor, _Scalar) THEN
        FormModifyObject(21; _ListSelect, rgInitColor)
    END IF
    LOOP
        sel = FormWait
        SELECT CASE sel
            CASE 31, 41, 51        'Scroll bars
                r = FormQNum(31)
                g = FormQNum(41)
                b = FormQNum(51)
                StdColorSetColor({r, g, b} / 100)
            CASE 1, 32, 42, 52        'Enter or Text boxes
                n = StrToNum(FormQStr(sel))
                If n <0 OR n>100 THEN
                    FormModifyObject(sel, _Normal, "0")
                END IF
                r = StrToNum(FormQStr(32))
                g = StrToNum(FormQStr(42))
                b = StrToNum(FormQStr(52))
                StdColorSetColor({r, g, b} / 100)
            CASE 21            'List Box
                StdColorSetColor(FormQNum(21))
                FormModifyObject(60, _SetFocus)
            CASE 60
                IF FormWait(_Peek) = 21 THEN
                    StdColorSetColor(FormQNum(21))
                    FormModifyObject(60, _SetFocus)
                END IF
            CASE 3    'OK
                FormControl(_Close)
                IF fdTemp THEN
                    FormSelect(fdTemp)
                END IF
                RETURN %ColorRetVal
            CASE 2    'Cancel
                FormControl(_Close)
                IF fdTemp THEN
                    FormSelect(fdTemp)
                END IF
                RETURN 0
        END SELECT
    END LOOP
END FUNC