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

Previous  Top  Next

    
 

 

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.

 

Code:

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;

 

©Drkb::03768