Кускова інтерполяція функцій кубічними многочленами Бесселя

         lineto(trunc((x[n+1]-xs)*xmnoj),imh-trunc((y[n+1]-ymin)*ymnoj));

         end;

      form1.gauge1.progress:=n;

      end;

   form1.gauge1.progress:=high(x);

   end else

   for n:=0 to high(x) do

      begin

      form1.image1.canvas.moveto(trunc((x[n]-xs)*xmnoj),imh-trunc((y[n]-ymin)*ymnoj));

      form1.image1.canvas.lineto(trunc((x[n]-xs)*xmnoj)+1,imh-trunc((y[n]-ymin)*ymnoj)+1);

      form1.gauge1.progress:=n;

      end;

form1.image1.canvas.pen.color:=clred;

MC:=strtoInt(Form1.steped.text);

if MC<=1 then

   begin

   showmessage('Невірна  кількість точок');

   exit;

   end;

for n:=0 to MC-1 do begin

  xc:=round((x[round(high(x)*n/(MC-1))]-xs)*xmnoj);

  yc:=imh-round((y[round(high(y)*n/(MC-1))]-ymin)*ymnoj);

form1.image1.canvas.Ellipse(xc-5,yc-5,xc+5,yc+5);

                    end;

form1.canvas.pen.width:=4;

form1.canvas.MoveTo(370,320);

form1.canvas.lineTo(400,320);

form1.canvas.pen.color:=clred;

form1.canvas.MoveTo(515,320);

form1.canvas.lineTo(545,320);

form1.canvas.pen.color:=clblack;

form1.canvas.pen.width:=1;

  Bessel_func;

graph:=true;

form1.caption:='Graphics - Побудову завершено';

end;

procedure TForm1.StartBtnClick(Sender: TObject);

var n:cardinal;

   m:word;

   str:string;

label a;

begin

form1.caption:='Graphics - Розрахунок точок';

graph:=true;

ram:=true;

xe:=strtofloat(xend.text);

xs:=strtofloat(xstart.text);

if xe<xs then

   begin

   str:=xend.text;

   xend.text:=xstart.text;

   xstart.text:=str;

   xe:=xe+xs;

   xs:=xe-xs;

   xe:=xe-xs;

   end;

step:=(xe-xs)*0.01;

if (step>abs(xe-xs))or(step<0) then

   begin

   showmessage('Невірний  крок');

   exit;

   end;

setlength(x,trunc(abs(xe-xs)/step)+1);

setlength(y,trunc(abs(xe-xs)/step)+1);

gauge1.maxvalue:=high(y);

for n:=0 to high(x) do

   begin

   x[n]:=xs+n*step;

   str:=formed.text;

   str:=erranalise(str);

   a:;

   for m:=1 to length(str) do

      begin

      if ((str[m]='x')or(str[m]='X'))then

         begin

         delete(str,m,1);

         insert(floattostr(x[n]),str,m);

         goto a;

         end;

      end;

   y[n]:=strtofloat(analise(str));

   gauge1.progress:=n;

   end;

xyminmax;

ris;

end;

procedure TForm1.ClearBtnClick(Sender: TObject);

begin

with form1.image1.canvas do

   begin

   brush.color:=clwhite;

   pen.color:=clwhite;

   rectangle(0,0,form1.image1.width,form1.image1.height);

   end;

graph:=false;

xed.text:='0';

yed.text:='0';

end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);

begin

finalize(x);

finalize(y);

end;

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,  Y: Integer);

begin

if graph then

   begin

   xed.text:=floattostr((x/image1.width)*(xe-xs)+xs);

   yed.text:=floattostr(ymax-(y/image1.height)*(ymax-ymin));

   end;

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

with form1.image1.canvas do

   begin

   brush.color:=clwhite;

   pen.color:=clwhite;

   rectangle(0,0,form1.image1.width,form1.image1.height);

   end;

end;

procedure TForm1.StartBtn2Click(Sender: TObject);

begin

xyminmax;

ris;

end;

procedure TForm1.OpenBtnClick(Sender: TObject);

var l:extended;

   formula:string;

   n:word;

begin

form1.caption:='Graphics - Відкриття файла';

if opendialog.execute then

   fn:=opendialog.filename;

if fn='' then exit;

setlength(x,0);

setlength(y,0);

assignfile(f,fn);

{$I-}

reset(f);

{$I+}

