|
Registriert seit: 29. Mai 2002
37.621 Beiträge
Delphi 2006 Professional
|
Re: Programm für kubische Gleichung TESTEN!!!!
17. Mai 2004, 20:58
Grausam. Hast du vorher in Basic programmiert:
Delphi-Quellcode:
procedure TForm1.ButtonRechneClick(Sender: TObject);
Var a,b,c,d,a1,b1,a2,xw,yw,xmax,ymax,xmin,ymin:extended;
x1,x2,x3,y1,y2,y3,G:extended;
code:integer;
s1,s2,s3,s4,s5,s6,s7,s8,s9,s10:string;
s11,s12,s13,s14,s15,s16:string;
i,xl,xr,yu,yo,my,mx,xBo,yBo,xB,yB:integer;
x,y,F,zw,x4,x5,x6,y4,y5,y6:extended;
rect:TRect;
begin
Labelxmax.Caption:='';
Labelxmin.Caption:='';
Labelxw.Caption:='';Labelyw.Caption:='';
Labelnst1.Caption:='';
Labelnst2.Caption:='';Labelnst3.Caption:='';
rect:= Bounds(0,0,Image1.Width,Image1.Height);
Image1.Canvas.Brush.Style:=bsClear;
Image1.Canvas.Brush.Color:=clwhite;
Image1.Canvas.FillRect(rect);
Val(Edita.Text,a,code);
Val(Editb.Text,b,code);
Val(Editc.Text,c,code);
Val(Editd.Text,d,code);
Str(a:4:1,s1);Edita1.Text:=s1;
Str(b:4:1,s2);Editb1.Text:=s2;
Str(c:4:1,s3);Editc1.Text:=s3;
Str(d:4:1,s4);Editd1.Text:=s4;
a1:=a*3;b1:=b*2;a2:=a1*2;
Str(a1:4:1,s5);Editastrich.Text:=s5;
Str(b1:4:1,s6);Editbstrich.Text:=s6;Editcstrich.Text:=s3;
Str(a2:4:1,s7);Editastrich2.Text:=s7;
Editbstrich2.Text:=s6;Editastrich3.Text:=s7;
With Form1.Image1 Do //Graph-Zeichnung
begin
mx:= Image1.ClientWidth div 8;
my:= Image1.ClientHeight div 8;
With Canvas Do
begin
Pen.Style:=psDot;
Pen.Color:=clblue;
Pen.Width:=1;
for i:=0 to 8 do
begin
MoveTo(i*mx,0);LineTo(i*mx,height);
end;
for i:= 0 to 8 do
begin
MoveTo(0,i*my);LineTo(width,i*my);
end;
xBo:= round (4*mx);
yBo:= round (4*my);
Pen.Style:=psSolid;
Pen.Width:=2;
Font.Color:=clblue;
Font.Style:=[fsbold];
MoveTo(0,yBo);LineTo(width,yBo);//x-Achse
MoveTo(xBo,0);LineTo(xBo,height);//y-Achse
TextOut(xBo-15,5,'y');TextOut(ClientWidth -15,yBo+5,'x');
TextOut(xBo+mx,yBo+10,'1');TextOut(xBo-mx,yBo+10,'-1');
TextOut(xBo-20,yBo+my-5,'-1');TextOut(xBo-10,yBo-my-5,'1');
MoveTo(xBo,0);LineTo(xBo-4,10);
MoveTo(xBo,0);LineTo(xBo+4,10);//y-Pfeil
MoveTo(Width,yBo);LineTo(Width-10,yBo-4);
MoveTo(Width,yBo);LineTo(Width-10,yBo+4);//x-Pfeil
For xB:=0 to width Do
begin
x:=xB/mx-4;
y:=a*x*x*x+b*x*x+c*x+d;
yB:=trunc((4-y)*my);
if xB=0 then MoveTo(xB,yB)
else begin Pen.Color:=clblack;
LineTo(xB,yB);
end;
end;
end; // With Canvas Do
end; // With Form2.Image1 Do
if a2=0 then begin Labelxw.Caption:=' / '; //Wendepunkt
Labelyw.Caption:=' / ';
end
else begin xw:=-b1/a2;
yw:=a*xw*xw*xw+b*xw*xw+c*xw+d;
Str(xw:4:2,s8);Str(yw:4:2,s9);
Labelxw.Caption:=s8;Labelyw.Caption:=s9;
end;
if a=0 then begin if b=0 then begin //Extrema
Labelxmin.Caption:='kein Extrema';
end
else begin
if b<0 then begin
x:=-c/b1;
y:=a*x*x*x+b*x*x+c*x+d;
Str(x:4:2,s10);Str(y:4:2,s11);
Labelxmax.Caption:='Maximum ( '+s10+
' | '+s11+ ' )';
end
else begin
x:=-c/b1;
y:=a*x*x*x+b*x*x+c*x+d;
Str(x:4:2,s10);Str(y:4:2,s11);
Labelxmin.Caption:='Minimum ( '+s10+
' | '+s11+ ' )';
end;
end;
end
else begin
G:=b1*b1-4*a1*c;
if G=0 then begin
x:=-b1/(2*a1);
zw:=a2*x+b1;
if zw<0 then begin
y:=a*x*x*x+b*x*x+c*x+d;
Str(x:4:2,s10);Str(y:4:2,s11);
Labelxmax.Caption:='Maximum ( '+s10+
' | '+s11+ ' )';
end
else begin
y:=a*x*x*x+b*x*x+c*x+d;
Str(x:4:2,s10);Str(y:4:2,s11);
Labelxmin.Caption:='Minimum ( '+s10+
' | '+s11+ ' )';
end;
end
else begin
if G<0 then begin
Labelxmin.Caption:='kein Extrema';
end
else begin
x1:=(-b1+sqrt(G))/(2*a1);
x2:=(-b1-sqrt(G))/(2*a1);
y1:=a2*x+b1;
y2:=a2*x1+b1;
if y1>0 then
begin
y:=a*x1*x1*x1+b*x1*x1+c*x1+d;
Str(x1:4:2,s10);Str(y:4:2,s11);
Labelxmin.Caption:='Minimum ( '+s10+
' | '+s11+ ' )';
end
else
begin
y:=a*x1*x1*x1+b*x1*x1+c*x1+d;
Str(x1:4:2,s10);Str(y:4:2,s11);
Labelxmax.Caption:='Maximum ( '+s10+
' | '+s11+ ' )';
end;
if y2>0 then
begin
y:=a*x2*x2*x2+b*x2*x2+c*x2+d;
Str(x2:4:2,s12);Str(y:4:2,s13);
Labelxmax.Caption:='Maximum ( '+s12+
' | '+s13+ ' )';
end
else
begin
y:=a*x2*x2*x2+b*x2*x2+c*x2+d;
Str(x2:4:2,s12);Str(y:4:2,s13);
Labelxmin.Caption:='Minimum ( '+s12+
' | '+s13+ ' )';
end;
end;
end;
end;
if a<>0 then begin
x1:=-100;x2:=100;
repeat //Bisektion
x3:=(x1+x2)/2;
y1:=a*x1*x1*x1+b*x1*x1+c*x1+d;
y2:=a*x2*x2*x2+b*x2*x2+c*x2+d;
y3:=a*x3*x3*x3+b*x3*x3+c*x3+d;
if (y1<0) and (y3>0) and (y2>0) then
begin x1:=x1;x2:=x3;
end;
if (y1<0) and (y3<0) and (y2>0) then
begin x1:=x3;x2:=x2;
end;
if (y1>0) and (y3>0) and (y2<0) then
begin x1:=x2;x2:=x3;
end;
if (y1>0) and (y3<0) and (y2<0) then
begin x1:=x3;x2:=x1;
end;
until abs(y3)<0.000000001;
Str(x3:4:2,s14);
Labelnst1.Caption:='x1= '+s14;
end
else if b>0 then begin x1:=(-c+sqrt(c*c-4*b*d))/(2*b);
x2:=(-c-sqrt(c*c-4*b*d))/(2*b);
Str(x1:4:1,s14);Str(x2:4:1,s15);
Labelnst1.Caption:='x1= '+s14;
Labelnst2.Caption:='x2= '+s15;
end
else begin x1:=-d/c;
Str(x1:4:1,s14);
Labelnst1.Caption:='x1= '+s14;
end;
end;
(Formatierung unverändert.) Wie behältst du da die Übersicht wo ein Block zu ende ist und der nächste anfängt bzw. welches end zu welchem begin gehört?
Hier noch mal "korrekt" formatiert. Kuck dir mal den Unterchied an:
Delphi-Quellcode:
procedure TForm1.ButtonRechneClick(Sender: TObject);
var
a, b, c, d, a1, b1, a2, xw, yw, xmax, ymax, xmin, ymin: extended;
x1, x2, x3, y1, y2, y3, G: extended;
code: integer;
s1, s2, s3, s4, s5, s6, s7, s8, s9, s10: string;
s11, s12, s13, s14, s15, s16: string;
i, xl, xr, yu, yo, my, mx, xBo, yBo, xB, yB: integer;
x, y, F, zw, x4, x5, x6, y4, y5, y6: extended;
rect: TRect;
begin
Labelxmax.Caption := '';
Labelxmin.Caption := '';
Labelxw.Caption := '';
Labelyw.Caption := '';
Labelnst1.Caption := '';
Labelnst2.Caption := '';
Labelnst3.Caption := '';
rect := Bounds(0, 0, Image1.Width, Image1.Height);
Image1.Canvas.Brush.Style := bsClear;
Image1.Canvas.Brush.Color := clwhite;
Image1.Canvas.FillRect(rect);
Val(Edita.Text, a, code);
Val(Editb.Text, b, code);
Val(Editc.Text, c, code);
Val(Editd.Text, d, code);
Str(a: 4: 1, s1);
Edita1.Text := s1;
Str(b: 4: 1, s2);
Editb1.Text := s2;
Str(c: 4: 1, s3);
Editc1.Text := s3;
Str(d: 4: 1, s4);
Editd1.Text := s4;
a1 := a * 3;
b1 := b * 2;
a2 := a1 * 2;
Str(a1: 4: 1, s5);
Editastrich.Text := s5;
Str(b1: 4: 1, s6);
Editbstrich.Text := s6;
Editcstrich.Text := s3;
Str(a2: 4: 1, s7);
Editastrich2.Text := s7;
Editbstrich2.Text := s6;
Editastrich3.Text := s7;
with Form1.Image1 do //Graph-Zeichnung
begin
mx := Image1.ClientWidth div 8;
my := Image1.ClientHeight div 8;
with Canvas do
begin
Pen.Style := psDot;
Pen.Color := clblue;
Pen.Width := 1;
for i := 0 to 8 do
begin
MoveTo(i * mx, 0);
LineTo(i * mx, height);
end;
for i := 0 to 8 do
begin
MoveTo(0, i * my);
LineTo(width, i * my);
end;
xBo := round(4 * mx);
yBo := round(4 * my);
Pen.Style := psSolid;
Pen.Width := 2;
Font.Color := clblue;
Font.Style := [fsbold];
MoveTo(0, yBo);
LineTo(width, yBo); //x-Achse
MoveTo(xBo, 0);
LineTo(xBo, height); //y-Achse
TextOut(xBo - 15, 5, 'y');
TextOut(ClientWidth - 15, yBo + 5, 'x');
TextOut(xBo + mx, yBo + 10, '1');
TextOut(xBo - mx, yBo + 10, '-1');
TextOut(xBo - 20, yBo + my - 5, '-1');
TextOut(xBo - 10, yBo - my - 5, '1');
MoveTo(xBo, 0);
LineTo(xBo - 4, 10);
MoveTo(xBo, 0);
LineTo(xBo + 4, 10); //y-Pfeil
MoveTo(Width, yBo);
LineTo(Width - 10, yBo - 4);
MoveTo(Width, yBo);
LineTo(Width - 10, yBo + 4); //x-Pfeil
for xB := 0 to width do
begin
x := xB / mx - 4;
y := a * x * x * x + b * x * x + c * x + d;
yB := trunc((4 - y) * my);
if xB = 0 then
MoveTo(xB, yB)
else
begin
Pen.Color := clblack;
LineTo(xB, yB);
end;
end;
end; // With Canvas Do
end; // With Form2.Image1 Do
if a2 = 0 then
begin
Labelxw.Caption := ' / '; //Wendepunkt
Labelyw.Caption := ' / ';
end
else
begin
xw := -b1 / a2;
yw := a * xw * xw * xw + b * xw * xw + c * xw + d;
Str(xw: 4: 2, s8);
Str(yw: 4: 2, s9);
Labelxw.Caption := s8;
Labelyw.Caption := s9;
end;
if a = 0 then
begin
if b = 0 then
begin //Extrema
Labelxmin.Caption := 'kein Extrema';
end
else
begin
if b < 0 then
begin
x := -c / b1;
y := a * x * x * x + b * x * x + c * x + d;
Str(x: 4: 2, s10);
Str(y: 4: 2, s11);
Labelxmax.Caption := 'Maximum ( ' + s10 +
' | ' + s11 + ' )';
end
else
begin
x := -c / b1;
y := a * x * x * x + b * x * x + c * x + d;
Str(x: 4: 2, s10);
Str(y: 4: 2, s11);
Labelxmin.Caption := 'Minimum ( ' + s10 +
' | ' + s11 + ' )';
end;
end;
end
else
begin
G := b1 * b1 - 4 * a1 * c;
if G = 0 then
begin
x := -b1 / (2 * a1);
zw := a2 * x + b1;
if zw < 0 then
begin
y := a * x * x * x + b * x * x + c * x + d;
Str(x: 4: 2, s10);
Str(y: 4: 2, s11);
Labelxmax.Caption := 'Maximum ( ' + s10 +
' | ' + s11 + ' )';
end
else
begin
y := a * x * x * x + b * x * x + c * x + d;
Str(x: 4: 2, s10);
Str(y: 4: 2, s11);
Labelxmin.Caption := 'Minimum ( ' + s10 +
' | ' + s11 + ' )';
end;
end
else
begin
if G < 0 then
begin
Labelxmin.Caption := 'kein Extrema';
end
else
begin
x1 := (-b1 + sqrt(G)) / (2 * a1);
x2 := (-b1 - sqrt(G)) / (2 * a1);
y1 := a2 * x + b1;
y2 := a2 * x1 + b1;
if y1 > 0 then
begin
y := a * x1 * x1 * x1 + b * x1 * x1 + c * x1 + d;
Str(x1: 4: 2, s10);
Str(y: 4: 2, s11);
Labelxmin.Caption := 'Minimum ( ' + s10 +
' | ' + s11 + ' )';
end
else
begin
y := a * x1 * x1 * x1 + b * x1 * x1 + c * x1 + d;
Str(x1: 4: 2, s10);
Str(y: 4: 2, s11);
Labelxmax.Caption := 'Maximum ( ' + s10 +
' | ' + s11 + ' )';
end;
if y2 > 0 then
begin
y := a * x2 * x2 * x2 + b * x2 * x2 + c * x2 + d;
Str(x2: 4: 2, s12);
Str(y: 4: 2, s13);
Labelxmax.Caption := 'Maximum ( ' + s12 +
' | ' + s13 + ' )';
end
else
begin
y := a * x2 * x2 * x2 + b * x2 * x2 + c * x2 + d;
Str(x2: 4: 2, s12);
Str(y: 4: 2, s13);
Labelxmin.Caption := 'Minimum ( ' + s12 +
' | ' + s13 + ' )';
end;
end;
end;
end;
if a <> 0 then
begin
x1 := -100;
x2 := 100;
repeat //Bisektion
x3 := (x1 + x2) / 2;
y1 := a * x1 * x1 * x1 + b * x1 * x1 + c * x1 + d;
y2 := a * x2 * x2 * x2 + b * x2 * x2 + c * x2 + d;
y3 := a * x3 * x3 * x3 + b * x3 * x3 + c * x3 + d;
if (y1 < 0) and (y3 > 0) and (y2 > 0) then
begin
x1 := x1;
x2 := x3;
end;
if (y1 < 0) and (y3 < 0) and (y2 > 0) then
begin
x1 := x3;
x2 := x2;
end;
if (y1 > 0) and (y3 > 0) and (y2 < 0) then
begin
x1 := x2;
x2 := x3;
end;
if (y1 > 0) and (y3 < 0) and (y2 < 0) then
begin
x1 := x3;
x2 := x1;
end;
until abs(y3) < 0.000000001;
Str(x3: 4: 2, s14);
Labelnst1.Caption := 'x1= ' + s14;
end
else if b > 0 then
begin
x1 := (-c + sqrt(c * c - 4 * b * d)) / (2 * b);
x2 := (-c - sqrt(c * c - 4 * b * d)) / (2 * b);
Str(x1: 4: 1, s14);
Str(x2: 4: 1, s15);
Labelnst1.Caption := 'x1= ' + s14;
Labelnst2.Caption := 'x2= ' + s15;
end
else
begin
x1 := -d / c;
Str(x1: 4: 1, s14);
Labelnst1.Caption := 'x1= ' + s14;
end;
end;
PS: Ich habe den langen Code extra gepostet, damit man vergleichen kann. Bitte nicht nach machen im Forum, sondern gegebenenfalls als Anhang anhängen. 
Michael
Ein Teil meines Codes würde euch verunsichern.
|