Как нарисовать радугу?
Как нарисовать радугу?
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;
