Если дискриминант равен нулю то из него не извлекая корень решать дальше

case ord(a=0) of
1:begin
   write('Это не квадратное уравнение');
   readln;
   exit;
  end;
0:begin
  d:=b*b-4*a*c;
  case d of
  -maxint-1..-1: write('Дискриминант отрицательный, решений нет');
              0: write('Дискриминат=0, 1 корень x=',(-b/(2*a)));
      1..maxint: write('Дискриминант положительный, 2 корня x1=',(-b+sqrt(d))/(2*a)):0:2,
                       '  x2=',(-b-sqrt(d))/(2*a)):0:2);
  end;
  end;
end;

case ord(a=0) of
1:write('Это не квадратное уравнение');
0:begin
  d:=b*b-4*a*c;
  case ord(d>=0)of
  0:write('Дискриминант отрицательный, решений нет');
  1:case ord(d=0) of
    1:write('Дискриминат=0, 1 корень x=',(-b/(2*a)));
    else write('Дискриминант положительный, 2 корня x1=',(-b+sqrt(d))/(2*a)):0:2,
                       '  x2=',(-b-sqrt(d))/(2*a)):0:2);
    end;
  end;
 end; 
end;

uses crt;
var a,b,c,d:real;
begin
clrscr;
writeln('Коэффициенты уравнения a,b,c:');
readln(a,b,c);
case ord(a=0) of
1:write('Это не квадратное уравнение');
0:begin
  d:=b*b-4*a*c;
  case ord(d>=0)of
  0:write('Дискриминант отрицательный, решений нет');
  1:case ord(d=0) of
    1:write('Дискриминат=0, 1 корень x=',(-b/(2*a)));
        else write('Дискриминант положительный, 2 корня x1=',(-b+sqrt(d))/(2*a):0:2,
                       '  x2=',(-b-sqrt(d))/(2*a):0:2);
    end;
  end;
 end; 
end;
readln
end.