unit parabola;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
  StdCtrls;

type

  { TForm1 }

  TForm1 = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    Edit4: TEdit;
    Edit5: TEdit;
    Edit6: TEdit;
    Edit7: TEdit;
    Edit8: TEdit;
    Label1: TLabel;
    Label10: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Label9: TLabel;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
    procedure Edit1KeyPress(Sender: TObject; var Key: char);
    procedure Edit2KeyPress(Sender: TObject; var Key: char);
    procedure Edit3KeyPress(Sender: TObject; var Key: char);
    procedure Edit4KeyPress(Sender: TObject; var Key: char);
    procedure Edit5KeyPress(Sender: TObject; var Key: char);
    procedure Edit6KeyPress(Sender: TObject; var Key: char);
    procedure Edit7KeyPress(Sender: TObject; var Key: char);
    procedure Edit8KeyPress(Sender: TObject; var Key: char);
  private
    { private declarations }
  public
    { public declarations }
  end; 

var
  Form1: TForm1; 

implementation

function f(x: extended): extended;
var
 a, b, c, d, e: extended; //коэффициенты y(x)a*x^4+b*x^3+c*x^2+d*x+e
begin
  a:=StrtoFloat(Form1.Edit1.Text);
  b:=StrtoFloat(Form1.Edit2.Text);
  c:=StrtoFloat(Form1.Edit3.Text);
  d:=StrtoFloat(Form1.Edit4.Text);
  e:=StrtoFloat(Form1.Edit5.Text);
  f:=a*x*x*x*x+b*x*x*x+c*x*x+d*x+e;
end;

function p(x: extended): extended; //первая производная
var
  p1, p2: extended;
  h: extended;
begin
  h:=1;
  repeat
    p1:=(f(x+h)-f(x-h))/h/2;
    h:=h/2;
    p2:=(f(x+h)-f(x-h))/h/2;
  until (p1=p2) or (h<1E-10*abs(x));
  p:=p2 ;
end;


function s(x: extended): extended; //вторая производная
var
  s1, s2: extended;
  h: extended;
begin
  h:=1;
  repeat
    s1:=((f(x+h)+f(x-h)-2*f(x)))/(h*h);
    h:=h/2;
    s2:=((f(x+h)+f(x-h)-2*f(x)))/(h*h);
  until (s1=s2) or (h*h<1E-10*abs(x));
  s:=s2;
end;

procedure minparab;
var
 x0: extended; //начальное значение
 dx: extended; //погрешность
 x1: extended;
 x2: extended;
 n: integer;
