Создать функции

[neytron007]

Короче есть программа:

{Условие: 11.Даны три числа. Если они могут быть длинами сторон
треугольника, определить его вид (прямоугольный, тупоугольный, остроугольный).
Вычислить длины его высот и напечатать их в порядке убывания.}

program Zadacha11;
{$APPTYPE CONSOLE}
uses
  SysUtils;

const
  arraysize: integer = 3;

var
  a: array of Extended;
  str: string;
  i: Integer;
  OK: boolean;
  s, p, cosA, cosB, cosC, Ha, Hb, Hc, min, max, middle: Extended;

begin
  setlength(a,arraysize);
  for i:=1 to arraysize do
    repeat
      write('Vvedite chislo a',i,': ');
      readln(Str);
      OK := TryStrToFloat(Str,a[i])
    until OK;
  if  (a[1]>0) and (a[2]>0) and (a[3]>0) and (a[1]+a[2]>a[3]) and (a[2]+a[3]>a[1]) and (a[1]+a[3]>a[2])   //условие существования треугольника
  then
    begin
      cosA := (a[2]*a[2]+a[3]*a[3]-a[1]*a[1])/2*a[2]*a[3];   //вычисление косинусов углов треугольника
      cosB := (a[1]*a[1]+a[3]*a[3]-a[2]*a[2])/2*a[1]*a[3];
      cosC := (a[2]*a[2]+a[1]*a[1]-a[3]*a[3])/2*a[1]*a[2];
      p := (a[1]+a[2]+a[3])/2;                               //периметр
      s := sqrt(p*(p-a[1])*(p-a[2])*(p-a[3]));               //площадь
      Ha := 2*s/a[1];                                        //высоты
      Hb := 2*s/a[2];
      Hc := 2*s/a[3];

      if (cosA=0) or (cosB=0) or (cosC=0)                    //прямоугольный треугольник
      then Writeln('Pryamougolniy treugolnik');

      if (cosA<0) or (cosB<0) or (cosC<0)                    //тупоугольный треугольник
      then Writeln('Tupougolniy treugolnik');

      if (cosA>0) and (cosB>0) and (cosC>0)                  //остроугольный треугольник
      then Writeln('Ostrougolniy treugolnik');

      if Ha>=Hb                                              //вычисление max-,min- и middle- высот
      then max := Ha
      else max := Hb;

      if Hc>max
      then max := Hc;

      if Ha>=Hb
      then min := Hb
      else min := Ha;

      if Hc<max
      then min := Hc;

      middle := a[1]+a[2]+a[3]-max-min;
      Writeln('Vysoty : ', max:5:2, ', ', middle:5:2, ', ', min:5:2);   //вывод высот в порядке убывания
    end
  else Writeln('Ne treugolnik!');
  readln;
end.

Надо эти части записать ввиде 3-х функций Proverka, Treugolnik, Poryadok:

  setlength(a,arraysize);
  for i:=1 to arraysize do
    repeat
      write('Vvedite chislo a',i,': ');
      readln(Str);
      OK := TryStrToFloat(Str,a[i])
    until OK;

(a[1]>0) and (a[2]>0) and (a[3]>0) and (a[1]+a[2]>a[3]) and (a[2]+a[3]>a[1]) and (a[1]+a[3]>a[2])

      if Ha>=Hb 
      then max := Ha
      else max := Hb;

      if Hc>max
      then max := Hc;

      if Ha>=Hb
      then min := Hb
      else min := Ha;

      if Hc<max
      then min := Hc;

      middle := a[1]+a[2]+a[3]-max-min;

[p51x]

Вам наше благославление нужно? Вперед, разрешаю.

Что конкретно не получается? Ключевое слово function забыли как пишется?

[neytron007]

