Using HSL to Get a Complimentary Color

Bruce Warner · #1 Oct 22nd, 2006, 03:34 PM

This test program randomly selects an RGB color and a contrasting color.
The color is expected to be complimentary, but the results sometimes do
not seem to achieve this goal.

One way to produce a contrasting color would be to "rotate" the three RGB
color values by 128 (half of the maximum 255). Example:

R& = (R& + 128) MOD 256
G& = (G& + 128) MOD 256
B& = (B& + 128) MOD 256

This does not work for all colors.

One way to calculate them is to convert from RGB to a different color notation.
I chose to use HSL.

HSL expresses colors in terms of their Hue, Saturation and Lightness, giving a
number for each of these three attributes of the color.

The Hue is the color's position on the color wheel, expressed in degrees from 0° to 359°, representing the 360° of the wheel; 0° being red, 180° being red's opposite color cyan, and so on.

The program below converts the main color to HSL, rotates the hue 180 degrees,
and then converts the resulting HSL color back to RGB.

Also see the posting "Graphic RGB Color Wheel".

Please post any comments in the Programming Forum.

Bruce Warner

Code:

' Thur  10/19/2006    Contrast.bas   Program to test rgb contrasting colors

            ' "HSL Functions" adapted from code posted on Planet-Source-Code.com
            '  By: Chris Jennings  Dated: 3/29/2004 5:55:45 PM
            ' Compatibility:VB 4.0 (32-bit), VB 5.0, VB 6.0
#COMPILE EXE  "Contrast.exe"
#DIM ALL
#INCLUDE "WIN32API.INC"    '   ** Includes **
#INCLUDE "PBForms.INC"

%IDD_DIALOG1     =  101    '   ** Constants **
%IDC_LBL_MNTITLE = 1001
%IDC_LBL_CTITLE  = 1002
%IDC_LBL_mCOLR   = 1003
%IDC_LBL_cCOLR   = 1004
%IDC_BTN_NEW     = 1005
%IDC_BTN_CLOSE    = 1006

%HSLMAX    = 255 ' H, S and L values can be 0 - HSLMAX. 240 matches what is
                 ' used by MS Win; any number less than 1 byte is OK;
                 ' works best if it is evenly divisible by 6
%RGBMAX    = 255 ' R, G, and B value can be 0 - RGBMAX
%UNDEFINED = 0   ' Hue is undefined if Saturation = 0 (greyscale)

TYPE RGBtype
    Red AS LONG
    Grn AS LONG
    Blu AS LONG
END TYPE

TYPE HSLtype
    Hue AS LONG  ' Hue
    Sat AS LONG  ' Saturation
    Lum AS LONG  ' Luminance
END TYPE

GLOBAL gHueA&, gHueB&,OutFile&                   ' for debug only  open
GLOBAL gHSL AS HSLtype, gRGB AS RGBtype
GLOBAL ghDlg AS DWORD, gMcolor&,gCcolor&
GLOBAL gMr&, gMg&, gMb&, gCr&, gCg&, gCb&

DECLARE CALLBACK FUNCTION ShowDIALOG1Proc()
DECLARE FUNCTION ShowDIALOG1(BYVAL hParent AS DWORD) AS LONG

SUB RGBtoHSL( r&, g&, b& ) ' Rtns Hue, Luminescence and Saturation in gHSL global
    DIM cMax AS LONG, cMin AS LONG
    DIM RDelta AS DOUBLE, GDelta AS DOUBLE, BDelta AS DOUBLE
    DIM H AS DOUBLE, S AS DOUBLE, L AS DOUBLE
    DIM cMinus AS LONG, cPlus AS LONG

    cMax = MAX( r&, g&, b&)        ' Highest color value
    cMin = MIN( r&, g&, b&)        ' Lowest  color value
    cMinus = cMax - cMin           ' Used to simplify the
    cPlus = cMax + cMin            ' calculations somewhat.

    L = ((cPlus * %HSLMAX) + %RGBMAX) / (2 * %RGBMAX) ' Calc Luminance (lightness)

    IF cMax = cMin THEN    ' achromatic (r=g=b, greyscale)
        S = 0              ' Saturation 0 for greyscale
        H = %UNDEFINED     ' Hue undefined for greyscale
      ELSE
        IF L <= (%HSLMAX / 2) THEN                   ' Calculate color saturation
            S = ((cMinus * %HSLMAX) + 0.5) / cPlus
          ELSE
            S = ((cMinus * %HSLMAX) + 0.5) / (2 * %RGBMAX - cPlus)
        END IF
        RDelta = (((cMax - r&) * (%HSLMAX / 6)) + 0.5) / cMinus ' Calculate hue
        GDelta = (((cMax - g&) * (%HSLMAX / 6)) + 0.5) / cMinus
        BDelta = (((cMax - b&) * (%HSLMAX / 6)) + 0.5) / cMinus
        SELECT CASE cMax
            CASE CLNG(r&)
                H = BDelta - GDelta
            CASE CLNG(g&)
                H = (%HSLMAX / 3) + RDelta - BDelta
            CASE CLNG(b&)
                H = ((2 * %HSLMAX) / 3) + GDelta - RDelta
        END SELECT
        IF H < 0 THEN H = H + %HSLMAX
    END IF
    gHSL.Hue = CLNG(H)
    gHSL.Lum = CLNG(L)
    gHSL.Sat = CLNG(S)
