Painting a rainbow color spectrum onto a form

Question:

How do I paint the color spectrum of a rainbow, and if the spectrum is clicked on, how do I calculate what color was clicked on?

Answer:

The following example demonstrates painting a color spectrum, and calculating the color of a given point on the spectrum. Two procedures are presented: PaintRainbow() and ColorAtRainbowPoint(). The PaintRainbow() procedure paints a spectrum from red to magenta if the WrapToRed parameter is false, or paint red to red if the WrapToRed parameter is true. The rainbow can progress either in a horizontal or vertical progression. The ColorAtRainbowPoint() function returns a TColorRef containing the color at a given point in the rainbow.

Example:

procedure PaintRainbow(Dc : hDc; {Canvas to paint to}

x : integer; {Start position X}

y : integer; {Start position Y}

Width : integer; {Width of the rainbow}

Height : integer {Height of the rainbow};

bVertical : bool; {Paint verticallty}

WrapToRed : bool); {Wrap spectrum back to red}

var

i : integer;

ColorChunk : integer;

OldBrush : hBrush;

OldPen : hPen;

r : integer;

g : integer;

b : integer;

Chunks : integer;

ChunksMinus1 : integer;

pt : TPoint;

begin

OffsetViewportOrgEx(Dc,

pt);

if WrapToRed = false then

Chunks := 5 else

Chunks := 6;

ChunksMinus1 := Chunks - 1;

if bVertical = false then

ColorChunk := Width div Chunks else

ColorChunk := Height div Chunks;

{Red To Yellow}

r := 255;

b := 0;

for i := 0 to ColorChunk do begin

g:= (255 div ColorChunk) * i;

OldBrush := SelectObject(Dc, CreateSolidBrush(Rgb(r, g, b)));

if bVertical = false then

PatBlt(Dc, i, 0, 1, Height, PatCopy) else

PatBlt(Dc, 0, i, Width, 1, PatCopy);

DeleteObject(SelectObject(Dc, OldBrush));

end;

{Yellow To Green}

g:=255;

b:=0;

for i := ColorChunk to (ColorChunk * 2) do begin

r := 255 - (255 div ColorChunk) * (i - ColorChunk);

OldBrush := SelectObject(Dc, CreateSolidBrush(Rgb(r, g, b)));

if bVertical = false then

PatBlt(Dc, i, 0, 1, Height, PatCopy) else

PatBlt(Dc, 0, i, Width, 1, PatCopy);

DeleteObject(SelectObject(Dc, OldBrush));

end;

{Green To Cyan}

r:=0;

g:=255;

for i:= (ColorChunk * 2) to (ColorChunk * 3) do begin

b := (255 div ColorChunk)*(i - ColorChunk * 2);

OldBrush := SelectObject(Dc, CreateSolidBrush(Rgb(r, g, b)));

if bVertical = false then

PatBlt(Dc, i, 0, 1, Height, PatCopy) else

PatBlt(Dc, 0, i, Width, 1, PatCopy);

DeleteObject(SelectObject(Dc,OldBrush));

end;

{Cyan To Blue}

r := 0;

b := 255;

for i:= (ColorChunk * 3) to (ColorChunk * 4) do begin

g := 255 - ((255 div ColorChunk) * (i - ColorChunk * 3));

OldBrush := SelectObject(Dc, CreateSolidBrush(Rgb(r, g, b)));

if bVertical = false then

PatBlt(Dc, i, 0, 1, Height, PatCopy) else

PatBlt(Dc, 0, i, Width, 1, PatCopy);

DeleteObject(SelectObject(Dc, OldBrush));

end;

{Blue To Magenta}

g := 0;

b := 255;

for i:= (ColorChunk * 4) to (ColorChunk * 5) do begin

r := (255 div ColorChunk) * (i - ColorChunk * 4);

OldBrush := SelectObject(Dc, CreateSolidBrush(Rgb(r, g, b)));

if bVertical = false then

PatBlt(Dc, i, 0, 1, Height, PatCopy) else

PatBlt(Dc, 0, i, Width, 1, PatCopy);

DeleteObject(SelectObject(Dc, OldBrush))

end;

if WrapToRed <> false then begin

{Magenta To Red}

r := 255;

g := 0;

for i := (ColorChunk * 5) to ((ColorChunk * 6) - 1) do begin

b := 255 -((255 div ColorChunk) * (i - ColorChunk * 5));

OldBrush := SelectObject(Dc, CreateSolidBrush(Rgb(r,g,b)));

if bVertical = false then

PatBlt(Dc, i, 0, 1, Height, PatCopy) else

PatBlt(Dc, 0, i, Width, 1, PatCopy);

DeleteObject(SelectObject(Dc,OldBrush));

end;

{Fill Remainder}

if (Width - (ColorChunk * Chunks) - 1 ) > 0 then begin

if WrapToRed <> false then begin

r := 255;

g := 0;

b := 0;

end else begin

r := 255;

g := 0;

b := 255;

end;

OldBrush := SelectObject(Dc, CreateSolidBrush(Rgb(r, g, b)));

if bVertical = false then

PatBlt(Dc,

ColorChunk * Chunks,

Width - (ColorChunk * Chunks),

Height,

PatCopy) else

PatBlt(Dc,

ColorChunk * Chunks,

Width,

Height - (ColorChunk * Chunks),

PatCopy);

DeleteObject(SelectObject(Dc,OldBrush));

end;

OffsetViewportOrgEx(Dc,

Pt.x,

Pt.y,

pt);

end;

function ColorAtRainbowPoint(ColorPlace : integer;

RainbowWidth : integer;

WrapToRed : bool) : TColorRef;

var

ColorChunk : integer;

ColorChunkIndex : integer;

ColorChunkStart : integer;

begin

if ColorPlace = 0 then begin

result := RGB(255, 0, 0);

exit;

end;

{WhatChunk}

if WrapToRed <> false then

ColorChunk := RainbowWidth div 6 else

ColorChunk := RainbowWidth div 5;

ColorChunkStart := ColorPlace div ColorChunk;

ColorChunkIndex := ColorPlace mod ColorChunk;

case ColorChunkStart of

0 : result := RGB(255,

(255 div ColorChunk) * ColorChunkIndex,

0);

1 : result := RGB(255 - (255 div ColorChunk) * ColorChunkIndex,

255,

0);

2 : result := RGB(0, 255, (255 div ColorChunk) * ColorChunkIndex);

3 : result := RGB(0,

255 - (255 div ColorChunk) * ColorChunkIndex,

255);

4 : result := RGB((255 div ColorChunk) * ColorChunkIndex,

255);

5 : result := RGB(255,

255 - (255 div ColorChunk) * ColorChunkIndex);

else

if WrapToRed <> false then

result := RGB(255, 0, 0) else

result := RGB(255, 0, 255);

end;{Case}

end;

procedure TForm1.FormPaint(Sender: TObject);

begin

PaintRainbow(Form1.Canvas.Handle,

Form1.ClientWidth,

Form1.ClientHeight,

false,

true);

end;

procedure TForm1.FormResize(Sender: TObject);

begin

InvalidateRect(Form1.Handle, nil, false);

end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

var

Color : TColorRef;

begin

Color := ColorAtRainbowPoint(y,

Form1.ClientWidth,

true);

ShowMessage(IntToStr(GetRValue(Color)) + #32 +

IntToStr(GetGValue(Color)) + #32 +

IntToStr(GetBValue(Color)));

end;