本例效果图:
代码文件:
代码文件:
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