Delphi实现RGB色环的代码绘制（XE10.2+WIN764）

相关资料：

http://blog.csdn.net/tokimemo/article/details/18702689

http://www.myexception.cn/delphi/215402.html

http://bbs.csdn.net/topics/390627275

结果总结：

1.生成的环中间会少一部分颜色，颜色会小于16581375。

2.手动选择颜色不准，手容易抖，要支持用户输入准确的数值。

代码实例：

 unit Unit1;

 interface

 uses
   Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
   Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls;

 type
   TForm1 = class(TForm)
     Button1: TButton;
     Image1: TImage;
     CheckBox1: TCheckBox;
     Label1: TLabel;
     Label2: TLabel;
     Label3: TLabel;
     Label4: TLabel;
     Label5: TLabel;
     Label6: TLabel;
     procedure Button1Click(Sender: TObject);
     procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
       Y: Integer);
   private
     { Private declarations }
   public
     { Public declarations }
   end;

 var
   Form1: TForm1;

 implementation

 {$R *.dfm}

 //生成RGB色环的代码绘制
 //传入图片的大小
 function CreateColorCircle(const size: integer): TBitmap;
 var
   i,j,x,y: Integer;
   radius: integer;
   perimeter,arc,degree,step: double;
   R,G,B: byte;
   color: TColor;
 begin
   radius := round(size / );
   RESULT := TBitmap.Create;
   R:=;
   G:=;
   B:=;
   with RESULT do
   begin
     width := size;
     height:= size;
     pixelFormat := pf24bit;
     Canvas.Brush.Color := RGB(R,G,B);
     x := size + ;
     y := round(radius) + ;
     Canvas.FillRect(Rect(size,round(radius),x,y));
     for j :=  to size do
       begin
       perimeter := (size - j) * PI + ;
       arc := perimeter / ;
       step := (  *  ) / perimeter ; //颜色渐变步长
       for i :=  to round(perimeter) -  do
         begin
           degree :=  / perimeter * i;
           x := round(cos(degree * PI / ) * (size - j + ) / ) + radius;//数学公式，最后加上的是圆心点
           y := round(sin(degree * PI / ) * (size - j + ) / ) + radius;

           if (degree > ) and (degree <= ) then
           begin
             R := ;
             G := ;
             B := round(step * i);
           end;
           if (degree > ) and (degree <= ) then
           begin
             if perimeter /  /  * (degree - ) > 1.0 then
               R :=  - round(step * (i - arc))
             else
               R :=  - round(step * ABS(i - arc));
             G := ;
             B := ;
           end;
           if (degree > ) and (degree <= ) then
           begin
             R := ;
             if perimeter /  /  * (degree - ) > 1.0 then
               G := round(step * (i -  * arc))
             else
               G := round(step * ABS(i -  * arc));
             B := ;
           end;
           if (degree > ) and (degree <= ) then
           begin
             R := ;
             G := ;
             if perimeter /  /  * (degree - ) > 1.0 then
               B :=  - round(step * (i - perimeter / ))
             else
               B :=  - round(step * ABS(i - perimeter / ));
           end;
           if (degree > ) and (degree <= ) then
           begin
             if perimeter /  /  * (degree - ) > 1.0 then
               R := round(step * (i -  * arc))
             else
               R := round(step * ABS(i -  * arc)) ;
             G := ;
             B := ;
           end;
           if (degree > ) and (degree <= ) then
           begin
             R := ;
             if perimeter /  /  * (degree - ) > 1.0 then
               G :=  - round(step * (i -  * arc))
             else
               G :=  - round(step * ABS(i -  * arc));
             B := ;
           end;
           color := RGB( ROUND(R + ( - R)/size * j),ROUND(G + ( - G) / size * j),ROUND(B + ( - B) / size * j));
           Canvas.Brush.Color := color;
           //为了绘制出来的圆好看，分成四个部分进行绘制
           if (degree >= ) and (degree <= ) then
             Canvas.FillRect(Rect(x,y,x-,y-));
           if (degree > ) and (degree <= ) then
             Canvas.FillRect(Rect(x,y,x-,y-));
           if (degree > ) and (degree <= ) then
             Canvas.FillRect(Rect(x,y,x+,y+));
           if (degree > ) and (degree <= ) then
             Canvas.FillRect(Rect(x,y,x+,y+));
           if (degree > ) and (degree <= ) then
             Canvas.FillRect(Rect(x,y,x-,y-));
         end;
       end;
   end;
 end;

 //扣出中心的黑色圆
 //输入图片与中心圆的半径
 procedure BuckleHole(ABitmap: TBitmap; ARadius: Integer);
 var
   oBmp :TBitmap;
   oRgn :HRGN;
 begin
 //  oBmp := TBitmap.Create; //为了代码整齐就不写try了
 //  oBmp.PixelFormat := ABitmap.PixelFormat;
 //  oBmp.Width := ABitmap.Width;
 //  oBmp.Height := ABitmap.Height;
 //  BitBlt(oBmp.Canvas.Handle, 0, 0, oBmp.Width, oBmp.Height, ABitmap.Canvas.Handle, 80, 80, SRCCOPY); //要拷贝的位图
 //  oRgn := CreateEllipticRgn(0, 0, 100, 100); //创建圆形区域
 //  SelectClipRgn(ABitmap.Canvas.Handle, oRgn); //选择剪切区域
 //  ABitmap.Canvas.Draw(0, 0, oBmp); //位图位于区域内的部分加载
 //  oBmp.Free;
 //  DeleteObject(oRgn);
   ABitmap.Canvas.Pen.Color := clBlack;
   ABitmap.Canvas.Brush.Style := bsClear;
   ABitmap.Canvas.Brush.Color := clBlack;
   ABitmap.Canvas.Ellipse(Trunc(ABitmap.Width/)-ARadius, Trunc(ABitmap.Height/)-ARadius,
     Trunc(ABitmap.Width/)+ARadius, Trunc(ABitmap.Height/)+ARadius);
 end;

 //把中心圆做成透明的
 procedure MyDraw(ABitmap: TBitmap; ARadius: Integer);
 var
   bf: BLENDFUNCTION;
   desBmp, srcBmp: TBitmap;
   rgn: HRGN;
 begin
   with bf do
   begin
     BlendOp := AC_SRC_OVER;
     BlendFlags := ;
     AlphaFormat := ;
     SourceConstantAlpha := ; // 透明度，0~255
   end;

   desBmp := TBitmap.Create;
   srcBmp := TBitmap.Create;

   try
     srcBmp.Assign(ABitmap);

     desBmp.Width := srcBmp.Width;
     desBmp.Height := srcBmp.Height;

     Winapi.Windows.AlphaBlend(desBmp.Canvas.Handle, , ,
       desBmp.Width, desBmp.Height, srcBmp.Canvas.Handle,
       , , srcBmp.Width, srcBmp.Height, bf);

     rgn := CreateEllipticRgn(Trunc(ABitmap.Width/)-ARadius, Trunc(ABitmap.Height/)-ARadius,
     Trunc(ABitmap.Width/)+ARadius, Trunc(ABitmap.Height/)+ARadius); // 创建一个圆形区域
     SelectClipRgn(srcBmp.Canvas.Handle, rgn);
     srcBmp.Canvas.Draw(, , desBmp);

     ABitmap.Assign(nil);
     ABitmap.Assign(srcBmp);
   finally
     desBmp.Free;
     srcBmp.Free;
   end
 end;

 procedure TForm1.Button1Click(Sender: TObject);
 var
   oBitmap: TBitmap;
    rgn: HRGN;
 begin
    oBitmap := CreateColorCircle(Image1.Width);
    if CheckBox1.Checked then //要不要代中心圆选项
 //     BuckleHole(oBitmap, 100);
    MyDraw(oBitmap, );
    Image1.Picture.Graphic := oBitmap;
    oBitmap.Free;
 end;

 procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
   Y: Integer);
   var
   oColor: TColor;
 begin
   //鼠标移动时提取颜色RGB的值
   with Image1 do
     oColor := GetPixel(GetDC(Parent.Handle), X + left,Y + Top);
   Label4.Caption := IntToStr(oColor and $FF);
   Label5.Caption := IntToStr((oColor and $FF00) shr );
   Label6.Caption := IntToStr((oColor and $FF0000) shr );
 end;

 end.