задача с использованием процедуры Delphi7

[warma2d]

Здравствуйте!

Думал над программой уже несколько дней, как её сделать не знаю, и всё не получается

Прошу помочь, разобраться с последней программой. и тогда будет зачёт

Гарантирую каждому за помощь, даже символическое вознаграждение, правда не денежное)))


Разработать алгоритм и программу решения задачи с использованием процедуры. Передача информации в процедуру должна осуществляться через аппарат формальных-фактических параметров.

Три точки заданы своими декартовыми координатами х={x1,x2}; у = {y1,y2}; z={z1,z2}. Вычислить и напечатать полярные координаты этих точек. Кроме этого, упорядочить и напечатать координаты точек по возрастанию полярного радиуса ρ. Полярный радиус ρ и полярный угол φ вычисляются по формулам .
Перевод декартовых координат в полярные оформить в виде подпрограммы.

до чего смог додумать:

program rabota820;
{$APPTYPE CONSOLE}
uses
  SysUtils,
  math;

Type mas1=array[1..2] of real;
var x1,x2:real;
    i:integer;
    x,y,z:mas1;

//------------------------------------
function fun(n:integer): Real;
var i:integer; fi,P:real;
begin
    For i:=1 to n do begin
P:=power((SQR(X1)+SQR(X2)),(1/2));
Fi:=arctan(x2/x1);
 end;
//-----------------------------------------
 Procedure Proc (x1,x2,y1,y2,z1,z2:real;  var P,Fi:real );
   begin
 P:=fun (X,Y,Z);
  writeln ('P=',x,y,z);
  writeln ('Fi=',x,y,z);
         end;
 //--------------------------------

   begin
  writeln('BBEDUTE KOORDINATY X');
   For i:=1 to 2 do begin
    read(X[i]);end;
    writeln('BBEDUTE KOORDINATY Y');
    For i:=1 to 2 do begin
    read(Y[i]);end;
       writeln('BBEDUTE KOORDINATY Z');
                 For i:=1 to 2 do begin
            read(Z[i]);    end;


          Proc(X,Y,Z);

     readln;readln;

end.

помогите пожалуйста
Всех Заранее Благодарю )))

[alex_fcsm]

TPoint=record
 a,b,p,fi:real;

X:array[1..3] of TPoint;

Вводите все свои данные

for i:=1 to 3 do
 readln(X[i].a,x[i].b);

Делаете процедуру

Procedure Polar(a,b:real; var c,d:real);
begin
c:=sqrt(sqr(a)+sqr(b));
d:=arctan(b/a);
end;

for i:=1 to 3 do
 Polar(x[i].a,x[i].b,x[i].p,x[i].fi);

Сортируете массив по x[i].p

Если правильно понял, то что-то такое.

[warma2d]

alex_fcsm спасибо за ответ
Наверно я уже все-таки в безвыходном положении.
не получается сделать. Помогите пожалуйста
с помощью подсказки получилось как-то вот так:

program rabota820;
{$APPTYPE CONSOLE}
uses
  SysUtils,
  math;

type
TPoint = record
 a,b,p,fi:real;
  end;


var i:integer;
X:array[1..3] of TPoint;



 Procedure Polar(a,b:real; var c,d:real);
begin
c:=sqrt(sqr(a)+sqr(b));
d:=arctan(b/a);
end;

begin
writeln ('v-te Dekartovie koordinaty x,y,z');
for i:=1 to 3 do
 readln(X[i].a,x[i].b);


for i:=1 to 3 do
 Polar(x[i].a,x[i].b,x[i].p,x[i].fi);

 writeln (x[i].a);


  readln;
end.

[alex_fcsm]

Сортировку сделать по x[i].p

[warma2d]

всё равно при таком коде, выдаётся 0
помогите пожалуйста, кто чем может
Вознаграждение обязательно будет каждому, кто поможет!

program rabota820;
{$APPTYPE CONSOLE}
uses
  SysUtils,
  math;

type
TPoint = record
 a,b,p,fi:real;
  end;


var i:integer;
X:array[1..3] of TPoint;



 Procedure Polar(a,b:real; var c,d:real);
begin
c:=sqrt(sqr(a)+sqr(b));
d:=arctan(b/a);
end;

begin
writeln ('v-te Dekartovie koordinaty x,y,z');
for i:=1 to 3 do
 readln(X[i].a,x[i].b);


for i:=1 to 3 do
 Polar(x[i].a,x[i].b,x[i].p,x[i].fi);

 writeln (x[i].p);


  readln;
end.

[rubius2008]

program rabota820;
{$APPTYPE CONSOLE}
uses
  SysUtils,
  math;

Procedure Polar(a,b:real; var c,d:real);
begin
c:=sqrt(sqr(a)+sqr(b));
d:=arctan(b/a);
end;

