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; ChunksMinus : integer; pt : TPoint; begin OffsetViewportOrgEx(Dc, x, y, pt);

if WrapToRed = false then Chunks := 5 else Chunks := 6; ChunksMinus := Chunks - ;

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, , Height, PatCopy) else PatBlt(Dc, 0, i, Width, , 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, , Height, PatCopy) else PatBlt(Dc, 0, i, Width, , 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, , Height, PatCopy) else PatBlt(Dc, 0, i, Width, , 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, , Height, PatCopy) else PatBlt(Dc, 0, i, Width, , 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, , Height, PatCopy) else PatBlt(Dc, 0, i, Width, , 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) - ) 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, , Height, PatCopy) else PatBlt(Dc, 0, i, Width, , PatCopy); DeleteObject(SelectObject(Dc,OldBrush)); end; end;

{Fill Remainder} if (Width - (ColorChunk * Chunks) - ) > 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, 0, Width - (ColorChunk * Chunks), Height, PatCopy) else PatBlt(Dc, 0, 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); : 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, 0, 255); 5 : result := RGB(255, 0, 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 TForm .FormPaint(Sender: TObject); begin PaintRainbow(Form .Canvas.Handle, 0, 0, Form .ClientWidth, Form .ClientHeight, false, true);

end;

procedure TForm .FormResize(Sender: TObject); begin InvalidateRect(Form .Handle, nil, false); end;

procedure TForm .FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var Color : TColorRef; begin Color := ColorAtRainbowPoint(y, Form .ClientWidth, true); ShowMessage(IntToStr(GetRValue(Color)) + #32 + IntToStr(GetGValue(Color)) + #32 + IntToStr(GetBValue(Color))); end; 7/ 6/98 4:3 :28 PM