Рисование кривых по заданным точкам

Здесь я использую процедуру рисования кривой Безье между двумя точками. Можно задать кривизну кривой(20-35 лучше всего). Можно задать число отрезков между соседними точками, а если в процедуре DrawSlice убрать коментарий со строки

//  num_slices:=trunc(sqrt(sqr(p1.x-p2.x)+sqr(p1.y-p2.y)));

то число отрезков между соседними точками будет расчитываться автоматически, исходя из растояния между ними. Если потребуются дополнительные коментарии, пишите по адресу andrus78@mail.ru

unit
 u_bezier;

interface


uses
 Windows, Graphics, SysUtils;

type
 TArrayPoint = array
 of
 TPoint; //массив точек

const
 num_slices: integer = 20; //число отрезков между двумя точками
  krivizna: integer = 30; //кривизна кривой (длина плеча направляющей)

procedure
 DrawBezier(acanv: TCanvas; var
 ArrPoint: TArrayPoint);

/////////////////////////////////////////////////////////////////////
implementation

uses
 unit1;

type

  TBezierPoint = record
 //точка Безье
    x, y: integer; //основной узел
    xl, yl, //левая контрольная точка
      xr, yr: single; //правая контрольная точка
  end
;
  TArrayBezierPoint = array
 of
 TBezierPoint; //массив точек Безье

const
 grad_to_rad = pi / 180; //перевод градусов в радианы
  rad_to_grad = 180 / pi; //перевод радиан в градусы
  rad_90 = 90 * grad_to_rad; //90 градусов в радианах
  rad_180 = 180 * grad_to_rad; //180 градусов в радианах
  rad_270 = 270 * grad_to_rad; //270 градусов в радианах
  rad_360 = 360 * grad_to_rad; //360 градусов в радианах

var
 Canvas: TCanvas; //рабочий холст, на котором происходит рисование


//определить угол в радианах между точкой и положительным направлением оси х

function
 GetAngle(dx, dy: single): single;
begin

  if
 dx = 0 then
 begin

    if
 dy = 0 then
 Result := 0
    else
 if
 dy < 0 then
 Result := rad_270
    else
 Result := rad_90;
    exit
  end
;
  Result := arctan(abs(dy) / abs(dx));
  if
 dy < 0 then

    if
 dx < 0 then
 Result := rad_180 + Result
    else
 Result := rad_360 - Result
  else

    if
 dx < 0 then
 Result := rad_180 - Result
end
;


//определить направляющие линии к точке p

procedure
 GetCooPerpendikular(a, o, b: TPoint; var
 p: TBezierPoint);
var
 alfa, beta, gamma, dx, dy, angle_napr: single;
  l1, l2: single;
begin

  dx := a.x - o.x; dy := a.y - o.y;
  alfa := GetAngle(dx, dy);
  l1 := sqrt(dx * dx + dy * dy) * (krivizna / 100); //растояние oa
  dx := b.x - o.x; dy := b.y - o.y;
  beta := GetAngle(dx, dy);
  l2 := sqrt(dx * dx + dy * dy) * (krivizna / 100); //растояние ob
  gamma := (alfa + beta) / 2; //биссектриса угла aob

  if
 alfa > beta then
 angle_napr := gamma + rad_90
  else
 angle_napr := gamma - rad_90;

  p.xl := o.x + l1 * cos(angle_napr);
  p.yl := o.y + l1 * sin(angle_napr);
  p.xr := o.x + l2 * cos(angle_napr + rad_180);
  p.yr := o.y + l2 * sin(angle_napr + rad_180)
end
;


//вычислить координаты точки, лежащей на участке кривой между
//двумя точками Безье в пределах от 0 до 1

procedure
 BezierValue(P1, P2: TBezierPoint; t: single; var
 X, Y: integer);
var
 t_sq, t_cb, r1, r2, r3, r4: single;
