Карта сайта 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;

Статья Рисование кривых по заданным точкам раздела Графика и Игры Графика может быть полезна для разработчиков на Delphi и FreePascal.


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


Ваше мнение или вопрос к статье в виде простого текста (Tag <a href=... Disabled). Все комментарии модерируются, модератор оставляет за собой право удалить непонравившейся ему комментарий.

заголовок

e-mail

Ваше имя

Сообщение

Введите код




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



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


реклама



©KANSoftWare (разработка программного обеспечения, создание программ, создание интерактивных сайтов), 2007
Top.Mail.Ru Rambler's Top100
28.03.2024 19:56:32/0.070658922195435/0