begin
  Form1.Memo1.Clear;
  Form1.Edit8.Text:='';
  x0:=StrtoFloat(Form1.Edit6.Text);
  dx:=StrtoFloat(Form1.Edit7.Text);
  Form1.Memo1.Lines.Add('X[0]='+FloatToStr(x0));
  if s(x0)<=0
    then
      begin
        Form1.Memo1.Lines.Add('Введённое начальное значение X[0]'+
        ' не соответствует вогнутости вниз');
        Form1.Memo1.Lines.Add('Вторая производная в точке X[0]'+
        ' не является положительной  = '+FloatToStr(s(x0)));
          while s(x0)<=0 do x0:=x0+1;
      end;
  n:=0;
  x1:=x0;
  x2:=x1-p(x1)/s(x1);
  Form1.Memo1.Lines.Add('X['+IntToStr(n)+']='+FloatToStr(x1));
  Form1.Memo1.Lines.Add('X['+IntToStr(n+1)+']='+FloatToStr(x2));
  Form1.Memo1.Lines.Add('f(X['+IntToStr(n)+'])='+FloatToStr(f(x1)));
  Form1.Memo1.Lines.Add('f(X['+IntToStr(n+1)+'])='+FloatToStr(f(x2)));
  Form1.Memo1.Lines.Add('Вторая производная в точке X['+
                           IntToStr(n)+'] = '+FloatToStr(s(x1)));
  Form1.Memo1.Lines.Add('Первая производная в точке X['+
                           IntToStr(n)+'] = '+FloatToStr(p(x1)));
  Form1.Memo1.Lines.Add('Приращение функции в точке X['+
                           IntToStr(n)+'] = '+FloatToStr(f(x2)-f(x1)));
  Form1.Memo1.Lines.Add('');
  while (abs(x2-x1)>dx) and (f(x2)-f(x1)<>0) and (n<1000) do
    begin
    n:=n+1;
    x1:=x2;
    x2:=x1-p(x1)/s(x1);
      Form1.Memo1.Lines.Add('X['+IntToStr(n)+']='+FloatToStr(x1));
  Form1.Memo1.Lines.Add('X['+IntToStr(n+1)+']='+FloatToStr(x2));
  Form1.Memo1.Lines.Add('f(X['+IntToStr(n)+'])='+FloatToStr(f(x1)));
  Form1.Memo1.Lines.Add('f(X['+IntToStr(n+1)+'])='+FloatToStr(f(x2)));
  Form1.Memo1.Lines.Add('Вторая производная в точке X['+
                           IntToStr(n)+'] = '+FloatToStr(s(x1)));
  Form1.Memo1.Lines.Add('Первая производная в точке X['+
                           IntToStr(n)+'] = '+FloatToStr(p(x1)));
  Form1.Memo1.Lines.Add('Приращение функции в точке X['+
                           IntToStr(n)+'] = '+FloatToStr(f(x2)-f(x1)));
  Form1.Memo1.Lines.Add('');
    end;                         
  Form1.Edit8.Text:=FloatToStr(x2);
end;

{ TForm1 }

procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: char);
type
  DigitChar = set of '0'..'9';
var
  digit: DigitChar;
  b: boolean;
  k1: byte;
  i: byte;
  h: string;
begin
  h:=Edit1.Text;
  b:=false;
  k1:=0;
  digit:=['0','1','2','3','4','5','6','7','8','9'];
  for i:=1 to length(h) do
    begin
      if (h[i] in digit) and (h[i]<>'0') then b:=true;
      if (h[i] in digit) and (b=true) then k1:=k1+1;
    end;
  case Key of
  '0'..'9':  if (((k1>=15) and (pos('E',h)=0)) or
            ((length(h)>=pos('E',h)+5))and (pos('E',h)>0)) then Key :=Chr(0);
  #8: ;
  ',':  if (pos(',',h)<>0) and (pos('E',h)= 0) then Key :=Chr(0);
  'E':  if pos('E',h)<>0 then Key :=Chr(0);
  '-':  if  (length(h) <> pos('E',h)) or (pos('E',h)= 0)  then Key :=Chr(0);
  #13: Edit2.SetFocus;
  else Key :=Chr(0);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  if Edit1.Text='' then begin Edit1.SetFocus; exit; end;
  if Edit2.Text='' then begin Edit2.SetFocus; exit; end;
  if Edit3.Text='' then begin Edit3.SetFocus; exit; end;
  if Edit4.Text='' then begin Edit4.SetFocus; exit; end;
  if Edit5.Text='' then begin Edit5.SetFocus; exit; end;
  if Edit6.Text='' then begin Edit6.SetFocus; exit; end;
  if Edit7.Text='' then begin Edit7.SetFocus; exit; end;
  if StrToFloat(Edit1.Text)=0
    then
      begin
       Showmessage('Коэффициент при старшей степени должен быть положительным');
       Edit1.Text:='';
       Edit1.SetFocus;
       exit;
      end;
  minparab;
end;

procedure TForm1.Edit2KeyPress(Sender: TObject; var Key: char);
type
  DigitChar = set of '0'..'9';
var
  digit: DigitChar;
  b: boolean;
  k1: byte;
  i: byte;
  h: string;
