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

Автор: Даниил Карапетян
WEB сайт: http://program.dax.ru

Как нарисовать кривую Безье. Именно она применяется для построения гладких кривых во всех графических программах - от PaintBrush до CorelDraw и PhotoShop. Для задания кривой Безье n-ной степени (чем больше степень, тем более кривой может быть линия; кривая первой степени - отрезок) нужно указать n+1 точку. Первая и последняя точки будут началом и концом кривой, а остальные точки задаю ее поведение на других участках. В частности, первая и n-ая точки задают касательные и кривизну кривой на ее концах. В большинстве программ используются кривые Безье третьего порядка. Начиная с Delphi5 такую кривую можно нарисовать при помощи функции PolyBezier. Кривая Безье задается параметрически (x=x(t), y=y(t)). Это позволяет ей вести себя абсолютно произвольно. Если бы она задавалась, как y(x), она не смогла бы даже сделать поворот на 180 градусов. Функции x(t) и y(t) выглядят так: x(t)= Cn0 * t0 * (1-t)n * x0 + Cn1 * t1 * (1-t)n-1 * x1 + Cn2 * t2 * (1-t)n-2 * x2 + ... + Cnn * tn * (1-t)0 * xn y(t)= Cn0 * t0 * (1-t)n * y0 + Cn1 * t1 * (1-t)n-1 * y1 + Cn2 * t2 * (1-t)n-2 * y2 + ... + Cnn * tn * (1-t)0 * yn где n - порядок кривой, Cni - коэффициенты в разложении бинома Ньютона, t - параметр, меняющийся от 0 до 1, xi, yi - координаты опорных точек. Эта программа строит кривую Безье n-ного порядка. n задается в SpinEdit1. Все узлы можно перемещать по полю мышью. Для создания нового узла нужно нажать мышью на пустое место на поле или увеличить порядок кривой. Скачать необходимые для компиляции файлы проекта можно на http://program.dax.ru

uses Math;
const
  RectSize = 5;
  MaxN = 128;
var
  n: integer = -1;
  pt: array[0..MaxN] of TPoint;
  C: array[0..MaxN] of single;
  bm: TBitMap;

function GetBinomialCoefficient(m, i: integer): single;
  function Factorial(x: integer): double;
  var
    i: integer;
  begin
    result := 1;
    for i := 2 to x do
      result := result * i;
  end;
begin
  result := Factorial(m) / (Factorial(i) * Factorial(m - i));
end;

procedure DrawBezier(Canvas: TCanvas; Count: integer);
type
  TPointArray = array[word] of TPoint;
  PPointArray = ^TPointArray;
var
  p: PPointArray;
  Step, qx, qy, t, q: single;
  i, j: integer;
begin
  GetMem(p, sizeof(TPoint) * (Count + 1));
  Step := 1.0 / Count;
  for i := 0 to Count do
  begin
    t := i * Step;
    qx := 0;
    qy := 0;
    for j := 0 to n do
    begin
      q := C[j] * IntPower(1 - t, j) * IntPower(t, n - j);
      qx := qx + q * pt[j].x;
      qy := qy + q * pt[j].y;
    end;
    p[i] := Point(round(qx), round(qy));
  end;
  Canvas.Polyline(Slice(p^, Count + 1));
  FreeMem(p);
end;

procedure DrawLines(canvas: TCanvas; const pt: array of TPoint);
var
  i: integer;
begin
  Canvas.Pen.Color := clGreen;
  Canvas.Pen.Width := 1;
  Canvas.MoveTo(pt[0].x, pt[0].y);
  for i := 0 to n do
  begin
    Canvas.Rectangle(Bounds(pt[i].x - RectSize, pt[i].y - RectSize,
      2 * RectSize, 2 * RectSize));
    Canvas.LineTo(pt[i].x, pt[i].y);
  end;
end;

procedure Redraw;
begin
  with Form1.PaintBox1 do
  begin
    bm.Canvas.FillRect(Bounds(0, 0, Width, Height));
    if Form1.CheckBox1.Checked then
      DrawLines(bm.Canvas, pt);
    bm.Canvas.PolyBezier(pt);
    bm.Canvas.Pen.Color := clRed;
    bm.Canvas.pen.Width := Form1.SpinEdit3.Value;
    DrawBezier(bm.Canvas, Form1.SpinEdit2.Value);
    Canvas.Draw(0, 0, bm);
  end;
end;
var
  moving: integer = -1;
  oldr: TRect;

procedure FillRandom(NewN: integer);
var
  i: integer;
begin
  randomize;
  for i := n + 1 to NewN do
    pt[i] := Point(random(Form1.PaintBox1.Width - 20) + 10,
      random(Form1.PaintBox1.Height - 20) + 10);
  n := NewN;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  bm := TBitmap.Create;
  bm.Width := PaintBox1.Width;
  bm.Height := PaintBox1.height;
  SpinEdit1.MinValue := 1;
  SpinEdit1.MaxValue := MaxN;
  SpinEdit1.Value := 3;
  SpinEdit2.MinValue := 6;
  SpinEdit2.MaxValue := MaxN * 4;
  SpinEdit2.Value := 50;
  SpinEdit2.OnChange := PaintBox1.OnPaint;
  SpinEdit3.MinValue := 1;
  SpinEdit3.MaxValue := 8;
  SpinEdit3.Value := 3;
  SpinEdit3.OnChange := PaintBox1.OnPaint;
  CheckBox1.Checked := true;
  CheckBox1.OnClick := PaintBox1.OnPaint;
end;

procedure TForm1.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  i: integer;
  r: TRect;
begin
  if Button <> mbLeft then
    Exit;
  for i := 0 to n do
    if (abs(X - pt[i].x) <= RectSize) and (abs(Y - pt[i].y) <= RectSize) then
    begin
      moving := i;
      r.TopLeft := Form1.ClientToScreen(PaintBox1.BoundsRect.TopLeft);
      r.BottomRight := Form1.ClientToScreen(PaintBox1.BoundsRect.BottomRight);
      GetClipCursor(oldr);
      ClipCursor(@r);
      Exit;
    end;
  if moving < 0 then
  begin
    SpinEdit1.Value := SpinEdit1.Value + 1;
    pt[n] := Point(X, Y);
    Redraw;
  end;
end;

procedure TForm1.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X, Y:
  Integer);
begin
  if moving < 0 then
    Exit;
  pt[moving] := Point(X, Y);
  Redraw;
end;

procedure TForm1.PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if (Button = mbLeft) and (moving >= 0) then
  begin
    moving := -1;
    ClipCursor(@oldr);
  end;
end;

procedure TForm1.SpinEdit1Change(Sender: TObject);
var
  i: integer;
begin
  FillRandom(SpinEdit1.Value);
  SpinEdit2.MinValue := n * 2;
  for i := 0 to n do
    C[i] := GetBinomialCoefficient(n, i);
  Redraw;
end;

procedure TForm1.PaintBox1Paint(Sender: TObject);
begin
  Redraw;
end;
Проект Delphi World © Выпуск 2002 - 2017
Автор проекта: Эксклюзивные курсы программирования