Berikut ini adalah program untuk menentukan akar persamaan kuadrat :
Program akarPK;
uses wincrt,crt;
var a,b,c:real;
D,x1,x2:real;
R,I:real;
pilih:Char;
label baca;
begin
baca:
clrscr;
writeln('program menghitung akar persamaan ax^2+bx+c=0');
writeln;
write('masukkan nilai-nilai a : '); readln(a);
write('masukkan nilai-nilai b : '); readln(b);
write('masukkan nilai-nilai c : '); readln(c);
if a = 0 then
begin writeln('nilai a tidak boleh sama dengan nol ');
goto baca; {ulangi lagi sampai <> 0 !}
end;
(* Tulis persamaan ... *)
writeln ('Anda mempunyai persamaan kuadrat: ');
if a=1 then write ('x^2') else write (a:3:2,'x^2');
if b>0 then
begin
if b=1 then write (' + x')
else write (' + ',b:3:2)
end
else if b < 0 then write(b:3:2);
if c>0 then write (c:3:2)
else if c < 0 then write (c:3:2);
writeln('=0 ');
writeln;
D:=b*b-4*a*c;
if D=0 then
begin
x1:=-b/(2*a);
Writeln('oleh karena itu nilai D = ', D:3:2, ',');
writeln('maka akar-akarnya adlalah x1 = x2 = ',x1:3:2);
end
else if D>0 then
begin
x1:=(-b+sqrt(D))/(2*a);
x2:= (-b-sqrt(D))/(2*a);
writeln('oleh karena itu nilai D = ',D:3:2,',');
writeln('maka akar-akarnya adalah : ');
writeln('x1 = ', x1:3:2, 'dan x2 = ', x2:3:2);
end
else if D < 0 then
begin
R:=-b/(2*a) ; I:=(sqrt(-D))/(2*a);
writeln('Oleh karena itu nilai D = ', D:3:2,',');
writeln('maka akar-akarnya adalah : ');
write('x1= ');
if R<>0 then write (R:3:2);
if I<>0 then write ('+',I:3:2,'i')
else write(I:3:2);
write(' dan x2 = ');
if R<>0 then write (R:3:2);
if i>0 then writeln('-',I:3:2,'i')
else writeln(I:3:2,'i');
end;
writeln;
write('mau menghitung lagi? <y/t> : '); readln(pilih);
if (pilih='y') or (pilih='Y') then goto baca
else writeln( 'selesai ');
end.
