Krzywe B-Spline
acotexas
Witam
To jest mój pierwszy artykuł na tym forum, mam nadzieje, że wam się przyda. Inspiracją była jedna strona wikipedii <wiki href="Krzywa_B-sklejana">Krzywa B-sklejana</wiki>. Na podstawie zawartych tam wzorów wykombinowałem coś takiego. Pomyślałem, że mogę to wrzucić. Nie będę szczegółowo opisywał wszystkiego. Na formę kładziemy obiekty:
Label1: TLabel;
obraz_: TPaintBox;
i ustawiamy zdarzenia.
Jedna uwaga tablica u zawiera elementy wymyślone przeze mnie. Można je edytować, ale elementy nie mogą się powtarzać(błąd dzielenia przez zero), no i muszą być rosnące i z przedziału [0,1]; Poniżej jest pełny kod napisany w Delphi 3.0. Pozdrawiam
Thx for Tomek27!!!
Nie wiem czemu nie wypisuje poprawnie funkcji znajdz z if'em (wytłuszczona). Wyłączyłem znaczniki delphi i to pomogło.
unit Unit1;
{
Poniższy kod jest pierwotnym kodem, nic nie zmieniałem bo nie mam na to
czasu. Zgłaszane uwagi będę próbował sprostować, aczkolwiek zaznaczam, że
nie programuje w delphi tylko w c++ (chciałem tylko szybko zaimplementować ten
programik) i mogę czegoś nie wiedzieć. Kod może więc zawierać jakieś zbędne
linie, które nie wpływają na efekt końcowy.
}
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls, Buttons;
type
TForm1 = class(TForm)
Label1: TLabel;
obraz_: TPaintBox;
procedure FormCreate(Sender: TObject);
procedure obraz_MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure obraz_MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure obraz_MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormPaint(Sender: TObject);
private
{ Private declarations }
public
function _N(i,n:integer;t:real):real;
function _P(i,m,n:integer;t:real):TPoint;
end;
type
Tpunkt=record
x,y:integer;
zaznaczony:boolean;
end;
const m=10;
n=4;
var
Form1: TForm1;
u:array[0..m+1] of real=(0.11,0.1,0.2,0.3,0.4,0.5,0.6,0.7,0.8,0.9,0.95,1);
p:array[0..m-n+1] of TPunkt;
przesuwaj:boolean=false;
jaki:integer; // który punkt kontrolny zaznaczony
implementation
{$R *.DFM}
function znajdz(x,y:integer):integer;
var t:integer;
begin
Result:=-1;
for t:=0 to m-n+1 do
begin
if ( ( x> (p[t].x-3) ) and ( x< (p[t].x+3) ) and ( y> (p[t].y-3) ) and ( y< ( p[t].y+3) ) ) then
Result:=t;
end;
end;
function tform1._P(i,m,n:integer;t:real):TPoint;
var x,y:real;
l:integer;
begin
x:=0;
y:=0;
for l:=0 to m-n-1 do
begin
x:=x+p[l].x*_N(l,n,t);
y:=y+p[l].y*_N(l,n,t);
end;
Result.x:=round(x);
Result.y:=round(y);
end;
function tform1._N(i,n:integer;t:real):real;
begin
if n=0 then begin
if ((t>=u[i])and(t<u[i+1])) then Result:=1 else Result:=0
end else
begin
Result:=(t-u[i])/(u[i+n]-u[i])*_N(i,n-1,t) + (u[i+n+1]-t)/(u[i+n+1]-u[i+1])*_N(i+1,n-1,t)
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
p[0].x:=180;
p[0].y:=20;
p[1].x:=185;
p[1].y:=66;
p[2].x:=165;
p[2].y:=112;
p[3].x:=100;
p[3].y:=133;
p[4].x:=15;
p[4].y:=105;
p[5].x:=43;
p[5].y:=45;
end;
procedure TForm1.obraz_MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
jaki:=znajdz(x,y);
label1.caption:=inttostr(jaki)+' - '+ inttostr(p[jaki].x)+':'+inttostr(p[jaki].y);
if jaki<>-1 then
przesuwaj:=true;
end;
procedure TForm1.obraz_MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
caption:=inttostr(p[jaki].x)+' - '+inttostr(p[jaki].y);
if przesuwaj then
begin
p[jaki].x:=x;
p[jaki].y:=y;
paint;
end;
end;
procedure TForm1.obraz_MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
caption:=inttostr(p[jaki].x)+' - '+inttostr(p[jaki].y);
if przesuwaj then
begin
p[jaki].x:=x;
p[jaki].y:=y;
end;
przesuwaj:=false;
paint;
end;
procedure TForm1.FormPaint(Sender: TObject);
var t,i:integer;
begin
obraz_.Canvas.brush.Color:=clwhite;
obraz_.canvas.FillRect(obraz_.Canvas.ClipRect);
obraz_.Canvas.Moveto(_P(i,m,n,t/100).x,_P(i,m,n,t/100).y);
obraz_.Canvas.Pen.Color:=clblack;
for t:=1 to 100 do
obraz_.Canvas.LineTo(_P(i,m,n,t/100).x,_P(i,m,n,t/100).y);
obraz_.Canvas.Pen.Color:=clblue;
for t:=0 to 6 do
begin
obraz_.canvas.rectangle(p[t-1].x-3,p[t-1].y-3,p[t-1].x+3,p[t-1].y+3);
end;
end;
end.
CONST
np = 10;
TYPE
RealArrayNP = ARRAY [1..np] OF real;
PROCEDURE spline(VAR x,y: RealArrayNP;
n: integer;
yp1,ypn: real;
VAR y2: RealArrayNP);
VAR
i,k: integer;
p,qn,sig,un: real;
u: RealArrayNP;
BEGIN
IF yp1 > 0.99e30 THEN BEGIN
y2[1] := 0.0;
u[1] := 0.0
END
ELSE BEGIN
y2[1] := -0.5;
u[1] := (3.0/(x[2]-x[1]))((y[2]-y[1])/(x[2]-x[1])-yp1)
END;
FOR i := 2 TO n-1 DO BEGIN
sig := (x[i]-x[i-1])/(x[i+1]-x[i-1]);
p := sigy2[i-1]+2.0;
y2[i] := (sig-1.0)/p;
u[i] := (y[i+1]-y[i])/(x[i+1]-x[i])-(y[i]-y[i-1])/(x[i]-x[i-1]);
u[i] := (6.0u[i]/(x[i+1]-x[i-1])-sigu[i-1])/p
END;
IF ypn > 0.99e30 THEN BEGIN
qn := 0.0;
un := 0.0
END
ELSE BEGIN
qn := 0.5;
un := (3.0/(x[n]-x[n-1]))(ypn-(y[n]-y[n-1])/(x[n]-x[n-1]))
END;
y2[n] := (un-qnu[n-1])/(qn*y2[n-1]+1.0);
FOR k := n-1 DOWNTO 1 DO
y2[k] := y2[k]*y2[k+1]+u[k];
END;
by WITOS
W kodzie istnieją metody bez definicji:
A w metodzie
masz niezainicjowane zmienne.
Metoda
nie jest wcale potrzebna o ile zmienną zdefiniujesz jako:
p:array[0..m-n+1] of TPunkt = ((x: 180;y: 20), (x: 185;y: 66), (x: 165;y: 112), (x: 100;y: 133), (x: 15;y: 105), (x: 43;y: 45), (x: 0;y: 0), (x: 0;y: 0));
znajdują się niepotrzebne wpisy:
Messages, Dialogs, Spin, Buttons, Gauges
Efekt całkiem ciekawy.
Trzeba tylko poprawić funkcję znajdz (w if'ie są błędy).