Отправляет email-рассылки с помощью сервиса Sendsay

Советы по Delphi

Рассылка закрыта

При закрытии подписчики были переданы в рассылку "Delphi - проблемы и решения" на которую и рекомендуем вам подписаться.

Вы можете найти рассылки сходной тематики в Каталоге рассылок.

←   Февраль 2002   →
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
Автор
Сергей

Статистика

13.545 подписчиков
-22 за неделю
←   Все выпуски   →

Советы по Delphi Кривая Безье


Служба Рассылок Subscribe.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. Все узлы можно перемещать по полю мышью. Для создания нового узла нужно нажать мышью на пустое место на поле или увеличить порядок кривой.

Скачать необходимые для компиляции файлы проекта можно на 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;

Все советы и замечания, пожалуйста, присылайте на subscribe@program.dax.ru

Всего доброго,
Даниил Карапетян.




http://subscribe.ru/
E-mail: ask@subscribe.ru 		Отписаться
Убрать рекламу
В избранное