Как нарисовать радугу?
Материал из DRKB
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