Версия для печати темы
Нажмите сюда для просмотра этой темы в обычном формате
Форум «Всё о Паскале» _ Делфи _ Кривая Безье
Автор: Глюк 3.05.2007 22:20
Здавствуйте,
Подскажите,пожалуйста, алгоритм построения Кривой Безье на Delphi ... 
Автор: volvo 3.05.2007 22:33
Алгоритм? Рекурсивное деление пополам ... Если ты имеешь в виду метод построения, то существует функция PolyBezier, которая по заданным точкам строит эту самую кривую Безье.
Автор: Глюк 3.05.2007 22:56
Алгоритм? Рекурсивное деление пополам ... Если ты имеешь в виду метод построения, то существует функция PolyBezier, которая по заданным точкам строит эту самую кривую Безье.
А как это.Просто впервые с таким сталкиваюсь...не понимаю,если честно
Мне надо шоб точки задавались с помощью мыши (щелчком на области отображения).
Автор: volvo 4.05.2007 0:13
Смотри... На форму брось TImage и TButton, в классе формы опиши:
type
TForm1 = class(TForm)
...
private
the_points: array of TPoint;
...
end;
и добавь 2 обработчика:
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;Теперь щелкни в 4-х местах на Image, этим ты задашь 4 точки. Только внимательно: 2 из них (первая и последняя) - задают начало/конец кривой Безье, а еще 2 - задают ее форму... После того, как 4 точки отмечены - жми кнопку... Вот тебе и кривая...
Shift: TShiftState; X, Y: Integer);
const sz=3;
begin
Image1.Canvas.Pen.Color := clRed;
Image1.Canvas.Ellipse(X - sz, Y - sz, X + sz, Y + sz);
setlength(the_points, length(the_points) + 1);
the_points[length(the_points)-1].X := X;
the_points[length(the_points)-1].Y := Y;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
Image1.Canvas.PolyBezier(the_points);
end;
Автор: Глюк 4.05.2007 21:42
Спасиб,но...Я сделал так,но у меня на TImage точки не ставятся,а в итоге и не рисуется кривая?
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls;
type
TForm1 = class(TForm)
Image1: TImage;
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
the_points: array of TPoint;
{ Private declarations }
public
procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
const sz=3;
begin
Image1.Canvas.Pen.Color := clRed;
Image1.Canvas.Ellipse(X - sz, Y - sz, X + sz, Y + sz);
setlength(the_points, length(the_points) + 1);
the_points[length(the_points)-1].X := X;
the_points[length(the_points)-1].Y := Y;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
Image1.Canvas.PolyBezier(the_points);
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
close;
end;
end.
Что я не правильно сделал?
Автор: volvo 4.05.2007 21:54
Ты вручную прописывал Image1MouseDown? Так нельзя... убери это и в Object Inspector-е 2 раза щелкни на OnMouseDown для TImage - тогда Дельфи будет знать, что такой обработчик сушествует... Сейчас Дельфи просто не знает о нем, потому как то, что прописано в Private и Public - это твое добавление, а не добавление компилятора...
Попробуй изменить, если не получится - присоединю небольшой работающий проект...
Автор: Глюк 4.05.2007 22:23
Спасибо большое.Теперь рисует
Я хотел узнать:а можно сделать так,чтобы задавалось более 4 точек?
Автор: volvo 4.05.2007 22:27
Задавать ты можешь хоть 50, только вот использовать PolyBezier будет только 4 ... Если надо больше - придется отрисовывать вручную...
Автор: Глюк 4.05.2007 22:52
Значит все надо начинать сначала... 
Подскажите,пожалуйста,а как можно будет это сделать?
Автор: volvo 4.05.2007 23:08
Почитай вот это (теория про кривые Безье): http://ru.wikipedia.org/wiki/%D0%9A%D1%80%D0%B8%D0%B2%D0%B0%D1%8F_%D0%91%D0%B5%D0%B7%D1%8C%D0%B5
А на Арбузе есть неплохая реализация на Паскале: http://forum.arbuz.uz/index.php?showtopic=870&view=findpost&p=13139
Автор: Глюк 7.05.2007 1:24
Ок.Спасибо.
Прога практически готова,тока надо немного подкорректировать...кое-че не то у меня...Ну,думаю,справлюсь
Автор: Глюк 13.05.2007 20:36
Снова я за помощью.Я сделал программку,рисует правильно.Но только почему-то у меня координаты точек смещаются.Что нужно сделать,чтоб рисовалось там,где я кликаю мышкой?
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Edit1: TEdit;
Button2: TButton;
ComboBox1: TComboBox;
Label1: TLabel;
Edit2: TEdit;
Button3: TButton;
PaintBox2: TPaintBox;
procedure PaintBox2Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure ComboBox1Change(Sender: TObject);
procedure Button3Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
x : array [0..49] of integer;
y : array [0..49] of integer;
implementation
uses ConvUtils;
{$R *.dfm}
procedure TForm1.PaintBox2Click(Sender: TObject);
var p : tpoint;
i,j : integer;
f: string;
begin
i:=strtoint(edit1.Text);
GetCursorPos(p);
x[i]:=p.X;
y[i]:=p.Y;
paintbox2.Canvas.Pen.Color:=clblue;
paintbox2.Canvas.Pen.Width:=5;
paintbox2.Canvas.moveto(p.x,p.y);
paintbox2.Canvas.LineTo(p.x,p.y);
paintbox2.Canvas.TextOut(p.X-2,p.Y-2,'P'+inttostr(i));
i:=i+1;
edit1.text:=inttostr(i);
with paintbox2.Canvas do begin
pen.Color:=clgreen;
pen.Width:=1;
for j:= 0 to i-2 do
begin
moveto(x[j],y[j]);
lineto(x[j+1],y[j+1]);
end;
end;
end;
function fac(q: integer): integer;
var k,s : integer;
begin
s:=1;
for k:=1 to q do
s:=s*k;
fac:=s;
end;
function step (t:real;i:integer):real;
var k : integer;
s : real;
begin
s:=1;
if i=0 then s:=1 else begin
for k:=1 to i do
s:=s*t;
end;
step:=s;
end;
function vec(n,i : integer): real;
var s : real;
begin
s:=fac(n)/(fac(i)*fac(n-i));
vec:=s;
end;
function polin(t:real;n,i:integer):real;
var s:real;
begin
s:=vec(n,i)*step(t,i)*step(1-t,n-i);
polin:=s;
end;
function bezex (n : integer; t:real):integer;
var i : integer;
s : real;
begin
s:=0;
for i:=0 to n do
s:=s+x[i]*polin(t,n,i);
bezex:=round(s);
end;
function bezey (n : integer; t:real):integer;
var i : integer;
s : real;
begin
s:=0;
for i:=0 to n do
s:=s+y[i]*polin(t,n,i);
bezey:=round(s);
end;
procedure TForm1.Button1Click(Sender: TObject);
var t,a,b:real;
n:integer;
begin
n:=strtoint(edit1.text)-1;
t:=0;
while t<=1 do
begin
with paintbox2.Canvas do begin
pen.Width:=3;
pixels[bezex(n,t),bezey(n,t)]:=edit2.color;
end;
t:=t+0.0001;
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
paintbox2.Repaint;
edit1.Text:='0';
end;
procedure TForm1.ComboBox1Change(Sender: TObject);
var s: string;
begin
s:=combobox1.Text;
edit2.color:=StringToColor(s);
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
close;
end;
end.
Автор: volvo 13.05.2007 21:37
Ты считаешь, что глобальные координаты курсора мыши и оконные координаты, в которых должна появиться точка - это одно и то же, а на самом деле это далеко не так... Я не просто так в четвертом посте сделал обработку события OnMouseDown... Смотри:
var
Form1: TForm1;
_x : array [0..49] of integer; // Переименовываешь здесь и везде, где имеются в виду массивы
_y : array [0..49] of integer;
и переносишь обработку нажатия из OnClick в OnMouseDown:
procedure TForm1.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer); // Здесь - именно оконные координаты клика мыши
var i, j: integer;
begin
i := strtoint(edit1.Text);
_x[i]:=X;
_y[i]:=Y;
paintbox1.Canvas.Pen.Color:=clblue;
paintbox1.Canvas.Pen.Width:=5;
paintbox1.Canvas.moveto(x,y);
paintbox1.Canvas.LineTo(x,y);
paintbox1.Canvas.TextOut(X-2,Y-2,'P'+inttostr(i));
i:=i+1;
edit1.text:=inttostr(i);
with paintbox1.Canvas do begin
pen.Color:=clgreen;
pen.Width:=1;
for j:= 0 to i-2 do begin
moveto(_x[j],_y[j]);
lineto(_x[j+1],_y[j+1]);
end;
end;
end;
Автор: Глюк 14.05.2007 12:31
Спасибо!Я про это и не подумал...