procedure PaintRainbow(Dc : hDc; x : integer; y : integer; Width : integer; Height : integer; bVertical : bool; WrapToRed : bool);
var
i : integer;
ColorChunk : integer;
OldBrush : hBrush;
r : integer;
g : integer;
b : integer;
Chunks : integer;
pt : TPoint;
begin
OffsetViewportOrgEx(Dc, x, y, pt);
if WrapToRed then Chunks := 6
else Chunks := 5;
if bVertical then ColorChunk := Height div Chunks
else ColorChunk := Width div Chunks;

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

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

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

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

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

if WrapToRed then
begin
{Magenta -> 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 then PatBlt(Dc, 0, i, Width, 1, PatCopy)
else PatBlt(Dc, i, 0, 1, Height, PatCopy);
DeleteObject(SelectObject(Dc,OldBrush));
end;
end;

if (Width - (ColorChunk * Chunks) - 1 ) > 0 then
begin
if WrapToRed 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 then PatBlt(Dc, 0, ColorChunk * Chunks, Width, Height - (ColorChunk * Chunks), PatCopy)
else PatBlt(Dc, ColorChunk * Chunks, 0, Width - (ColorChunk * Chunks), Height, 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;
if WrapToRed 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, 0, 255);
5 : result := RGB(255, 0, 255 - (255 div ColorChunk) * ColorChunkIndex);
else
if WrapToRed then result := RGB(255, 0, 0)
else result := RGB(255, 0, 255);
end;
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
PaintRainbow(Form1.Canvas.Handle, 0, 0, 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;
K čemu dnešní příklad použijete, to již ponechám jako obvykle na vás. Zřejmě asi nebude nejvhodnější dávat takové barevné pozadí na hlavní formulář aplikace, ale jistě se najdou i jiná vhodná místa. Rovněž si povšimněte, že není nutné aplikovat kreslení spektra pouze na pozadí formuláře, ale prakticky na libovolný objekt, která má "plátno" (Canvas). Například jej můžete použít jako pozadí ToolBaru, ale musíte si dát v tomto případě pozor na překreslování jednotlivých prvků (tlačítek), které bude ToolBar obsahovat.
A to je již pro dnešek opravdu vše a jako obvykle vás v podobných případech vybízím k experimentování se zdrojákem. Určitě se vám povede vykouzlit různé barevné "šílenosti".