unit LKardano;

interface

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

type
  TForm1 = class(TForm)
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    Label10: TLabel;
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    Edit4: TEdit;
    Edit5: TEdit;
    Edit6: TEdit;
    Label11: TLabel;
    Label12: TLabel;
    Edit7: TEdit;
    Edit8: TEdit;
    Edit9: TEdit;
    Edit10: TEdit;
    Edit11: TEdit;
    Edit12: TEdit;
    Edit13: TEdit;
    Label13: TLabel;
    Label14: TLabel;
    Label15: TLabel;
    Label16: TLabel;
    Label17: TLabel;
    Label18: TLabel;
    Label19: TLabel;
    Label20: TLabel;
    Button1: TButton;
    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 Button1Click(Sender: TObject);
    procedure Edit1Change(Sender: TObject);
    procedure Edit2Change(Sender: TObject);
    procedure Edit3Change(Sender: TObject);
    procedure Edit4Change(Sender: TObject);
    procedure FormActivate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

procedure Kardano;
var
  A,B,C,D: real; {коэффициенты кубического уравнения A*x^3+B*x^2+C*x+D=0}
  p, q: real; {коэффициенты кубического уравнения y^3+p*y+q=0, x=y-B/(3*A)}
  S: real;  {Дискриминант кубического уравнения S=q*q/4+p*p*p/27}
  F: real; {аргумент комплексного корня}
  Re: real; {дейстаительная часть комплексно-сопряжённых корней}
  Im: real; {мнимая часть комплексно-сопряжённых корней}
  y1: real; {y1=(-q/2+Sqrt(q*q/4+p*p*p/27))^(1/3)}
  y2: real; {y1=(-q/2-Sqrt(q*q/4+p*p*p/27))^(1/3)}
  x1,x2,x3: real;{точные корни уравнения A*x^3+B*x^2+C*x+D=0 }
begin
  A:=StrToFloat(Form1.Edit1.Text);
  B:=StrToFloat(Form1.Edit2.Text);
  C:=StrToFloat(Form1.Edit3.Text);
  D:=StrToFloat(Form1.Edit4.Text);
  p := (3*A*C-B*B)/(3*A*A);
  q := (2*B*B*B-9*A*B*C+27*A*A*D)/(27*A*A*A);
  S := (4*(3*A*C-B*B)*(3*A*C-B*B)*(3*A*C-B*B)
       +(2*B*B*B-9*A*B*C+27*A*A*D)*(2*B*B*B-9*A*B*C+27*A*A*D))
       /(2916*A*A*A*A*A*A);
  Form1.Edit5.Text := FloatToStr(p);
  Form1.Edit6.Text := FloatToStr(q);
  Form1.Edit7.Text := floatToStr(S);
  y1:=0; y2:=0; F:=0;
  if S<0
    then
      begin
        if q<0 then F:=Arctan(-2*Sqrt(-S)/q);
        if q>0 then F:=Arctan(-2*Sqrt(-S)/q)+Pi;
        if q=0 then F:=Pi/2;
        x1:=2*Sqrt(-p/3)*Cos(F/3)-B/A/3;
        x2:=2*Sqrt(-p/3)*Cos((F+2*Pi)/3)-B/A/3;
        x3:=2*Sqrt(-p/3)*Cos((F+4*Pi)/3)-B/A/3;
        if q=0 then x3:=-B/A/3;
        Form1.Edit8.Text := FloatToStr(x1);
        Form1.Edit9.Text := FloatToStr(x2);
        Form1.Edit10.Text:= FloatToStr(x3);
      end;
  if S>0
    then
      begin
        if -q/2+Sqrt(S)>0 then y1:=exp(ln(abs(-q/2+Sqrt(S)))/3);
        if -q/2+Sqrt(S)<0 then y1:=-exp(ln(abs(-q/2+Sqrt(S)))/3);
        if -q/2+Sqrt(S)=0 then y1:=0;
        if -q/2-Sqrt(S)>0 then y2:=exp(ln(abs(-q/2-Sqrt(S)))/3);
        if -q/2-Sqrt(S)<0 then y2:=-exp(ln(abs(-q/2-Sqrt(S)))/3);
        if -q/2-Sqrt(S)=0 then y2:=0;
        x1:=y1+y2-B/A/3;
        Re:=-(y1+y2)/2-B/A/3;
        Im:=(y1-y2)*Sqrt(3)/2;
        Form1.Edit8.Text := FloatToStr(x1);
        Form1.Edit9.Text := FloatToStr(Re)+' + i * '+FloatToStr(Im);
        Form1.Edit10.Text:= FloatToStr(Re)+' - i * '+FloatToStr(Im);
      end;
  if S=0
    then
      begin
        if q<0 then y1:=exp(ln(abs(-q/2))/3);
        if q>0 then y1:=-exp(ln(abs(-q/2))/3);
        if q=0 then y1:=0;
        x1:=2*y1-B/A/3;
        x2:=-y1-B/A/3;
        x3:=-y1-B/A/3;
        Form1.Edit8.Text := FloatToStr(x1);
        Form1.Edit9.Text := FloatToStr(x2);
        Form1.Edit10.Text:= FloatToStr(x3);
      end;
