作一个类似PhotoShop那样的取色板

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;

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;

 

http://dpm.dnqu.cn/dpm_6505.html