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.手动选择颜色不准，手容易抖，要支持用户输入准确的数值。

代码实例：

  1 unit Unit1;
  2 
  3 interface
  4 
  5 uses
  6   Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  7   Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls;
  8 
  9 type
 10   TForm1 = class(TForm)
 11     Button1: TButton;
 12     Image1: TImage;
 13     CheckBox1: TCheckBox;
 14     Label1: TLabel;
 15     Label2: TLabel;
 16     Label3: TLabel;
 17     Label4: TLabel;
 18     Label5: TLabel;
 19     Label6: TLabel;
 20     procedure Button1Click(Sender: TObject);
 21     procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
 22       Y: Integer);
 23   private
 24     { Private declarations }
 25   public
 26     { Public declarations }
 27   end;
 28 
 29 var
 30   Form1: TForm1;
 31 
 32 implementation
 33 
 34 {$R *.dfm}
 35 
 36 //生成RGB色环的代码绘制
 37 //传入图片的大小
 38 function CreateColorCircle(const size: integer): TBitmap;
 39 var
 40   i,j,x,y: Integer;
 41   radius: integer;
 42   perimeter,arc,degree,step: double;
 43   R,G,B: byte;
 44   color: TColor;
 45 begin
 46   radius := round(size / 2);
 47   RESULT := TBitmap.Create;
 48   R:=255;
 49   G:=0;
 50   B:=0;
 51   with RESULT do
 52   begin
 53     width := size;
 54     height:= size;
 55     pixelFormat := pf24bit;
 56     Canvas.Brush.Color := RGB(R,G,B);
 57     x := size + 1;
 58     y := round(radius) + 1;
 59     Canvas.FillRect(Rect(size,round(radius),x,y));
 60     for j := 0 to size do
 61       begin
 62       perimeter := (size - j) * PI + 1;
 63       arc := perimeter / 6;
 64       step := ( 255 * 6 ) / perimeter ; //颜色渐变步长
 65       for i := 0 to round(perimeter) - 1 do
 66         begin
 67           degree := 360 / perimeter * i;
 68           x := round(cos(degree * PI / 180) * (size - j + 1) / 2) + radius;//数学公式，最后加上的是圆心点
 69           y := round(sin(degree * PI / 180) * (size - j + 1) / 2) + radius;
 70 
 71           if (degree > 0) and (degree <= 60) then
 72           begin
 73             R := 255;
 74             G := 0;
 75             B := round(step * i);
 76           end;
 77           if (degree > 60) and (degree <= 120) then
 78           begin
 79             if perimeter / 3 / 120 * (degree - 60) > 1.0 then
 80               R := 255 - round(step * (i - arc))
 81             else
 82               R := 255 - round(step * ABS(i - arc));
 83             G := 0;
 84             B := 255;
 85           end;
 86           if (degree > 120) and (degree <= 180) then
 87           begin
 88             R := 0;
 89             if perimeter / 3 / 120 * (degree - 120) > 1.0 then
 90               G := round(step * (i - 2 * arc))
 91             else
 92               G := round(step * ABS(i - 2 * arc));
 93             B := 255;
 94           end;
 95           if (degree > 180) and (degree <= 240) then
 96           begin
 97             R := 0;
 98             G := 255;
 99             if perimeter / 3 / 120 * (degree - 120) > 1.0 then