end;

procedure PSolution3;
var
  A,B,C,D:real;{коэффициенты кубического уравнения}
  X4,X5,X6:real; { приближённые корни кубичнеского уравнения}
  PRE, PIm:real;
begin
  A:=StrToFloat(Form1.Edit1.Text);
  B:=StrToFloat(Form1.Edit2.Text);
  C:=StrToFloat(Form1.Edit3.Text);
  D:=StrToFloat(Form1.Edit4.Text);
  X4:=StrToFloat(Form1.Edit11.Text);
  if Sqr(B+A*X4)-4*A*(C+B*X4+A*X4*X4)>0
    then
      begin
        X5:=(-B-A*X4+Sqrt(Sqr(B+A*X4)-4*A*(C+B*X4+A*X4*X4)))/2/A;
        X6:=(-B-A*X4-Sqrt(Sqr(B+A*X4)-4*A*(C+B*X4+A*X4*X4)))/2/A;
        Form1.Edit12.Text := FloatToStr(X5);
        Form1.Edit13.Text := FloatToStr(X6);
      end
    else
      begin
        PRe:=(-B-A*X4)/2/A;
        PIm:=(Sqrt(-Sqr(B+A*X4)+4*A*(C+B*X4+A*X4*X4)))/2/A;
        Form1.Edit11.Text := FloatToStr(X4);
        Form1.Edit12.Text := FloatToStr(PRe)+' + i * '+FloatToStr(PIm);
        Form1.Edit13.Text := FloatToStr(PRe)+' - i * '+FloatToStr(PIm);
      end;
end;

procedure PReal;
const
  DX=0.000000000000001;{погрешность вычисления}
var
  A,B,C,D:real;{коэффициенты кубического уравнения}
  M,Z1,Z2,Z0:real;
  I,N:integer;
  X4:real; { приближённые корни кубичнеского уравнения}
function Y(X:real):real;
begin
  Y:=A*X*X*X+B*X*X+C*X+D;
end;
begin
  A:=StrToFloat(Form1.Edit1.Text);
  B:=StrToFloat(Form1.Edit2.Text);
  C:=StrToFloat(Form1.Edit3.Text);
  D:=StrToFloat(Form1.Edit4.Text);
  M:=1;
  if Y(-M)*Y(+M)>0
    then
      repeat
        M:=M*2;
      until Y(-M)*Y(+M)<=0;
  if Y(-M)=0
    then
      begin
        X4:=-M;
        Form1.Edit11.Text := FloatToStr(X4);
        PSolution3;
        Exit;
      end;
  if Y(M)=0
    then
      begin
        X4:=M;
        Form1.Edit11.Text := FloatToStr(X4);
        PSolution3;
        Exit;
      end;
  Z1:=-M;
  Z2:=M;
  N:=Round(Ln(2*M/DX)/Ln(2));
  for I:=1 to N do
  begin
    Z0:=(Z1+Z2)/2;
    if Y(Z1)*Y(Z0)<0 then Z2:=Z0;
    if Y(Z1)*Y(Z0)>0 then Z1:=Z0;
    if Y(z0)=0
      then
        begin
          X4:=Z0;
          Form1.Edit11.Text := FloatToStr(X4);
          PSolution3;
          exit;
        end;
     Z0:=(Z1+Z2)/2;
  end;
  X4:=Z0;
  Form1.Edit11.Text := FloatToStr(X4);
  PSolution3;
end;

procedure sqr;
var
  a, b, c: real;// коэфиициенты квадратного уравнения
  D: real; //дискриминант
  x1, x2: real; //корни квадратного уравнения
  Re, Im: real; //действительная и мнимая части комплексного корня.
begin
  a:=StrToFloat(Form1.Edit2.Text);
  b:=StrToFloat(Form1.Edit3.Text);
  c:=StrToFloat(Form1.Edit4.Text);
  D:=b*b-4*a*c;
  if (a=0)
    then
      if b=0
        then
          if c=0 then Form1.Edit8.Text := 'Любое число удовлетворяет уравнению'
                 else Form1.Edit8.Text := 'Уравнение не имеет решений'
        else  Form1.Edit8.Text := FloatTostr(-c/b)
    else
      if (D=0) or (D>0)
        then
          begin
            x1:=(-b+Sqrt(D))/2/a;
            x2:=(-b-Sqrt(D))/2/a;
            Form1.Edit8.Text:=FloatToStr(x1);
            Form1.Edit9.Text:=FloatToStr(x2);
          end
        else
          begin
             Re:= -b/2/a;
             Im:= Abs(Sqrt(-D)/2/a);
             Form1.Edit9.Text:=FloatToStr(Re)+'   +  i * '+FloatToStr(Im);
             Form1.Edit10.Text:=FloatToStr(Re)+'   -  i * '+FloatToStr(Im);
          end;
