Форум программистов [Powered by Invision Power Board]

Код

type
  TForm1 = class(TForm)
    PaintBox1: TPaintBox;
    procedure PaintBox1Paint(Sender: TObject);
    procedure PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormCreate(Sender: TObject);
  private
    FCurve: array of TPoint;
    FDragIndex: Integer;
  public
    procedure InitPoints(const APoints: array of TPoint);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function PtNearPt(X, Y: Integer; const Pt: TPoint): Boolean;
begin
  Result := (X>=Pt.X-3)and(X<=Pt.X+3)and(Y>=Pt.Y-3)and(Y<=Pt.Y+3);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  PaintBox1.ControlStyle := PaintBox1.ControlStyle + [csOpaque];

  InitPoints(
    [Point(100, 100), Point(200, 100), Point(300, 100),
     Point(400, 100), Point(400, 200), Point(400, 300),
     Point(400, 400), Point(300, 400), Point(200, 400),
     Point(100, 400), Point(100, 300), Point(100, 200),
     Point(100, 100)]);
end;

procedure TForm1.InitPoints(const APoints: array of TPoint);
var i, L: Integer;
begin
  L := Length(APoints);
  if L mod 3 <> 1 then
    raise Exception.Create('Bezier: Invalid point number');

  SetLength(FCurve, L);
  for i := 0 to L-1 do
    FCurve[i] := APoints[i];
end;


procedure TForm1.PaintBox1Paint(Sender: TObject);
var i, k, L, N: Integer;
    pt: TPoint;
begin
  with Sender as TPaintBox do
  begin
    Canvas.Pen.Style := psSolid;
    Canvas.Pen.Color := clBlack;
    Canvas.Brush.Style := bsSolid;
    Canvas.Rectangle(ClientRect);

    {-- Bezier itself --}
    Canvas.PolyBezier(FCurve);

    L := Length(FCurve);

    {-- Point markers --}
    Canvas.Pen.Color := clRed;
    for i := 0 to L-1 do
    begin
      pt := FCurve[i];
      Canvas.Rectangle(pt.X - 3, pt.Y - 3, pt.X + 3, pt.Y + 3);
    end;

    {-- Dotted lines ---}
    N := L div 3;
    Canvas.Pen.Style := psDot;
    Canvas.Pen.Color := clBlue;
    Canvas.Brush.Style := bsClear;
    for i := 0 to N-1 do
    begin
      k := i*3;
      Canvas.MoveTo(FCurve[k].X,   FCurve[k].Y);
      Canvas.LineTo(FCurve[k+1].X, FCurve[k+1].Y);
      Canvas.MoveTo(FCurve[k+2].X, FCurve[k+2].Y);
      Canvas.LineTo(FCurve[k+3].X, FCurve[k+3].Y);
    end;
    Canvas.Pen.Style := psSolid;
  end;
end;

procedure TForm1.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var i: Integer;
begin
  FDragIndex := -1;
  for i := 0 to Length(FCurve)-1 do
    if PtNearPt(X, Y, FCurve[i]) then
    begin
      FDragIndex := i;
      Break;
    end;
end;

procedure TForm1.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
begin
  if (ssLeft in Shift)and(FDragIndex <> -1)then
  begin
    FCurve[FDragIndex] := Point(X, Y);
    (Sender as TPaintBox).Refresh;
  end;
end;