Sources
Delphi Russian Knowledge Base
DRKB - это самая большая и удобная в использовании база знаний по Дельфи в рунете, составленная Виталием Невзоровым

Как нарисовать радугу?

01.01.2007

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?

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.

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,
                      x
,
                      y
,
                      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;
 
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,
             
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);
   
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 <> 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,
               
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;