begin

  t_sq := t * t;
  t_cb := t * t_sq;
  r1 := (1 - 3 * t + 3 * t_sq - t_cb);
  r2 := (3 * t - 6 * t_sq + 3 * t_cb);
  r3 := (3 * t_sq - 3 * t_cb);
  r4 := (t_cb);
  X := round(r1 * p1.x + r2 * p1.xr + r3 * p2.xl + r4 * p2.x);
  Y := round(r1 * p1.y + r2 * p1.yr + r3 * p2.yl + r4 * p2.y)
end
;


//рисуй участок кривой между двумя точками Безье

procedure
 DrawSlice(p1, p2: TBezierPoint);
var
 i: integer;
  x, y: integer;
  r1, r2: TRect;
begin

//  если убрать комментарий, то количество отрезков между соседними
//  точками будет расчитываться исходя из растояния между ними
//  num_slices:=trunc(sqrt(sqr(p1.x-p2.x)+sqr(p1.y-p2.y)));
  Canvas.MoveTo(p1.x, p1.y);
  for
 i := 1 to
 num_slices - 1 do
 begin

    BezierValue(p1, p2, i / num_slices, x, y);
    Canvas.LineTo(x, y)
  end
;
  Canvas.LineTo(p2.x, p2.y)
end
;


//рисуй кривую на холсте acanv по точкам массива ArrPoint

procedure
 DrawBezier(acanv: TCanvas; var
 ArrPoint: TArrayPoint);
var
 ArrBezPoint: TArrayBezierPoint;
  i, num_point: integer;
  a, o, b: TPoint;
begin

  Canvas := acanv;
  num_point := high(ArrPoint) + 1;
  SetLength(ArrBezPoint, num_point);
  for
 i := 0 to
 num_point - 1 do
 begin

    ArrBezPoint[i].x := ArrPoint[i].x;
    ArrBezPoint[i].y := ArrPoint[i].y;
  end
;
  ArrBezPoint[0].xr := ArrPoint[0].x;
  ArrBezPoint[0].yr := ArrPoint[0].y;
  ArrBezPoint[0].xl := ArrPoint[0].x;
  ArrBezPoint[0].yl := ArrPoint[0].y;
  for
 i := 1 to
 num_point - 2 do
 begin

    a := ArrPoint[i - 1];
    o := ArrPoint[i];
    b := ArrPoint[i + 1];
    GetCooPerpendikular(a, o, b, ArrBezPoint[i])
  end
;
  ArrBezPoint[num_point - 1].xr := ArrPoint[num_point - 1].x;
  ArrBezPoint[num_point - 1].yr := ArrPoint[num_point - 1].y;
  ArrBezPoint[num_point - 1].xl := ArrPoint[num_point - 1].x;
  ArrBezPoint[num_point - 1].yl := ArrPoint[num_point - 1].y;

  for
 i := 1 to
 num_point - 1 do

    DrawSlice(ArrBezPoint[i - 1], ArrBezPoint[i])
end
;

end
.

// *********************************** //
// использовать этот модуль можно так: //
// *********************************** //

procedure
 TForm1.Button2Click(Sender: TObject);
var
 ArrPoint: TArrayPoint;
begin

  SetLength(ArrPoint, 5);
  ArrPoint[0].x := random(200); ArrPoint[0].y := random(200);
  ArrPoint[1].x := random(200); ArrPoint[1].y := random(200);
  ArrPoint[2].x := random(200); ArrPoint[2].y := random(200);
  ArrPoint[3].x := random(200); ArrPoint[3].y := random(200);
  ArrPoint[4].x := random(200); ArrPoint[4].y := random(200);

  num_slices := 10;
  krivizna := 30;
  DrawBezier(Form1.Canvas, ArrPoint)
end
;


// нужно не забыть включить модуль в список используемых:

// implementation
// uses u_bezier;

Другое по теме:

• Delphi и графика
• Вывод надписи поверх всех окон
• Изменить режим копирования изображения