begin
  h:=Edit2.Text;
  b:=false;
  k1:=0;
  digit:=['0','1','2','3','4','5','6','7','8','9'];
  for i:=1 to length(h) do
    begin
      if (h[i] in digit) and (h[i]<>'0') then b:=true;
      if (h[i] in digit) and (b=true) then k1:=k1+1;
    end;
  case Key of
  '0'..'9':  if (((k1>=15) and (pos('E',h)=0)) or
            ((length(h)>=pos('E',h)+5))and (pos('E',h)>0)) then Key :=Chr(0);
  #8: ;
  ',':  if (pos(',',h)<>0) and (pos('E',h)= 0) then Key :=Chr(0);
  'E':  if pos('E',h)<>0 then Key :=Chr(0);
  '-':  if  length(h) <> pos('E',h)  then Key :=Chr(0);
  #13: Edit3.SetFocus;
  else Key :=Chr(0);
  end;
end;

procedure TForm1.Edit3KeyPress(Sender: TObject; var Key: char);
type
  DigitChar = set of '0'..'9';
var
  digit: DigitChar;
  b: boolean;
  k1: byte;
  i: byte;
  h: string;
begin
  h:=Edit3.Text;
  b:=false;
  k1:=0;
  digit:=['0','1','2','3','4','5','6','7','8','9'];
  for i:=1 to length(h) do
    begin
      if (h[i] in digit) and (h[i]<>'0') then b:=true;
      if (h[i] in digit) and (b=true) then k1:=k1+1;
    end;
  case Key of
  '0'..'9':  if (((k1>=15) and (pos('E',h)=0)) or
            ((length(h)>=pos('E',h)+5))and (pos('E',h)>0)) then Key :=Chr(0);
  #8: ;
  ',':  if (pos(',',h)<>0) and (pos('E',h)= 0) then Key :=Chr(0);
  'E':  if pos('E',h)<>0 then Key :=Chr(0);
  '-':  if  length(h) <> pos('E',h)  then Key :=Chr(0);
  #13: Edit4.SetFocus;
  else Key :=Chr(0);
  end;
end;

procedure TForm1.Edit4KeyPress(Sender: TObject; var Key: char);
type
  DigitChar = set of '0'..'9';
var
  digit: DigitChar;
  b: boolean;
  k1: byte;
  i: byte;
  h: string;
begin
  h:=Edit4.Text;
  b:=false;
  k1:=0;
  digit:=['0','1','2','3','4','5','6','7','8','9'];
  for i:=1 to length(h) do
    begin
      if (h[i] in digit) and (h[i]<>'0') then b:=true;
      if (h[i] in digit) and (b=true) then k1:=k1+1;
    end;
  case Key of
  '0'..'9':  if (((k1>=15) and (pos('E',h)=0)) or
            ((length(h)>=pos('E',h)+5))and (pos('E',h)>0)) then Key :=Chr(0);
  #8: ;
  ',':  if (pos(',',h)<>0) and (pos('E',h)= 0) then Key :=Chr(0);
  'E':  if pos('E',h)<>0 then Key :=Chr(0);
  '-':  if  length(h) <> pos('E',h)  then Key :=Chr(0);
  #13: Edit5.SetFocus;
  else Key :=Chr(0);
  end;
end;

procedure TForm1.Edit5KeyPress(Sender: TObject; var Key: char);
type
  DigitChar = set of '0'..'9';
var
  digit: DigitChar;
  b: boolean;
  k1: byte;
  i: byte;
  h: string;
begin
  h:=Edit5.Text;
  b:=false;
  k1:=0;
  digit:=['0','1','2','3','4','5','6','7','8','9'];
  for i:=1 to length(h) do
    begin
      if (h[i] in digit) and (h[i]<>'0') then b:=true;
      if (h[i] in digit) and (b=true) then k1:=k1+1;
    end;
  case Key of
  '0'..'9':  if (((k1>=15) and (pos('E',h)=0)) or
            ((length(h)>=pos('E',h)+5))and (pos('E',h)>0)) then Key :=Chr(0);
  #8: ;
  ',':  if (pos(',',h)<>0) and (pos('E',h)= 0) then Key :=Chr(0);
  'E':  if pos('E',h)<>0 then Key :=Chr(0);
  '-':  if  length(h) <> pos('E',h)  then Key :=Chr(0);
  #13: Edit6.SetFocus;
  else Key :=Chr(0);
  end;
