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

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;
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;
ID: 03768
Category:Графика
Category:Bitmap