Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей  по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Рисование кривых по заданным точкам

Автор: Andrus

Здесь я использую процедуру рисования кривой Безье между двумя точками. Можно задать кривизну кривой(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 World © Выпуск 2002 - 2024
Автор проекта: USU Software
Вы можете выкупить этот проект.