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

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.