100               B := 255 - round(step * (i - perimeter / 2))
101             else
102               B := 255 - round(step * ABS(i - perimeter / 2));
103           end;
104           if (degree > 240) and (degree <= 300) then
105           begin
106             if perimeter / 3 / 120 * (degree - 240) > 1.0 then
107               R := round(step * (i - 4 * arc))
108             else
109               R := round(step * ABS(i - 4 * arc)) ;
110             G := 255;
111             B := 0;
112           end;
113           if (degree > 300) and (degree <= 360) then
114           begin
115             R := 255;
116             if perimeter / 3 / 120 * (degree - 300) > 1.0 then
117               G := 255 - round(step * (i - 5 * arc))
118             else
119               G := 255 - round(step * ABS(i - 5 * arc));
120             B := 0;
121           end;
122           color := RGB( ROUND(R + (255 - R)/size * j),ROUND(G + (255 - G) / size * j),ROUND(B + (255 - B) / size * j));
123           Canvas.Brush.Color := color;
124           //为了绘制出来的圆好看，分成四个部分进行绘制
125           if (degree >= 0) and (degree <= 45) then
126             Canvas.FillRect(Rect(x,y,x-2,y-1));
127           if (degree > 45) and (degree <= 135) then
128             Canvas.FillRect(Rect(x,y,x-1,y-2));
129           if (degree > 135) and (degree <= 225) then
130             Canvas.FillRect(Rect(x,y,x+2,y+1));
131           if (degree > 215) and (degree <= 315) then
132             Canvas.FillRect(Rect(x,y,x+1,y+2));
133           if (degree > 315) and (degree <= 360) then
134             Canvas.FillRect(Rect(x,y,x-2,y-1));
135         end;
136       end;
137   end;
138 end;
139 
140 //扣出中心的黑色圆
141 //输入图片与中心圆的半径
142 procedure BuckleHole(ABitmap: TBitmap; ARadius: Integer);
143 var
144   oBmp :TBitmap;
145   oRgn :HRGN;
146 begin
147 //  oBmp := TBitmap.Create; //为了代码整齐就不写try了
148 //  oBmp.PixelFormat := ABitmap.PixelFormat;
149 //  oBmp.Width := ABitmap.Width;
150 //  oBmp.Height := ABitmap.Height;
151 //  BitBlt(oBmp.Canvas.Handle, 0, 0, oBmp.Width, oBmp.Height, ABitmap.Canvas.Handle, 80, 80, SRCCOPY); //要拷贝的位图
152 //  oRgn := CreateEllipticRgn(0, 0, 100, 100); //创建圆形区域
153 //  SelectClipRgn(ABitmap.Canvas.Handle, oRgn); //选择剪切区域
154 //  ABitmap.Canvas.Draw(0, 0, oBmp); //位图位于区域内的部分加载
155 //  oBmp.Free;
156 //  DeleteObject(oRgn);
157   ABitmap.Canvas.Pen.Color := clBlack;
158   ABitmap.Canvas.Brush.Style := bsClear;
159   ABitmap.Canvas.Brush.Color := clBlack;
160   ABitmap.Canvas.Ellipse(Trunc(ABitmap.Width/2)-ARadius, Trunc(ABitmap.Height/2)-ARadius,
161     Trunc(ABitmap.Width/2)+ARadius, Trunc(ABitmap.Height/2)+ARadius);
162 end;
163 
164 //把中心圆做成透明的
165 procedure MyDraw(ABitmap: TBitmap; ARadius: Integer);
166 var
167   bf: BLENDFUNCTION;
168   desBmp, srcBmp: TBitmap;
169   rgn: HRGN;
170 begin
171   with bf do
172   begin
173     BlendOp := AC_SRC_OVER;
174     BlendFlags := 0;
175     AlphaFormat := 0;
176     SourceConstantAlpha := 0; // 透明度，0~255
177   end;
178 
179   desBmp := TBitmap.Create;
180   srcBmp := TBitmap.Create;
181 
182   try
183     srcBmp.Assign(ABitmap);
184 
185     desBmp.Width := srcBmp.Width;
186     desBmp.Height := srcBmp.Height;
187 
188     Winapi.Windows.AlphaBlend(desBmp.Canvas.Handle, 0, 0,
189       desBmp.Width, desBmp.Height, srcBmp.Canvas.Handle,
190       0, 0, srcBmp.Width, srcBmp.Height, bf);
191 
192     rgn := CreateEllipticRgn(Trunc(ABitmap.Width/2)-ARadius, Trunc(ABitmap.Height/2)-ARadius,
193     Trunc(ABitmap.Width/2)+ARadius, Trunc(ABitmap.Height/2)+ARadius); // 创建一个圆形区域
194     SelectClipRgn(srcBmp.Canvas.Handle, rgn);
195     srcBmp.Canvas.Draw(0, 0, desBmp);
196 
197     ABitmap.Assign(nil);
198     ABitmap.Assign(srcBmp);
199   finally
200     desBmp.Free;
201     srcBmp.Free;
202   end
203 end;
204 
205 procedure TForm1.Button1Click(Sender: TObject);
206 var
207   oBitmap: TBitmap;
208    rgn: HRGN;
209 begin
210    oBitmap := CreateColorCircle(Image1.Width);
211    if CheckBox1.Checked then //要不要代中心圆选项
212 //     BuckleHole(oBitmap, 100);
213    MyDraw(oBitmap, 100);
214    Image1.Picture.Graphic := oBitmap;
215    oBitmap.Free;
216 end;
217 
218 procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
219   Y: Integer);
220   var
221   oColor: TColor;
222 begin
223   //鼠标移动时提取颜色RGB的值
224   with Image1 do
225     oColor := GetPixel(GetDC(Parent.Handle), X + left,Y + Top);
226   Label4.Caption := IntToStr(oColor and $FF);
227   Label5.Caption := IntToStr((oColor and $FF00) shr 8);
228   Label6.Caption := IntToStr((oColor and $FF0000) shr 16);
229 end;
230 
231 end.

View Code

相关阅读:
排序之插入排序
 swfupload在chrome中点击上传图片按钮无反应的解决办法
 ASP.NET网站限制访问频率
 SQL 合并列值和拆分列值
 替换字符串第一次出现的某个字符
 HttpWebResponse远程服务器返回错误: (500) 内部服务器错误
 撒列实现关键字过虑
 sql关键字过滤C#方法
 WebRequest 对象的使用
 Request 分别获取具有相同 name 属性表单元素值
原文地址：https://www.cnblogs.com/FKdelphi/p/7859054.html