本例效果图:
代码文件:
代码文件:
unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls; type TForm1 = class(TForm) CheckBox1: TCheckBox; CheckBox2: TCheckBox; CheckBox3: TCheckBox; procedure FormCreate(Sender: TObject); procedure FormPaint(Sender: TObject); procedure CheckBox1Click(Sender: TObject); procedure CheckBox2Click(Sender: TObject); procedure CheckBox3Click(Sender: TObject); end; var Form1: TForm1; implementation {$R *.dfm} uses GDIPOBJ, GDIPAPI; procedure TForm1.FormCreate(Sender: TObject); begin CheckBox1.Caption := '提取路径中所有的点'; CheckBox2.Caption := '提取路径中最后一个点'; CheckBox3.Caption := '显示路径的外接矩形'; end; procedure TForm1.FormPaint(Sender: TObject); var g: TGPGraphics; path: TGPGraphicsPath; p: TGPPen; b: TGPBrush; pts: array[0..6] of TGPPoint; ptf: TGPPointF; ppts: array of TGPPoint; rect: TGPRect; i: Integer; begin {给 Bezier 线准备的点, 用于建立路径} pts[0].X := 22; pts[0].Y := 44; pts[1].X := 11; pts[1].Y := 111; pts[2].X := 33; pts[2].Y := 222; pts[3].X := 60; pts[3].Y := 88; pts[4].X := 80; pts[4].Y := 222; pts[5].X := 170; pts[5].Y := 111; pts[6].X := 200; pts[6].Y := 11; g := TGPGraphics.Create(Canvas.Handle); {建立路径, 并给路径添加两条 Bezier 线} path := TGPGraphicsPath.Create; path.AddBeziers(PGPPoint(@pts), Length(pts)); {绘制路径} p := TGPPen.Create(aclRed); g.DrawPath(p, path); {虚画原始数据点} p.SetColor(aclGray); for i := 0 to Length(pts)-1 do g.DrawRectangle(p, MakeRect(pts[i].X-2, pts[i].Y-2, 4, 4)); {提取路径中所有的点} b := TGPSolidBrush.Create(aclBlue); if CheckBox1.Checked then begin SetLength(ppts, path.GetPointCount); path.GetPathPoints(PGPPoint(ppts), Length(pts)); for i := 0 to Length(ppts)-1 do g.FillRectangle(b, MakeRect(ppts[i].X-3, ppts[i].Y-3, 6, 6)); end; {可以专门获取最后一个点} TGPSolidBrush(b).SetColor(aclRed); if CheckBox2.Checked then begin path.GetLastPoint(ptf); g.FillRectangle(b, MakeRect(ptf.X-3, ptf.Y-3, 6, 6)); end; {路径的外接矩形} if CheckBox3.Checked then begin path.GetBounds(rect); g.DrawRectangle(p, rect); end; b.Free; p.Free; path.Free; g.Free; end; procedure TForm1.CheckBox1Click(Sender: TObject); begin Repaint; end; procedure TForm1.CheckBox2Click(Sender: TObject); begin Repaint; end; procedure TForm1.CheckBox3Click(Sender: TObject); begin Repaint; end; end.窗体文件:
object Form1: TForm1 Left = 0 Top = 0 Caption = 'Form1' ClientHeight = 235 ClientWidth = 302 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 CheckBox1: TCheckBox Left = 157 Top = 152 Width = 124 Height = 17 Caption = 'CheckBox1' TabOrder = 0 OnClick = CheckBox1Click end object CheckBox2: TCheckBox Left = 157 Top = 175 Width = 137 Height = 17 Caption = 'CheckBox2' TabOrder = 1 OnClick = CheckBox2Click end object CheckBox3: TCheckBox Left = 157 Top = 198 Width = 137 Height = 17 Caption = 'CheckBox3' TabOrder = 2 OnClick = CheckBox3Click end end