IPB
ЛогинПароль:

> ВНИМАНИЕ!

Прежде чем задать вопрос, смотрите FAQ.
Рекомендуем загрузить DRKB.

Наладить общение поможет, если вы подпишитесь по почте на новые темы в этом форуме.

> Кривая Безье
сообщение
Сообщение #1


Новичок
*

Группа: Пользователи
Сообщений: 34
Пол: Мужской

Репутация: -  0  +


Здавствуйте,
Подскажите,пожалуйста, алгоритм построения Кривой Безье на Delphi ... smile.gif

Сообщение отредактировано: Глюк -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
 
 Ответить  Открыть новую тему 
Ответов
сообщение
Сообщение #2


Новичок
*

Группа: Пользователи
Сообщений: 34
Пол: Мужской

Репутация: -  0  +


Снова я за помощью.Я сделал программку,рисует правильно.Но только почему-то у меня координаты точек смещаются.Что нужно сделать,чтоб рисовалось там,где я кликаю мышкой? unsure.gif


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.


Сообщение отредактировано: Глюк -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

Сообщений в этой теме
Глюк   Кривая Безье   3.05.2007 22:20
volvo   Алгоритм? Рекурсивное деление пополам ... Если ты …   3.05.2007 22:33
Глюк   Алгоритм? Рекурсивное деление пополам ... Если ты…   3.05.2007 22:56
volvo   Смотри... На форму брось TImage и TButton, в класс…   4.05.2007 0:13
Глюк   Спасиб,но...Я сделал так,но у меня на TImage точки…   4.05.2007 21:42
volvo   Ты вручную прописывал Image1MouseDown? Так нельзя.…   4.05.2007 21:54
Глюк   Спасибо большое.Теперь рисует :) Я хотел узнать:…   4.05.2007 22:23
volvo   Задавать ты можешь хоть 50, только вот использоват…   4.05.2007 22:27
Глюк   Значит все надо начинать сначала... :unsure: Подс…   4.05.2007 22:52
volvo   Почитай вот это (теория про кривые Безье): http://…   4.05.2007 23:08
Глюк   Ок.Спасибо. Прога практически готова,тока надо нем…   7.05.2007 1:24
Глюк   Снова я за помощью.Я сделал программку,рисует прав…   13.05.2007 20:36
volvo   Ты считаешь, что глобальные координаты курсора мыш…   13.05.2007 21:37
Глюк   Спасибо!Я про это и не подумал...   14.05.2007 12:31


 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 





- Текстовая версия 5.05.2024 7:36
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name