END SUB               ' RGB to HSL

FUNCTION HuetoRGB(mag1 AS LONG, mag2 AS LONG, Hue AS LONG) AS LONG
                        'Utility function for HSLtoRGB Range check
    IF Hue < 0 THEN
        Hue = Hue + %HSLMAX
      ELSEIF Hue > %HSLMAX THEN
        Hue = Hue - %HSLMAX
    END IF
                        ' Return r, g, or b value from parameters
    SELECT CASE Hue     ' Values get progressively larger.
                        ' Only the first true condition will execute
        CASE IS < (%HSLMAX / 6)
            HuetoRGB = (mag1 + (((mag2 - mag1) * Hue + (%HSLMAX / 12)) / (%HSLMAX / 6)))
        CASE IS < (%HSLMAX / 2)
            HuetoRGB = mag2
        CASE IS < (%HSLMAX * 2 / 3)
            HuetoRGB = (mag1 + (((mag2 - mag1) * ((%HSLMAX * 2 / 3) - Hue) + (%HSLMAX / 12)) / (%HSLMAX / 6)))
        CASE ELSE
            HuetoRGB = mag1
    END SELECT
END FUNCTION           ' Hue to RGB - return a magic number

SUB HSLtoRGB( )
    DIM r&, g&, b&
    DIM H AS LONG, L AS LONG, S AS LONG
    DIM Magic1 AS LONG, Magic2 AS LONG
    H = gHSL.Hue
    L = gHSL.Lum
    S = gHSL.Sat

    IF S = 0 THEN ' Greyscale
        r& = (L * %RGBMAX) / %HSLMAX ' luminescence, converted to proper range
        g& = r&                    ' All RGB values same in greyscale
        b& = r&

        IF H <> %UNDEFINED THEN   ' This is technically an error.  The
                                  ' RGBtoHSL routine will always return
                                  'Hue = UNDEFINED when Sat = 0.
            ' When writing a color mixer where the user inputs color
            ' values, you may want to set Hue = %UNDEFINED in this case.
        END IF
     ELSE          ' else Get the "Magic Numbers"
        IF L <= %HSLMAX / 2 THEN
            Magic2 = (L * (%HSLMAX + S) + (%HSLMAX / 2)) / %HSLMAX
          ELSE
            Magic2 = L + S - ((L * S) + (%HSLMAX / 2)) / %HSLMAX
        END IF
        Magic1 = 2 * L - Magic2
          ' get r&, g&, b&; change units from %HSLMAX range to %RGBMAX range
        r& = (HuetoRGB(Magic1, Magic2, H + (%HSLMAX / 3)) * %RGBMAX + (%HSLMAX / 2)) / %HSLMAX
        g& = (HuetoRGB(Magic1, Magic2, H) * %RGBMAX + (%HSLMAX / 2)) / %HSLMAX
        b& = (HuetoRGB(Magic1, Magic2, H - (%HSLMAX / 3)) * %RGBMAX + (%HSLMAX / 2)) / %HSLMAX
    END IF
    gRGB.Red = INT(CINT(r&))
    gRGB.Grn = INT(CINT(g&))
    gRGB.Blu = INT(CINT(b&))
END SUB                        ' HSL to RGB

