本例效果图:

代码文件:

代码文件:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, StdCtrls, ExtCtrls;
type
TForm1 = class(TForm)
procedure FormPaint(Sender: TObject);
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
uses GDIPOBJ, GDIPAPI;
procedure TForm1.FormPaint(Sender: TObject);
const
colors: array[0..3] of TGPColor = (aclRed, aclYellow, aclGreen, aclBlue);
pos: array[0..3] of Single = (0.0, 0.2, 0.6, 1.0); {好像两端数据必须要是 0 和 1}
var
g: TGPGraphics;
path: TGPGraphicsPath;
pb: TGPPathGradientBrush;
num: Integer;
pts: array of TGPPoint;
begin
g := TGPGraphics.Create(Canvas.Handle);
path := TGPGraphicsPath.Create;
{建立椭圆路径, 并根据路径建立路径画刷, 再用 SetInterpolationColors 设置颜色}
path.AddEllipse(MakeRect(10,10,150,150));
pb := TGPPathGradientBrush.Create(path);
pb.SetInterpolationColors(@colors, @pos, Length(pos));
g.FillPath(pb, path);
{根据椭圆路径建立路径画刷, 再用 SetSurroundColors 设置颜色}
pb.Free;
pb := TGPPathGradientBrush.Create(path);
num := Length(pos);
pb.SetSurroundColors(@colors, num);
g.TranslateTransform(160, 0);
g.FillPath(pb, path);
{根据从椭圆路径中提取出的点数组建立路径画刷, 再用 SetSurroundColors 设置颜色}
SetLength(pts, path.GetPointCount);
path.GetPathPoints(PGPPoint(pts), Length(pts));
pb.Free;
pb := TGPPathGradientBrush.Create(PGPPoint(pts), Length(pts));
pb.SetCenterColor(aclWhite); {此时中心会默认黑色, 我想要白色的}
num := Length(colors);
pb.SetSurroundColors(@colors, num);
g.TranslateTransform(160, 0);
g.FillPath(pb, path);
{根据从椭圆路径中提取出的点数组建立路径画刷, 再用 SetInterpolationColors 设置颜色}
// SetLength(pts, path.GetPointCount);
// path.GetPathPoints(PGPPoint(pts), Length(pts));
pb.Free;
pb := TGPPathGradientBrush.Create(PGPPoint(pts), Length(pts));
// pb.SetCenterColor(aclWhite); {这里不需要中心色}
num := Length(colors);
pb.SetInterpolationColors(@colors, @pos, Length(pos));
g.TranslateTransform(160, 0);
g.FillPath(pb, path);
pb.Free;
path.Free;
g.Free;
end;
end.
窗体文件:object Form1: TForm1 Left = 0 Top = 0 Caption = 'Form1' ClientHeight = 169 ClientWidth = 649 Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -11 Font.Name = 'Tahoma' Font.Style = [] OldCreateOrder = False Position = poDesktopCenter OnPaint = FormPaint PixelsPerInch = 96 TextHeight = 13 end
浙公网安备 33010602011771号