я с функциями вообще понятия не имею как работать((( в первый раз это делаю, и не знаю как....полазил по гуглу, вроде написал для первой вот такую

function Proverka(a: array of Extended; str: string; i: Integer; OK: boolean): Extended; //проверка
  begin
    for i:=1 to arraysize do
    repeat
      write('Vvedite chislo a',i,': ');
      readln(Str);
      OK := TryStrToFloat(Str,a[i])
    until OK;
    Result := a[i];
  end;

вставил ее между разделами const и var....потом в теле программы написал

Proverka(a[i],str,i,OK);

попробовал запустить, короче выводит на экран введи а1,а2,а3...ввожу значит, а потом она вылетает, т.е. закрывается...в гугле везде написано как вызывать функцию при работе с формами, а при работе в console aplication не написано, вот и прошу помощи написать что, как и куда написать надо, я в этом вообще ничего не понимаю, в школе мы тольк в пейте рисовали((( не сердитесь на мою глупость

[p51x]

а теперь еще раз смотрите, что вы написали - параметр у функции массив, а передаете?

[gaw4]

а зачем такие хитрые вычисления на предмет определения вида
кажется , достаточно упорядочить a,b,c, и
прямоугольный - если a^2+b^2=c^2
тупоуг - если a^2+b^2<c^2
остроуг - если a^2+b^2>c^2


а, сори, не дочитал условие, там еще высоты надо

[gaw4]

альтернативный алгоритм
1 упорядочить a[1]<a[2]<a[3]
2 //упрощается условие существования
if (a[1]>0) and (a[2]>0) and (a[3]>0) and (a[1]+a[2]>a[3]) then T:=true
3 //по Нерону
p:=(a[1]+a[2]+a[3])/2;
S:=sqrt(p*(p-a[1])*(p-a[2])*(p-a[3]))
//высоты уже упорядочены
for i:=1 to 3 do
result:=result + floattostr(2*S/a[i])+ ' ';

[neytron007]

ды алгоритм хрен с ним...и этот пойдет, главное как функцию сделать и как ее вызвать потом? напишите код вместе с готовой функцией плиз, хотя бы с первой

[gaw4]

могу только на АВС проверить

program Zadacha11;
{$APPTYPE CONSOLE}
uses  crt;
  //SysUtils;

var
  a: array[1..3] of real;
  i,j: Integer;
  at,S, p : real;

//-----------упорядочивание и существование
function T(a: array[1..3] of real): boolean;
  begin
  T:=false;
  for i:=1 to 2 do
        for j:=i to 3 do
if  a[i]>a[j]  then  begin at:= a[i]; a[i]:=a[j];  a[j]:=at; end;
  if  (a[1]>0) and (a[2]>0) and (a[3]>0) and (a[1]+a[2]>a[3])  then T:=true ; //условие существования треугольника
 end;
 
 //----------------------тип треугольника
 function tT(a: array[1..3] of real): string;
  begin
if  power(a[1],2)+power(a[2],2)=power(a[3],2)  then
    tt:='=90'
    else if  power(a[1],2)+power(a[2],2)<power(a[3],2) then
        tt:='>90'
          else tt:='<90'
 end;

 //---------------------высоты
function h(a: array[1..3] of real): string;
  begin
  result:='';
  p:=(a[1]+a[2]+a[3])/2;
  S:=sqrt(p*(p-a[1])*(p-a[2])*(p-a[3]));
  for i:=1 to 3 do
      //result:=result  + floattostr(2*S/a[3+1-i])+ '  ';
      result:=result  + floattostr(2*S/a[i])+ '  ';
 end;

//---------------------------
begin
  for i:=1 to 3 do   // печать
    begin
      write('Vvedite chislo a',i,': ');
      readln(a[i]);
    end;
 writeln; write ('storohy:       ');
    for i:=1 to 3 do    //печать
    begin
      write(a[i],'  ');
    end;
writeln;writeln; write('typ:            ');
   
   if  T(a)=true  //если существует
 then
    begin
          writeln(tt(a));
writeln;write('visota:        ');
           writeln(h(a));
    end
  else
  Writeln('Ne treugolnik!');

  readln;
end.

[Serge_Bliznykov]

кстати, косинусы углов в исходном коде считаются неверно, т.к. пропущены скобки.

должно быть так:

     cosA := (a[2]*a[2]+a[3]*a[3]-a[1]*a[1])/ ( 2*a[2]*a[3] );   //вычисление косинусов углов треугольника
      cosB := (a[1]*a[1]+a[3]*a[3]-a[2]*a[2])/ ( 2*a[1]*a[3] );
      cosC := (a[2]*a[2]+a[1]*a[1]-a[3]*a[3])/ ( 2*a[1]*a[2] );

[neytron007]

Точно, спасибо))) блин, никто что ли не может проверку в функцию запихнуть? как сделать чтобы результатом функции массив одномерный был???