FUNCTION ColorHueNm$ ( BYVAL r&, BYVAL g&, BYVAL b&, BYREF Grp& )
    LOCAL Deg!, MinVal&, MaxVal&
    MaxVal& = MAX( r&, g&, b& )   ' 24 hues - each is 15 degrees of the
    MinVal& = MIN( r&, g&, b& )   '           "color wheel" used here
    IF MaxVal& > 0 THEN
        IF r& = MaxVal& THEN
            Deg! = 60.0 * ( g& - b& ) / ( MaxVal& - MinVal& )
          ELSE
            IF g& = MaxVal& THEN
                Deg! = 120.0 + 60.0 * ( b& - r& ) / ( MaxVal& - MinVal& )
              ELSE   ' else b& is MaxVal&
                Deg! = 240.0 + 60.0 * ( r& - g& ) / ( MaxVal& - MinVal& )
            END IF
        END IF
    END IF
    IF Deg! < 0.0 THEN Deg! = Deg! + 360.0
    IF Deg! > 359.4 THEN Deg! = 0
    IF ABS( MAX&( r&, g&, b& ) - MIN&( r&, g&, b& )) < 28 THEN
        Grp& = 25                 ' Gray and near Gray colors
      ELSE
        Grp& = ( Deg! \ 15 ) + 2   ' not gray (every other color)
        IF Grp& > 24 THEN Grp& = 1
    END IF

    FUNCTION = "Unknown Group"
    IF Grp& < 1 OR Grp& > DATACOUNT THEN EXIT FUNCTION
    FUNCTION = READ$( Grp& )
    DATA "Red", "Red Orange", "Orange", "Yellow Orange", "Bright Yellow"
    DATA "Yellow", "Yellow Green", "Green Yellow", "Bright Green", "Green"
    DATA "Green Cyan", "Cyan Green", "Bright Cyan", "Cyan", "Cyan Blue"
    DATA "Blue Cyan", "Bright Blue", "Blue", "Violet", "Magenta Violet"
    DATA "Magenta", "Purple", "Purple Red", "Red Purple", "Near Gray"
END FUNCTION       '  Color Hue Name

SUB NewColor()
LOCAL mBright&, cBright&, LtYellow&, HueNo&, HueNm$, ConNm$
LOCAL r&, g&, b&, h&
    LtYellow& = RGB( 255, 255, 230 )

    gMr& = RND(0,255)
    gMg& = RND(0,255)
    gMb& = RND(0,255)
    HueNm$ = ColorHueNm$( gMr&, gMg&, gMb&, HueNo& )
    gMcolor& = RGB( gMr&, gMg&, gMb& )
    mBright& = (.299*gMr&) + (.587*gMg&) + (.114*gMb&)
    RGBtoHSL gMr&, gMg&, gMb&
    h& = gHSL.Hue             ' save hue value for debug print out

    IF gHSL.Hue > 180 THEN
        gHSL.Hue = gHSL.Hue - 180
      ELSE
        gHSL.Hue = gHSL.Hue + 179
    END IF
    HSLtoRGB   ' gHSL.Hue, gHSL.Sat gHSL.Lum
    gCr& = gRGB.Red
    gCg& = gRGB.Grn
    gCb& = gRGB.Blu
    cBright& = (.299*gCr&) + (gCg&*.587) + (.114*gCb&)

    ConNm$ = ColorHueNm$( gCr&, gCg&, gCb&, HueNo& )
    gCcolor& = RGB( gCr&, gCg&, gCb& )

    CONTROL SET COLOR ghDlg, %IDC_LBL_mCOLR,IIF(mBright& > 130,0,LtYellow&),gMcolor&
    CONTROL SET TEXT ghDlg, %IDC_LBL_mCOLR, " Hue Group: " + HueNm$ + $CRLF+ _
            " R=" + STR$( gMr& ) + "  G=" + STR$( gMg& ) + _
            "  B=" + STR$( gMb& ) + $CRLF + " Brightness: " + FORMAT$( mBright&," ###.###")
    CONTROL SET COLOR ghDlg, %IDC_LBL_cCOLR,IIF(cBright& > 130,0,LtYellow&),gCcolor&
    CONTROL SET TEXT ghDlg, %IDC_LBL_cCOLR, " Hue Group: " + ConNm$ + $CRLF+ _
            " R=" + STR$( gCr& ) + "  G=" + STR$( gCg& ) + "  B=" + STR$( gCb& ) + _
            $CRLF + " Brightness: " + FORMAT$( cBright&," ###.###") ' + _
    PRINT #Outfile&, "Main: " + HueNm$ + "              Contrasting: " + ConNm$ + $CRLF + _
           "Hue 1 = "+ STR$( h& ) +"   Hue 2 = "+ STR$( gHSL.Hue ) + $CRLF + _
           "Hue A = "+ STR$( gHueA& ) +"   Hue B = "+ STR$( gHueB& ) + $CRLF + _
           "C: R=" + STR$( gCr& ) + "  G=" + STR$( gCg& ) + "  B=" + STR$( gCb& ) + $CRLF + _
           "M: R=" + STR$( gMr& ) + "  G=" + STR$( gMg& ) + "  B=" + STR$( gMb& ) + $CRLF + _
           "r: R=" + STR$( r& ) + "  G=" + STR$( g& ) + "  B=" + STR$( b& ) + $CRLF
   DIALOG REDRAW ghDlg