var x1,x2,y1,y2,z1,z2:real;
begin
  writeln('Tochka x');
  write('x1='); readln(x1);  
  write('x2='); readln(x2); 
  writeln('Tochka y');
  write('y1='); readln(y1);  
  write('y2='); readln(y2); 
  writeln('Tochka z');
  write('z1='); readln(z1);  
  write('z2='); readln(z2);
   
  Polar(x1,x2,x1,x2);
  Polar(y1,y2,y1,y2);
  Polar(z1,z2,z1,z2);

  writeln('Polar coord:');
  writeln('Tochka x{',x1,';',x2,'}');
  writeln('Tochka y{',y1,';',y2,'}');
  writeln('Tochka z{',z1,';',z2,'}');

  writeln('Sort:')
  if x1>y1 then 
    if y1>z1 then begin
      writeln('x{',x1,';',x2,'}');
      writeln('y{',y1,';',y2,'}');
      writeln('z{',z1,';',z2,'}');
    end
    else if x1>z1 then begin
            writeln('x{',x1,';',x2,'}');
            writeln('z{',z1,';',z2,'}');
            writeln('y{',y1,';',y2,'}');
          end
          else begin
            writeln('z{',z1,';',z2,'}');
            writeln('x{',x1,';',x2,'}');
            writeln('y{',y1,';',y2,'}');
          end 
  else if x1>z1 then begin
          writeln('y{',y1,';',y2,'}');
          writeln('x{',x1,';',x2,'}');
          writeln('z{',z1,';',z2,'}');
        end
        else if y1>z1 begin
          writeln('y{',y1,';',y2,'}');
          writeln('z{',z1,';',z2,'}');
          writeln('x{',x1,';',x2,'}');
              end
              else begin
                writeln('z{',z1,';',z2,'}');
                writeln('y{',y1,';',y2,'}');
                writeln('x{',x1,';',x2,'}');
              end;  

readln;
end.

Вот так, может больше писанины, но зато нет сложных типов, да и нагляднее решение, как мне кажется.

[warma2d]

Спасибо огромное rubius2008 за подробный и простой способ решения!

Только подправил чуть-чуть код, чтобы заработал, сделал сортировку P по возрастанию и навёл красивости!

Сейчас получит вознаграждение: rubius2008 и alex_fcsm

Получилось вот так:

program rabota820yes;
{$APPTYPE CONSOLE}
uses
  SysUtils,
  math;

Procedure Polar(a,b:real; var c,d:real);
begin
c:=sqrt(sqr(a)+sqr(b));
d:=arctan(b/a);
end;

var x1,x2,y1,y2,z1,z2:real;
begin
  writeln('Tochka x');
  write('x1='); readln(x1);
  write('x2='); readln(x2);
  writeln('Tochka y');
  write('y1='); readln(y1);
  write('y2='); readln(y2);
  writeln('Tochka z');
  write('z1='); readln(z1);
  write('z2='); readln(z2);

  Polar(x1,x2,x1,x2);
  Polar(y1,y2,y1,y2);
  Polar(z1,z2,z1,z2);

  writeln('Polar coord:');
  writeln('Tochka x{P=',x1:2:2,'; Fi=',x2:2:2,'}');
  writeln('Tochka y{P=',y1:2:2,'; Fi=',y2:2:2,'}');
  writeln('Tochka z{P=',z1:2:2,'; Fi=',z2:2:2,'}');

  writeln('Sort:');
  if x1<y1 then
    if y1<z1 then begin
      writeln('x{ P=',x1:2:2,'; Fi=',x2:2:2,'}');
      writeln('y{ P=',y1:2:2,'; Fi=',y2:2:2,'}');
      writeln('z{ P=',z1:2:2,'; Fi=',z2:2:2,'}');
    end
    else if x1<z1 then begin
            writeln('x{ P=',x1:2:2,'; Fi=',x2:2:2,'}');
            writeln('z{ P=',z1:2:2,'; Fi=',z2:2:2,'}');
            writeln('y{ P=',y1:2:2,'; Fi=',y2:2:2,'}');
          end
          else begin
            writeln('z{ P=',z1:2:2,'; Fi=',z2:2:2,'}');
            writeln('x{ P=',x1:2:2,'; Fi=',x2:2:2,'}');
            writeln('y{ P=',y1:2:2,'; Fi=',y2:2:2,'}');
          end
  else if x1<z1 then begin
          writeln('y{ P=',y1:2:2,'; Fi=',y2:2:2,'}');
          writeln('x{ P=',x1:2:2,'; Fi=',x2:2:2,'}');
          writeln('z{ P=',z1:2:2,'; Fi=',z2:2:2,'}');
        end
        else if y1<z1 then begin
          writeln('y{ P=',y1:2:2,'; Fi=',y2:2:2,'}');
          writeln('z{ P=',z1:2:2,'; Fi=',z2:2:2,'}');
          writeln('x{ P=',x1:2:2,'; Fi=',x2:2:2,'}');
              end
              else begin
                writeln('z{ P=',z1:2:2,'; Fi=',z2:2:2,'}');
                writeln('y{ P=',y1:2:2,'; Fi=',y2:2:2,'}');
                writeln('x{ P=',x1:2:2,'; Fi=',x2:2:2,'}');
              end;

readln;
end.

[rubius2008]

Сообщение от warma2d

Спасибо огромное rubius2008 за подробный и простой способ решения!

Только подправил чуть-чуть код, чтобы заработал, сделал сортировку P по возрастанию и навёл красивости!

Сейчас получит вознаграждение: rubius2008 и alex_fcsm

О да, чет я знаки не те поставил (признаюсь, не тестил).
Награда получена.

[alex_fcsm]

Действительно награда получена. Благодарю. ТС может кстати указать, что именно было под вознаграждением