Карта сайта Kansoftware
НОВОСТИУСЛУГИРЕШЕНИЯКОНТАКТЫ
KANSoftWare

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

Delphi , Графика и Игры , Графика



Автор: 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;

Программный код, предоставленный вами, является программой на языке Паскаль, которая реализует алгоритм Бе́зье для рисования гладкой кривой через набор точек. Кривая управляется двумя параметрами: num_сlices, который определяет количество сегментов в кривой, и krivizna, которая контролирует изгиб кривой.

Вот разбор кода:

  1. Единица u_ezier.pas defines several constants and types, including a record for a Bezier point (TBezierPoint) and an array type for storing multiple points (TArrayBezierPoint).
  2. Функция GetAngle calculates the angle between two points in radians.
  3. Процедура GetCooPerpendikular calculates the coordinates of the control points for a Bezier curve segment.
  4. Процедура BezierValue evaluates the Bezier curve at a given parameter value (t) and returns the corresponding x and y coordinates.
  5. Процедура DrawSlice draws a single segment of the Bezier curve between two control points.
  6. Процедура DrawBezier takes an array of points as input, calculates the control points for each segment, and calls DrawSlice to draw the curve.

Пример кода в конце демонстрирует, как использовать этот модуль, создавая форму с кнопкой, которая генерирует случайный набор из 5 точек и рисует кривую Бе́зье через эти точки с помощью процедуры DrawBezier.

Некоторые примечания к коду:

  • Константа krivizna контролирует изгиб кривой, но ее значение не объясняется в комментариях. Значение 30 может быть разумным начальным пунктом.
  • Константа num_сlices determines the number of segments in the curve, which affects the smoothness and complexity of the curve. A higher value will result in a smoother curve, but may also increase computation time.
  • Код использует функцию random для генерации случайных точек для демонстрационных целей. В реальном приложении вы likely want to use a more robust method to generate points.
  • Код предполагает, что входные точки не коллинеарны (т.е., не лежат на одной прямой). Если это не так, кривая может быть нарисована неправильно.

В целом, код предоставляет хороший старт для реализации кривых Бе́зье в Паскале. С некоторыми модификациями и дополнительной функциональностью он мог бы использоваться для создания более сложных и реалистичных кривых для различных приложений.

Рисование кривых по заданным точкам на основе алгоритма Безье между двумя точками.


Комментарии и вопросы

Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS




Материалы статей собраны из открытых источников, владелец сайта не претендует на авторство. Там где авторство установить не удалось, материал подаётся без имени автора. В случае если Вы считаете, что Ваши права нарушены, пожалуйста, свяжитесь с владельцем сайта.


:: Главная :: Графика ::


реклама


©KANSoftWare (разработка программного обеспечения, создание программ, создание интерактивных сайтов), 2007
Top.Mail.Ru

Время компиляции файла: 2024-12-22 20:14:06
2025-03-21 09:37:59/0.0040411949157715/0