本例效果图:
代码文件:
代码文件:
unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, CheckLst, ExtCtrls, TeCanvas; type TForm1 = class(TForm) ButtonColor1: TButtonColor; ButtonColor2: TButtonColor; procedure FormCreate(Sender: TObject); procedure FormPaint(Sender: TObject); procedure ButtonColor1Click(Sender: TObject); procedure ButtonColor2Click(Sender: TObject); end; var Form1: TForm1; implementation {$R *.dfm} uses GDIPOBJ, GDIPAPI; procedure TForm1.FormCreate(Sender: TObject); begin ButtonColor1.Caption := '中心色 '; ButtonColor2.Caption := '周边色 '; ButtonColor1.SymbolColor := clLime; end; procedure TForm1.FormPaint(Sender: TObject); var g: TGPGraphics; rect: TGPRect; path: TGPGraphicsPath; pb: TGPPathGradientBrush; ColorArr: array[0..0] of TGPColor; num: Integer; begin rect := MakeRect(20, 10, ClientWidth - 40, ClientHeight - 50); g := TGPGraphics.Create(Canvas.Handle); path := TGPGraphicsPath.Create; path.AddEllipse(rect); pb := TGPPathGradientBrush.Create(path); pb.SetCenterColor(ColorRefToARGB(ButtonColor1.SymbolColor)); ColorArr[0] := ColorRefToARGB(ButtonColor2.SymbolColor); num := 1; pb.SetSurroundColors(PARGB(@ColorArr), num); g.FillEllipse(pb, rect); pb.Free; path.Free; g.Free; end; procedure TForm1.ButtonColor1Click(Sender: TObject); begin Repaint; end; procedure TForm1.ButtonColor2Click(Sender: TObject); begin Repaint; end; end.窗体文件:
object Form1: TForm1 Left = 0 Top = 0 Caption = 'Form1' ClientHeight = 258 ClientWidth = 208 Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -11 Font.Name = 'Tahoma' Font.Style = [] OldCreateOrder = False Position = poDesktopCenter OnCreate = FormCreate OnPaint = FormPaint PixelsPerInch = 96 TextHeight = 13 object ButtonColor1: TButtonColor Left = 24 Top = 225 Caption = 'ButtonColor1' TabOrder = 0 OnClick = ButtonColor1Click end object ButtonColor2: TButtonColor Left = 112 Top = 225 Caption = 'ButtonColor2' TabOrder = 1 OnClick = ButtonColor2Click end end