zoukankan html css js c++ java
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
查看全文
相关阅读:
真正的e时代
 在线手册
 UVA 10616 Divisible Group Sums
UVA 10721 Bar Codes
UVA 10205 Stack 'em Up
UVA 10247 Complete Tree Labeling
UVA 10081 Tight Words
UVA 11125 Arrange Some Marbles
UVA 10128 Queue
UVA 10912 Simple Minded Hashing
原文地址：https://www.cnblogs.com/FKdelphi/p/7859054.html