Помогите, пожалуйста, составить программы в Паскале

[совушка]

Помогите, пожалуйста, составить программы в Паскале

Помогите составить программы для задач:
1)Пусть даны три числа. Если они могут быть длинами сторон треугольника, определите его вид (прямоугольный, тупоугольный, остроугольный). Вычислите длины его высот и напечатайте их в порядке убывания.
2)Дано целое число N и набор из N целых чисел. Найти номера первого и последнего минимального элемента из данного набора и вывести их в указанном порядке.
3)Дан целочисленный массив А размера 10. Вывести порядковый номер последнего из тех его элементов Ак , которые удовлетворяют двойному неравенству А1<Ак<А10 . Если таких элементов нет, то вывести 0.
4)Дана строка, состоящая из русских слов, набранных заглавными буквами и разделенных пробелами (одним или несколькими). Найти количество слов, которые содержат ровно три буквы «А».

 

[Vladimir_S]

1)Пусть даны три числа. Если они могут быть длинами сторон треугольника, определите его вид (прямоугольный, тупоугольный, остроугольный). Вычислите длины его высот и напечатайте их в порядке убывания.

Var
 a,b,c,Ha,Hb,Hc,p,S,Alpha,Beta,Gamma,h1,h2,h3:Real;

function ArcCos(X:real):real;
begin
 if Round(X*10000000)=10000000 then ArcCos:=0 else
 if Round(X*10000000)=-10000000 then ArcCos:=Pi else
 ArcCos:=(Pi/2)-ArcTan(X/Sqrt(1-X*X));
end;

Begin
 Write('a= ');
 Readln(a);
 Write('b= ');
 Readln(b);
 Write('c= ');
 Readln(c);
 If ((a+b)<=c) or ((a+c)<=b) or ((b+c)<=a) then
  Writeln('It can not be a triangle!')
 else
  begin
   Alpha:=ArcCos((b*b+c*c-a*a)/(2*b*c));
   Beta:=ArcCos((a*a+c*c-b*b)/(2*a*c));
   Gamma:=ArcCos((a*a+b*b-c*c)/(2*a*b));
   If (Round(Alpha*1000)=Round(Pi*500)) or
      (Round(Beta*1000)=Round(Pi*500)) or
      (Round(Gamma*1000)=Round(Pi*500)) then
    Writeln('Right') else
   If (Alpha>Pi/2) or (Beta>Pi/2) or (Gamma>Pi/2) then
    Writeln('Obtuse') else
    Writeln('Acute');
   p:=(a+b+c)/2;
   S:=Sqrt(p*(p-a)*(p-b)*(p-c));
   Ha:=S*2/a;
   Hb:=S*2/b;
   Hc:=S*2/c;
   If (Ha>Hb) and (Ha>Hc) then
    begin
     h1:=Ha;
     if Hb>Hc then
      begin
       h2:=Hb;
       h3:=Hc;
      end else
      begin
       h2:=Hc;
       h3:=Hb;
      end;
    end
   else
   If (Hb>Ha) and (Hb>Hc) then
    begin
     h1:=Hb;
     if Ha>Hc then
      begin
       h2:=Ha;
       h3:=Hc;
      end else
      begin
       h2:=Hc;
       h3:=Ha;
      end;
    end
   else
    begin
     h1:=Hc;
     if Ha>Hb then
      begin
       h2:=Ha;
       h3:=Hb;
      end else
      begin
       h2:=Hb;
       h3:=Ha;
      end;
    end;
   Writeln('H1 = ',h1:0:3);
   Writeln('H2 = ',h2:0:3);
   Writeln('H3 = ',h3:0:3);
  end;
 Readln
End.

 

[Vladimir_S]

4)Дана строка, состоящая из русских слов, набранных заглавными буквами и разделенных пробелами (одним или несколькими). Найти количество слов, которые содержат ровно три буквы «А».

var
 S:string;
 i,N,M: integer;
 W:Array[1..255] of String;

Function Times(St:String):Boolean;
var
 b:boolean;
 k,p:integer;
begin
 p:=0;
 for k:=1 to Length(St) do
  if St[k]='А' then inc(p);
 Times:=(p=3);
end;

begin
 writeln('Введите строку:');
 readln(S);
 N:=1;
 i:=1;
 M:=0;
 Repeat
  While (S[i]=' ') and (i<Length(S)) do Inc(i);
  W[N]:='';
  While (S[i]<>' ') and (i<=Length(S)) do
   begin
    W[N]:=W[N]+S[i];
    Inc(i);
   end;
  If i<Length(S) then Inc(N);
 Until i>=Length(S);
 For i:=1 to N do
  If Times(W[i]) then
   begin
    Write(W[i]+' ');
    Inc(M);
   end;
 Writeln;
 Writeln(M,' слов');
 Readln
End.