end;

procedure TForm1.Edit6KeyPress(Sender: TObject; var Key: char);
type
  DigitChar = set of '0'..'9';
var
  digit: DigitChar;
  b: boolean;
  k1: byte;
  i: byte;
  h: string;
begin
  h:=Edit6.Text;
  b:=false;
  k1:=0;
  digit:=['0','1','2','3','4','5','6','7','8','9'];
  for i:=1 to length(h) do
    begin
      if (h[i] in digit) and (h[i]<>'0') then b:=true;
      if (h[i] in digit) and (b=true) then k1:=k1+1;
    end;
  case Key of
  '0'..'9':  if (((k1>=15) and (pos('E',h)=0)) or
            ((length(h)>=pos('E',h)+5))and (pos('E',h)>0)) then Key :=Chr(0);
  #8: ;
  ',':  if (pos(',',h)<>0) and (pos('E',h)= 0) then Key :=Chr(0);
  'E':  if pos('E',h)<>0 then Key :=Chr(0);
  '-':  if  length(h) <> pos('E',h)  then Key :=Chr(0);
  #13: minparab;
  else Key :=Chr(0);
  end;
end;

procedure TForm1.Edit7KeyPress(Sender: TObject; var Key: char);
type
  DigitChar = set of '0'..'9';
var
  digit: DigitChar;
  b: boolean;
  k1: byte;
  i: byte;
  h: string;
begin
  h:=Edit7.Text;
  b:=false;
  k1:=0;
  digit:=['0','1','2','3','4','5','6','7','8','9'];
  for i:=1 to length(h) do
    begin
      if (h[i] in digit) and (h[i]<>'0') then b:=true;
      if (h[i] in digit) and (b=true) then k1:=k1+1;
    end;
  case Key of
  '0'..'9':  if (((k1>=15) and (pos('E',h)=0)) or
            ((length(h)>=pos('E',h)+5))and (pos('E',h)>0)) then Key :=Chr(0);
  #8: ;
  ',':  if (pos(',',h)<>0) and (pos('E',h)= 0) then Key :=Chr(0);
  'E':  if pos('E',h)<>0 then Key :=Chr(0);
  '-':  if  length(h) <> pos('E',h)  then Key :=Chr(0);
  else Key :=Chr(0);
  end;
end;

procedure TForm1.Edit8KeyPress(Sender: TObject; var Key: char);
type
  DigitChar = set of '0'..'9';
var
  digit: DigitChar;
  b: boolean;
  k1: byte;
  i: byte;
  h: string;
begin
  h:=Edit8.Text;
  b:=false;
  k1:=0;
  digit:=['0','1','2','3','4','5','6','7','8','9'];
  for i:=1 to length(h) do
    begin
      if (h[i] in digit) and (h[i]<>'0') then b:=true;
      if (h[i] in digit) and (b=true) then k1:=k1+1;
    end;
  case Key of
  '0'..'9':  if (((k1>=15) and (pos('E',h)=0)) or
            ((length(h)>=pos('E',h)+5))and (pos('E',h)>0)) then Key :=Chr(0);
  #8: ;
  ',':  if (pos(',',h)<>0) and (pos('E',h)= 0) then Key :=Chr(0);
  'E':  if pos('E',h)<>0 then Key :=Chr(0);
  '-':  if  (length(h) <> pos('E',h)) or (pos('E',h)= 0)  then Key :=Chr(0);
  else Key :=Chr(0);
  end;
end;

initialization
  {$I parabola.lrs}

end.