END SUB                 ' New Color

FUNCTION PBMAIN()               '   ** Main Application Entry Point **
'    RANDOMIZE 1.5
    RANDOMIZE TIMER
    OPEN "HSLdata.txt" FOR OUTPUT AS #Outfile&
    PRINT #Outfile&, DATE$+"   " + MID$( TIME$, 1, 5 ) + _
         IIF$( VAL( MID$( TIME$, 1, 2 )) > 11," PM"," AM") + _
         SPACE$(18) + "HSLdata.txt" + $CRLF  + $CRLF

    ShowDIALOG1 %HWND_DESKTOP

    PRINT #Outfile&, " "
    CLOSE #Outfile&
END FUNCTION

CALLBACK FUNCTION ShowDIALOG1Proc()          '   ** CallBacks **
    SELECT CASE AS LONG CBMSG
        CASE %WM_INITDIALOG                  ' Initialization handler
            NewColor

        CASE %WM_NCACTIVATE
            STATIC hWndSaveFocus AS DWORD
            IF ISFALSE CBWPARAM THEN         ' Save control focus
                hWndSaveFocus = GetFocus()
            ELSEIF hWndSaveFocus THEN        ' Restore control focus
                SetFocus(hWndSaveFocus)
                hWndSaveFocus = 0
            END IF

        CASE %WM_COMMAND                     ' Process control notifications
            SELECT CASE AS LONG CBCTL
                CASE %IDC_BTN_NEW
                    IF CBCTLMSG = %BN_CLICKED OR CBCTLMSG = 1 THEN NewColor

                CASE %IDC_BTN_CLOSE
                    IF CBCTLMSG = %BN_CLICKED THEN DIALOG END CBHNDL
            END SELECT
    END SELECT
END FUNCTION

'   ** Dialogs **

FUNCTION ShowDIALOG1(BYVAL hParent
 AS DWORD) AS LONG
    LOCAL lRslt  AS LONG, i&, hDlg AS DWORD, hFont1 AS DWORD

    DIALOG NEW hParent, "Use HSL to Get Complimentary Color", 244, 86, 280, 150, %WS_POPUP OR %WS_BORDER _
        OR %WS_DLGFRAME OR %WS_SYSMENU OR %WS_MINIMIZEBOX OR %WS_CLIPSIBLINGS OR _
        %WS_VISIBLE OR %DS_MODALFRAME OR %DS_3DLOOK OR %DS_NOFAILCREATE OR %DS_SETFONT, _
        %WS_EX_CONTROLPARENT OR %WS_EX_LEFT OR %WS_EX_LTRREADING OR %WS_EX_RIGHTSCROLLBAR, _
        TO hDlg
    ghDlg = hDlg
    CONTROL ADD LABEL,  hDlg, %IDC_LBL_MNTITLE, "Main Color", 12, 8, 57, 13
    CONTROL ADD LABEL,  hDlg, %IDC_LBL_CTITLE, "Complimentary Color", 142, 8, 120, 13
    CONTROL ADD LABEL,  hDlg, %IDC_LBL_mCOLR, "", 10, 19, 130, 96, %WS_CHILD OR _
        %WS_VISIBLE OR %SS_LEFT, %WS_EX_LEFT OR %WS_EX_LTRREADING
    CONTROL ADD LABEL,  hDlg, %IDC_LBL_cCOLR, "", 140, 19, 130, 96, %WS_CHILD OR _
        %WS_VISIBLE OR %SS_LEFT, %WS_EX_LEFT OR %WS_EX_LTRREADING
    CONTROL ADD BUTTON, hDlg, %IDC_BTN_NEW, "&New Color", 71, 126, 68, 16
    CONTROL ADD BUTTON, hDlg, %IDC_BTN_CLOSE, "E&xit", 141, 126, 68, 16

    hFont1 = PBFormsMakeFont("MS Sans Serif", 10, 700, %FALSE, %FALSE, %FALSE, _
        %ANSI_CHARSET)

    DIALOG  SEND hDlg, %WM_SETFONT, hFont1, 0
    FOR i& = %IDC_LBL_MNTITLE TO %IDC_BTN_CLOSE   ' set hFont1 to all controls
        CONTROL SEND hDlg, i&, %WM_SETFONT, hFont1, 0
    NEXT i&

    DIALOG SHOW MODAL hDlg, CALL ShowDIALOG1Proc TO lRslt

    DeleteObject hFont1

    FUNCTION = lRslt
END FUNCTION

------------------

[This message has been edited by Bruce Warner (edited October 22, 2006).]

Thread Tools
Show Printable Version Email this Page
Display Modes
Linear Mode Switch to Hybrid Mode Switch to Threaded Mode