本例效果图:
代码文件:
代码文件:
unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs; type TForm1 = class(TForm) procedure FormPaint(Sender: TObject); procedure FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure FormMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure FormCreate(Sender: TObject); end; var Form1: TForm1; implementation {$R *.dfm} uses GDIPOBJ,GDIPAPI; var pts: array of TGPPoint; ptn: Integer = -1; f: Boolean; procedure TForm1.FormCreate(Sender: TObject); begin Text := '按住 Ctrl 键可添加点'; end; procedure TForm1.FormPaint(Sender: TObject); var g: TGPGraphics; p: TGPPen; i: Integer; begin g := TGPGraphics.Create(Canvas.Handle); p := TGPPen.Create(aclRed, 1); g.Clear(aclWhite); g.DrawBeziers(p, PGPPoint(pts), Length(pts)); p.SetColor(aclBlue); for i := Low(pts) to High(pts) do g.DrawRectangle(p, MakeRect(Rect(pts[i].X-2, pts[i].Y-2, pts[i].X+2, pts[i].Y+2))); g.Free; p.Free; end; procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin f := True; end; procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); var R: TRect; i: Integer; begin if f then begin if ptn = -1 then Exit; pts[ptn].X := X; pts[ptn].Y := Y; Repaint; end else begin ptn := -1; Cursor := crDefault; for i := Low(pts) to High(pts) do begin R := Rect(pts[i].X-2, pts[i].Y-2, pts[i].X+2, pts[i].Y+2); if PtInRect(R, Point(X, Y)) then begin ptn := i; Cursor := crHandPoint; end; end; end; end; procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin f := False; if ssCtrl in Shift then begin SetLength(pts, Length(pts)+1); pts[High(pts)].X := X; pts[High(pts)].Y := Y; Canvas.Pen.Color := clBlue; Canvas.Rectangle(X-2, Y-2, X+2, Y+2); {当点数是 3*n+1 时再绘制} if Length(pts) mod 3 = 1 then Repaint; end; end; end.窗体文件:
object Form1: TForm1 Left = 0 Top = 0 Caption = 'Form1' ClientHeight = 188 ClientWidth = 254 Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -11 Font.Name = 'Tahoma' Font.Style = [] OldCreateOrder = False Position = poDesktopCenter OnCreate = FormCreate OnMouseDown = FormMouseDown OnMouseMove = FormMouseMove OnMouseUp = FormMouseUp OnPaint = FormPaint PixelsPerInch = 96 TextHeight = 13 end