Почему некорректно работает программа на Delphi ?

Question

[Евгений Трофимов]

Требуется написать программу, на вход которой подаются 3 стороны прямоугольника и ,если этот прямоугольник тупоугольный - то она вычислит его площадь и выведет стороны в порядке убывания. Написал программу, которая работает с данными 3,3,5 и 5,3,3 например. Но вот 3,5,3 - не работает. Помогите понять, где ошибка...

Причем еще из наблюдений - если убрать проверку на тупоугольность - то он неправильно выведет числа , а именно 3,5,3 ... Так что скорее всего ошибка именно в сравнении 3-х чисел.

var
a,b,c,a1,b1,c1: integer;
S,p:real;

begin
a:= strtoint (Edit_a.Text);
b:= strtoint (Edit_b.Text);
c:= strtoint (Edit_c.Text);
a1:=a;
b1:=b;
c1:=c;

//Предполагается, что все эти ужасные 6 условий ниже затолкают большую сторону треугольника в С, а две другие в А и B.
if (a<=b) and (a<=c) and (b<=c) then begin a:=a1;b:=b1;c:=c1; end;
if (a<=b) and (a<=c) and (c<=b) then begin a:=a1;b:=c1;c:=b1; end;
if (b<=a) and (b<=c) and (a<=c) then begin a:=b1;b:=a1;c:=c1; end;
if (b<=a) and (b<=c) and (c<=a) then begin a:=b1;b:=c1;c:=a1; end;
if (c<=a) and (c<=b) and (a<=b) then begin a:=c1;b:=a1;c:=b1; end;
if (c<=a) and (c<=b) and (b<=a) then begin a:=c1;b:=b1;c:=a1; end;

//Проверка на равность 2-х сторон
if not ((a=b) or (a=c) or (c=b)) then
  begin
  ShowMessage('Треугольник не равнобедренный !');
  exit;
  end;

//Если квадрат гипотенузы > суммы квадратов катетов - треугольник будет тупоугольным,на это и проверяю
if not ((a*a+b*b<c*c)) then
  begin
  ShowMessage('Треугольник не тупоугольный !');
  exit;
  end;

//Подсчитывается полупериметр, а затем площадь , но проблема точно не в этом
p:=(a+b+c)/2;
S:=Sqrt(p*(p-a)*(p-b)*(p-c));
Edit_result.Text:= 'S=' + formatfloat('0.000',S) + '. Стороны в порядке возрастания: ' + floattostr(a)+', '+ floattostr(b) + ', ' + floattostr(c);

end;
end.

Comments

[zed]

У вас в описании какой-то бред написан. Определитесь, с чем вы имеете дело, с прямоугольником или с треугольником и исправьте описание.

Answer 1

[Антон Федорян]

Предложу свой вариант через массив:

procedure TForm1.Button1Click(Sender: TObject);
var
  rect: array[0..2] of real;
  tmp, p, s: real;
  i: integer;
begin
  rect[0] := StrToFloat(Edit1.Text);
  rect[1] := StrToFloat(Edit2.Text);
  rect[2] := StrToFloat(Edit3.Text);

  if (rect[0] = rect[1]) and (rect[1] = rect[2]) then
    begin
      label1.Caption := 'Равносторонний';
      Exit;
    end;
  if (rect[0] = rect[1]) or (rect[1] = rect[2]) or (rect[0] = rect[2]) then
    begin
      label1.Caption := 'Равнобедренный';
      Exit;
    end;

  //сортируем массив
  for i := 0 to 1 do
    begin
      tmp := rect[i + 1];
      if (rect[i] > rect[i + 1]) then
        begin
          rect[i + 1] := rect[i];
          rect[i] := tmp;
        end;
    end;
  if (rect[0] > rect[1]) then
        begin
          tmp := rect[1];
          rect[1] := rect[0];
          rect[0] := tmp;
        end;

  if (sqrt(rect[0] * rect[0] + rect[1] * rect[1]) = rect[2]) then
    begin
      label1.Caption := 'Прямоугольный';
      Exit;
    end;

  if (rect[0] * rect[0] + rect[1] * rect[1] > rect[2] * rect[2]) then
    begin
      label1.Caption := 'Тупоугольный';
      p := (rect[0] + rect[1] + rect[2]) / 2;
      s := sqrt(p * (p - rect[0]) * (p - rect[1]) * (p - rect[2]));
      label1.Caption := 'Площадь: ' + FloatToStr(s) + #13;
      for i := 0 to 2 do
        label1.Caption := label1.Caption + FloatToStr(rect[i]) + #13;
      Exit;
    end;
end;

Comments

[Антон Федорян]

Еще, после сортировки, можно добавить проверку на существования треугольника с такими сторонами:
if (rect[0] + rect[1] = rect[2]) then
begin
label1.Caption := 'Не существует';
Exit;
end;

Answer 2

[zed]

procedure Sort(var a,b,c: Integer);
var
  a1,b1,c1: Integer;
begin
  a1:=a; b1:=b; c1:=c;
  if (a<=b) and (a<=c) and (b<=c) then begin a:=a1;b:=b1;c:=c1; end else
  if (a<=b) and (a<=c) and (c<=b) then begin a:=a1;b:=c1;c:=b1; end else
  if (b<=a) and (b<=c) and (a<=c) then begin a:=b1;b:=a1;c:=c1; end else
  if (b<=a) and (b<=c) and (c<=a) then begin a:=b1;b:=c1;c:=a1; end else
  if (c<=a) and (c<=b) and (a<=b) then begin a:=c1;b:=a1;c:=b1; end else
  if (c<=a) and (c<=b) and (b<=a) then begin a:=c1;b:=b1;c:=a1; end;
end;

Comments

[Евгений Трофимов]

Огромное спасибо, действительно так куда правильнее !