if ioresult=0 then

   begin

   finalize(x);

   finalize(y);

   read(f,l);

   formula:='';

   for n:=1 to trunc(l) do

      begin

      read(f,l);

      formula:=formula+chr(trunc(l));

      end;

   read(f,xe,xs,step);

   while not eof(f) do

      begin

      setlength(x,high(x)+2);

      setlength(y,high(y)+2);

      read(f,x[high(x)],y[high(y)]);

      end;

   setlength(x,high(x));

   setlength(y,high(y));

   formed.text:=formula;

   xstart.text:=floattostr(xs);

   xend.text:=floattostr(xe);

   steped.text:='15';//floattostr(step);

   end else showmessage('Не  можу відкрити файл');

closefile(f);

form1.caption:='Graphics - Відкриття завершено';

end;

procedure TForm1.SaveBtnClick(Sender: TObject);

var n:cardinal;

   l:extended;

begin

form1.caption:='Graphics - Збереження файла';

if savedialog.execute then

   fn:=savedialog.filename;

if fn='' then exit;

l:=0;

for n:=length(fn) downto 1 do

   if fn[n]='\' then

      begin

      l:=n;

      break;

      end;

if pos('.',copy(fn,trunc(l),length(fn)-trunc(l)))=0 then fn:=fn+'.grf';

assignfile(f,fn);

rewrite(f);

l:=length(formed.text);

write(f,l);

for n:=1 to length(formed.text) do

   begin

  l:=ord(formed.text[n]);

   write(f,l);

   end;  step:=0.01;

write(f,xe,xs,step);

for n:=0 to high(x) do

   write(f,x[n],y[n]);

closefile(f);

form1.caption:='Graphics - Збереження завершено';

end;

procedure TForm1.AbBtnClick(Sender: TObject);

begin

AboutForm.ShowModal;

end;

end.

unit Unit2;

interface

uses

  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;

type

  TAboutForm = class(TForm)

    Memo1: TMemo;

    OKBtn: TButton;

    procedure OKBtnClick(Sender: TObject);

  private

    { Private declarations }

  public

    { Public declarations }

  end;

var

  AboutForm: TAboutForm;

implementation

{$R *.DFM}

procedure TAboutForm.OKBtnClick(Sender: TObject);

begin

close;

end;

end.

unit MyMath;

interface

uses SysUtils,math;

type

   func=(more,less,same);

type TOtv=record

   Resh:string;

   StartStr,EndStr:word;

   end;

var otv:totv;

function maxmin(a,b:string):func;

procedure swapstr(var a,b:string);

procedure swaparr(var a,b:array of shortint);

procedure delnull(var a:string);

procedure multiply(var a,b:string);

procedure addition(var a,b:string);

procedure substract(var a,b:string);

procedure division(zn:cardinal; var a,b:string);

procedure uni(str:string; n:word; deystv:string);

procedure unie(str:string; n:word);

procedure unitrig(str:string; n:word; deystv:string);

function erranalise(str:string):string;

function analise(str:string):string;

implementation

function maxmin(a,b:string):func;

var ch1:cardinal;

begin

delnull(a);

delnull(b);

if (a[1]='-')and(b[1]<>'-') then

   begin

   maxmin:=less;

   exit;

   end;

if (a[1]<>'-')and(b[1]='-') then

   begin

   maxmin:=more;

   exit;

   end;

if pos(',',a)=0 then a:=a+',0';

if pos(',',b)=0 then b:=b+',0';

if pos(',',a)>pos(',',b) then

   begin

   maxmin:=more;

   exit;

   end;

if pos(',',a)<pos(',',b) then

   begin

   maxmin:=less;

   exit;

   end;

if length(a)>length(b) then

   for ch1:=1 to length(a)-length(b) do

      b:=b+'0';

if length(a)<length(b) then

   for ch1:=1 to length(b)-length(a) do

      a:=a+'0';

for ch1:=1 to length(a) do

   begin

   if a[ch1]<b[ch1] then

      begin

      maxmin:=less;

      exit;

      end;

   if a[ch1]>b[ch1] then

      begin

      maxmin:=more;

      exit;

      end;

   end;

maxmin:=same;

end;

procedure swapstr(var a,b:string);

var c:^string;

begin

new(c);

c^:=a;

a:=b;

b:=c^;

dispose(c);

end;

procedure swaparr(var a,b:array of shortint);

var c,ch1:cardinal;

   q:shortint;

begin