Programowanie w języku Delphi » Artykuły

Krzywe B-Spline

  • 2006-08-09 20:24
  • 3 komentarze
  • 979 odsłon
  • Oceń ten tekst jako pierwszy
Witam
To jest mój pierwszy artykuł na tym forum, mam nadzieje, że wam się przyda. Inspiracją była jedna strona wikipedii  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.

3 komentarze

witkap 2006-12-14 14:36

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 := sig*y2[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.0*u[i]/(x[i+1]-x[i-1])-sig*u[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-qn*u[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

Szczawik 2005-10-09 20:03

W kodzie istnieją metody bez definicji:

procedure obrazMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure obrazMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure obrazMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);


A w metodzie
procedure TForm1.FormPaint(Sender: TObject);
masz niezainicjowane zmienne.

Metoda
procedure TForm1.FormCreate(Sender: TObject);
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));


Tu pojawia się inna kwestia - nigdzie nie zdefiniowałeś wartości dla p[6], p[7].

W sekcji
uses
znajdują się niepotrzebne wpisy:
Messages, Dialogs, Spin, Buttons, Gauges


Kod bardzo mało czytelny. Przed przejrzeniem musiałem sobie posprzątać.

Pomysł mi się jednak podoba, więc dla zachęty dam 4.

[DOPISANE]

Po poprawieniu pozostaję jednak przy ocenie 4, choć wciąż tablica p zawiera elementy, którym nie przypisano wartości, a FormPaint nie inicjalizuje zmiennych i, t :) Więcej czepiał się nie będę.

Tomek27 2005-10-09 19:16

Efekt całkiem ciekawy.
Trzeba tylko poprawić funkcję znajdz (w if\'ie są błędy).