unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls,Math, ComCtrls;
type
TForm1 =
class(TForm)
Edit1: TEdit;
Edit2: TEdit;
Edit3: TEdit;
Button1: TButton;
Label1: TLabel;
Edit4: TEdit;
Edit5: TEdit;
Button2: TButton;
RichEdit1: TRichEdit;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
Label7: TLabel;
procedure FormCreate(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private-Deklarationen }
public
{ Public-Deklarationen }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
type
MySolution =
Record
a,b,d:double;
c:integer;
// 1: 2 real solution; 2: 1 real solution;
// 3: 2 complex solutions
end;
//Wolfgang Mix - Delphi-PRAXiS
function SolveQuadraticEquation( a, b, c : Double ): MySolution;
var p, q , discriminant, discriminant2, re, im: Double;
begin
// ax² + bx + c = 0
if (a = 0)
then
raise Exception.CreateFmt
('
a should not be zero, no quadratic equation',[result.a]);
p := b / a;
q := c / a;
//if p is a very big number - sqr(p/2) > MaxDouble
if abs(p)>sqrt(Math.MaxDouble)
then begin
showmessage('
p is a very big number');
result.d := 0.25 - (q/p)/p;
im := abs(p)*sqrt(abs(result.d));
if result.d>0
then begin
result.a := -p/2 - sign(p)*im;
result.b := q/result.a;
result.c := 1;
end
else if result.d<0
then begin
Result.a := -p/2;
Result.b := im;
Result.c := 3;
end
else begin
Result.a := -p/2;
Result.b := Result.a;
Result.c := 2;
end;
exit;
end;
// calculate discriminant
discriminant := sqr(p/2) - q;
Result.d := discriminant;
// calculate real value
re:=-p/2;
// calculate imaginary value
im:=sqrt(abs(discriminant));
//Form1.Edit7.Text:=FloatToStr(discriminant);
if discriminant > 0
then
begin // 2 solutions
if p>=0
then
begin
Result.b := -p/2 - sqrt(discriminant);
Result.a := q/Result.b;
//x1 mit Vieta
Result.c := 1;
end
else begin
Result.a := -p/2 + sqrt( discriminant);
Result.b := q/Result.a;
//x2 mit Vieta
Result.c := 1;
end;
end
else
if discriminant < 0
then
begin // 2 complex solutions
Result.a := re;
Result.b := im;
Result.c := 3;
end
else
begin // 2 equal solutions
Result.a := -p/2;
Result.b := Result.a;
Result.c := 2;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var a,b,c,discriminant: double;
indicator:integer;
qs: MySolution;
begin
RichEdit1.Lines.Clear;
a:=StrToFloat(Edit1.Text);
b:=StrToFloat(Edit2.Text);
c:=StrToFloat(Edit3.Text);
if (a=0)
then
begin
// Don't calculate
showmessage ('
a should not be zero, no quadratic equation');
sleep(2000);
exit;
end
else
begin
{WE: Gleichung nur einmal lösen und Ergebnisse anzeigen}
qs := SolveQuadraticEquation(a,b,c);
indicator := qs.c;
case indicator
of
1:
Begin
Label1.Caption:='
2 real solutions';
RichEdit1.Lines.Add ('
X1= ' + FloatToStr(qs.a));
RichEdit1.Lines.Add ('
X2= ' + FloatToStr(qs.b));
End;
2:
Begin
Label1.Caption:='
1 real solution';
RichEdit1.Lines.Add ('
X= ' + FloatToStr(qs.a));
end;
3:
Begin
Label1.Caption:='
2 complex solutions';
RichEdit1.Lines.Add ('
X1= ' + FloatToStr(qs.a)+
'
+ ' + FloatToStr(qs.b)+ '
i ');
RichEdit1.Lines.Add ('
X2= ' + FloatToStr(qs.a)+
'
- ' + FloatToStr(qs.b )+ '
i ');
End;
end;
discriminant:= qs.d;
Edit4.Text:=FloatToStr(discriminant);
Edit5.Text:=IntToStr(indicator);
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
close;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
RichEdit1.Clear;
end;
end.