end;

{$R *.dfm}

procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
  case Key of
      #8, '0'..'9': ;//цифры и клавиша <Back Space>
      #13:         Edit2.SetFocus;
      '.',',':
            begin
              if Key <> DecimalSeparator then
                 Key:=DecimalSeparator;//заменим разделитель на допустимый
              if Pos(DecimalSeparator, Edit1.Text)<>0
                 then Key := Chr(0); //запрет на ввод второго разделителя
            end;
      '-': //минус можно вводить только первым символом,
           //т.е когда ячейка пустая
              if Length(Edit1.Text) <> 0
                 then Key := Chr(0);
      else Key:=Chr(0);//остальные символы запрещены
  end;
end;

procedure TForm1.Edit2KeyPress(Sender: TObject; var Key: Char);
begin
  case Key of
      #8, '0'..'9': ;//цифры и клавиша <Back Space>
      #13:         Edit3.SetFocus;
      '.',',':
            begin
              if Key <> DecimalSeparator then
                 Key:=DecimalSeparator;//заменим разделитель на допустимый
              if Pos(DecimalSeparator, Edit2.Text)<>0
                 then Key := Chr(0); //запрет на ввод второго разделителя
            end;
      '-': //минус можно вводить только первым символом,
           //т.е когда ячейка пустая
              if Length(Edit2.Text) <> 0
                 then Key := Chr(0);
      else Key:=Chr(0);//остальные символы запрещены
  end;
end;

procedure TForm1.Edit3KeyPress(Sender: TObject; var Key: Char);
begin
  case Key of
      #8, '0'..'9': ;//цифры и клавиша <Back Space>
      #13:         Edit4.SetFocus;
      '.',',':
            begin
              if Key <> DecimalSeparator then
                 Key:=DecimalSeparator;//заменим разделитель на допустимый
              if Pos(DecimalSeparator, Edit3.Text)<>0
                 then Key := Chr(0); //запрет на ввод второго разделителя
            end;
      '-': //минус можно вводить только первым символом,
           //т.е когда ячейка пустая
              if Length(Edit3.Text) <> 0
                 then Key := Chr(0);
      else Key:=Chr(0);//остальные символы запрещены
  end;
end;

procedure TForm1.Edit4KeyPress(Sender: TObject; var Key: Char);
var
  h: real;
begin
  h:=StrToFloat(Edit1.text);
  case Key of
      #8, '0'..'9': ;//цифры и клавиша <Back Space>
      #13:
        begin
          if h=0
           then
             begin
               Sqr;
             end
           else
             begin
               Kardano;
               PReal;
             end;
        end;
      '.',',':
            begin
              if Key <> DecimalSeparator then
                 Key:=DecimalSeparator;//заменим разделитель на допустимый
              if Pos(DecimalSeparator, Edit4.Text)<>0
                 then Key := Chr(0); //запрет на ввод второго разделителя
            end;
      '-': //минус можно вводить только первым символом,
           //т.е когда ячейка пустая
              if Length(Edit4.Text) <> 0
                 then Key := Chr(0);
      else Key:=Chr(0);//остальные символы запрещены
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  h: real;
begin
  h:=StrToFloat(Form1.Edit1.Text);
  if h=0
    then
      begin
        Sqr;
      end
    else
      begin
        Kardano;
        PReal;
      end;
end;

procedure TForm1.Edit1Change(Sender: TObject);
begin
  Edit5.Text:='';
  Edit6.Text:='';
  Edit7.Text:='';
  Edit8.Text:='';
  Edit9.Text:='';
  Edit10.Text:='';
  Edit11.Text:='';
  Edit12.Text:='';
  Edit13.Text:='';
end;

procedure TForm1.Edit2Change(Sender: TObject);
begin
  Edit5.Text:='';
  Edit6.Text:='';
  Edit7.Text:='';
  Edit8.Text:='';
  Edit9.Text:='';
  Edit10.Text:='';
  Edit11.Text:='';
  Edit12.Text:='';
  Edit13.Text:='';
end;

procedure TForm1.Edit3Change(Sender: TObject);
begin
  Edit5.Text:='';
  Edit6.Text:='';
  Edit7.Text:='';
  Edit8.Text:='';
  Edit9.Text:='';
  Edit10.Text:='';
  Edit11.Text:='';
  Edit12.Text:='';
  Edit13.Text:='';
end;

procedure TForm1.Edit4Change(Sender: TObject);
begin
  Edit5.Text:='';
  Edit6.Text:='';
  Edit7.Text:='';
  Edit8.Text:='';
  Edit9.Text:='';
  Edit10.Text:='';
  Edit11.Text:='';
  Edit12.Text:='';
  Edit13.Text:='';
end;

procedure TForm1.FormActivate(Sender: TObject);
begin
  Edit1.Text:='1';
  Edit2.SetFocus;
end;

end.