代码文件:
unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, CheckLst, ExtCtrls, TeCanvas; type TForm1 = class(TForm) procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure FormPaint(Sender: TObject); procedure FormMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); end; var Form1: TForm1; implementation {$R *.dfm} uses GDIPOBJ, GDIPAPI; var rect: TGPRect; pt: TGPPoint; pb: TGPPathGradientBrush; procedure TForm1.FormCreate(Sender: TObject); var path: TGPGraphicsPath; ColorSurround: TGPColor; {只用一种包围色, 就别用数组了} num: Integer; begin rect := MakeRect(10, 10, ClientWidth-20, ClientHeight-20); path := TGPGraphicsPath.Create; path.AddEllipse(rect); pb := TGPPathGradientBrush.Create(path); pb.SetCenterColor(aclLime); pb.GetCenterPoint(pt); ColorSurround := aclBlack; num := 1; pb.SetSurroundColors(@ColorSurround, num); path.Free; DoubleBuffered := True; end; procedure TForm1.FormDestroy(Sender: TObject); begin pb.Free; end; procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin pt.X := X; pt.Y := Y; Repaint; end; procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin Repaint; end; procedure TForm1.FormPaint(Sender: TObject); var g: TGPGraphics; p: TGPPen; begin g := TGPGraphics.Create(Canvas.Handle); p := TGPPen.Create(aclRed); g.FillEllipse(pb, rect); pb.SetCenterPoint(pt); g.DrawRectangle(p, pt.X-3, pt.Y-3, 6, 6); p.Free; g.Free; end; end.窗体文件:
object Form1: TForm1 Left = 0 Top = 0 Caption = 'Form1' ClientHeight = 164 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 OnDestroy = FormDestroy OnMouseDown = FormMouseDown OnMouseUp = FormMouseUp OnPaint = FormPaint PixelsPerInch = 96 TextHeight = 13 end