代码文件:
unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs; type TForm1 = class(TForm) procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure FormPaint(Sender: TObject); procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); end; var Form1: TForm1; implementation {$R *.dfm} uses GDIPOBJ, GDIPAPI; var path1,path2,path3: TGPGraphicsPath; p: TGPPen; procedure TForm1.FormCreate(Sender: TObject); var r: TRect; begin path1 := TGPGraphicsPath.Create; path2 := TGPGraphicsPath.Create; path3 := TGPGraphicsPath.Create; p := TGPPen.Create(aclRed, 3); path1.AddLine(0, 0, ClientWidth, ClientHeight); r := ClientRect; InflateRect(r, -ClientWidth div 3, -ClientHeight div 3); OffsetRect(r, -Trunc((r.Right-r.Left) * 0.6), -Trunc((r.Bottom-r.Top) * 0.6)); path2.AddRectangle(MakeRect(r)); OffsetRect(r, r.Right-r.Left, r.Bottom-r.Top); path3.AddEllipse(MakeRect(r)); end; procedure TForm1.FormDestroy(Sender: TObject); begin path1.Free; path2.Free; path3.Free; p.Free; end; procedure TForm1.FormPaint(Sender: TObject); var g: TGPGraphics; begin g := TGPGraphics.Create(Canvas.Handle); g.DrawPath(p, path1); g.DrawPath(p, path2); g.DrawPath(p, path3); g.Free; end; procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); begin Text := ''; // if path1.IsVisible(MakePoint(X,Y)) then Text := '在 path1 内'; if path2.IsVisible(MakePoint(X,Y)) then Text := '在矩形内'; if path3.IsVisible(MakePoint(X,Y)) then Text := '在椭圆内'; if path1.IsOutlineVisible(X, Y, p) then Text := '在直线上'; if path2.IsOutlineVisible(X, Y, p) then Text := '在矩形的边线上'; if path3.IsOutlineVisible(X, Y, p) then Text := '在椭圆的圆周线上'; end; end.窗体文件:
object Form1: TForm1 Left = 0 Top = 0 Caption = 'Form1' ClientHeight = 206 ClientWidth = 339 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 OnMouseMove = FormMouseMove OnPaint = FormPaint PixelsPerInch = 96 TextHeight = 13 end