Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Паскаль, Turbo Pascal, PascalABC.NET
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 19.11.2012, 00:28   #1
Medu3a
Новичок
Джуниор
 
Регистрация: 19.11.2012
Сообщений: 2
По умолчанию процедуры без параметров, нужно сделать с параметрами

Код:
Program Kursach;

Var a: array [1..6,1..6] of real;
    b,c: array [1..6] of real;
    g: array [1..6] of string;
    i,j,imax,jmax,N: integer;
    obsch,max,s,prozent: real;
    gor: string;
    f,f1,f2: text;

Procedure file_gorodov;
Begin
   Assign(f1,'C:\Users\Warrior\Desktop\ГОТОВЫЙ\Файлы\Goroda.txt');
   reset(f1);
   for i:=1 to N do
        readln(f1,g[i]);
close(f1);
end;

Procedure matriza_perevozok;
Begin
  Assign(f2,'C:\Users\Warrior\Desktop\ГОТОВЫЙ\Файлы\matriza_perevozok.txt');
  reset(f2);
  for i:=1 to N do
  Begin
   for j:=1 to N do
    read(f2,a[i,j]);
  end;
 close(f2);
end;

Procedure summa_po_strokam;
begin
  for i:=1 to N do
      b[i]:=0;
  for i:=1 to N do
   begin
   for j:=1 to N do
     b[i]:=b[i]+a[i,j];
  end;
end;

Procedure summa_po_stolbcam;
begin
  for j:=1 to N do
    c[j]:=0;
   obsch:=0;
   for j:=1 to N do
   begin
    for i:=1 to N do
        c[j]:=c[j]+a[i,j];
  obsch:=obsch+c[j];
  end;
end;

Procedure mest_soob;
begin
s:=0;
 for i:=1 to N do
  for j:=1 to N do
    if (i=j) then
       s:=s+a[i,j];
  Writeln('Сумма количества грузов в местном сообщении = ',s);
 Writeln;
end;

Procedure max_na_diagonali;
begin
max:=a[1,1];
gor:=g[1];
For i:=1 to N do
 for j:=1 to N do
  begin
   if (i=j) and (a[i,j]>=max) then
     begin
       max:=a[i,j];
       gor:=g[i];
       imax:=i;
       jmax:=j;
    end;
  end;
  Writeln('Максимальная перевозка ',max,'. ','Откуда - ',gor);
end;

Procedure umenshenie;
begin
prozent:=prozent/100;
For j:=1 to N do
 begin
   For i:=1 to N do
    if (i=imax) and (j=jmax) then a[i,j]:=a[i,j]-(a[i,j]*prozent);
 end;
end;

Procedure Vivod_na_ekran;
begin
for j:=1 to n+2 do
write('_____________');
Writeln;
write('|');
write('из \ на':12);
write('|');
 for i:=1 to N do
  begin
   write(g[i]:12);
   write('|');
  end;
 write('Итого':12);
 write('|');
Writeln;
for j:=1 to n+2 do
write('|____________');
write('|');
Writeln;
for i:=1 to N do
 begin
  write('|');
  write(g[i]:12);
  write('|');
    for j:=1 to N do
     write(a[i,j]:12:2,'|');
     write(b[i]:12:2);
     write('|');
     Writeln;
    begin
     for j:=1 to n+2 do
      write('|____________');
      write('|');
      Writeln;
    end;
 end;
 write('|');
write('Итого':12);
write('|');
 for j:=1 to N do
  begin
   write(c[j]:12:2);
   write('|');
  end;
  write(obsch:12:2);
  write('|');
  Writeln;
    for j:=1 to n+2 do
    write('|____________');
    write('|');
    Writeln;
Writeln;
Writeln;
end;
Procedure Vivod_v_file;
begin
for j:=1 to n+2 do
write(f,'_____________');
Writeln(f);
write(f,'|');
write(f,'из \ на':12);
write(f,'|');
 for i:=1 to N do
  begin
   write(f,g[i]:12);
   write(f,'|');
  end;
write(f,'Итого':12);
write(f,'|');
Writeln(f);
for j:=1 to n+2 do
write(f,'|____________');
write(f,'|');
Writeln(f);
for i:=1 to N do
 begin
  write(f,'|');
  write(f,g[i]:12);
  write(f,'|');
    for j:=1 to N do
     write(f,a[i,j]:12:2,'|');
     write(f,b[i]:12:2);
     write(f,'|');
     Writeln(f);
    begin
     for j:=1 to n+2 do
      write(f,'|____________');
      write(f,'|');
      Writeln(f);
    end;
 end;
 write(f,'|');
write(f,'Итого':12);
write(f,'|');
 for j:=1 to N do
  begin
   write(f,c[j]:12:2);
   write(f,'|');
  end;
  write(f,obsch:12:2);
  write(f,'|');
  Writeln(f);
    for j:=1 to n+2 do
    write(f,'|____________');
    write(f,'|');
    Writeln(f);
Writeln(f);
Writeln(f);
end;

Begin
     Writeln('                                  К У Р С О В А Я   Р А Б О Т А   ');
     Writeln('Определить регионы местного сообщения между которыми установлена максимальная перевозка грузов.');
     Writeln('По региону, прибытия данного груза, его размер уменьшить на 7%!');
     Writeln('Введите количество регионов (не более 6):');
     Readln(N);
     file_gorodov;
     matriza_perevozok;
     summa_po_stolbcam;      {Суммы по столбцам}
     summa_po_strokam;       {Суммы по строкам}
     Assign(f,'C:\Users\Warrior\Desktop\ГОТОВЫЙ\Файлы\Rezultat.txt');   {Открываем файл}
     rewrite(f);                            {Очищаем для записи}
     Vivod_na_ekran;        {Вывод таблицы перевозок}
     Vivod_v_file;
     mest_soob;    {Сумма перевозок местного сообщения}     
     Max_na_diagonali;         {Нахождение региона с макс-й перевозкой} 
     Readln(prozent);
     Writeln(f,'Введённый процент: ',prozent);
     umenshenie;         {Уменьшение кол-ва перевозок по найденному региону}
     summa_po_stolbcam;     {Пересчёт сумм по столбцам}
     summa_po_strokam;      {Пересчёт сумм по строкам}
     Vivod_na_ekran;        {Вывод изменённой матрицы} 
     Vivod_v_file;   
     close(f);
End.
__
Код нужно оформлять по правилам:
тегом [CODE]..[/СODE] (это кнопочка с решёточкой #)
Не забывайте об этом!
Модератор.

Последний раз редактировалось Serge_Bliznykov; 19.11.2012 в 09:43.
Medu3a вне форума Ответить с цитированием
Старый 19.11.2012, 00:36   #2
Medu3a
Новичок
Джуниор
 
Регистрация: 19.11.2012
Сообщений: 2
По умолчанию файлы

Goroda.txt

matriza_perevozok.txt

Rezultat.txt
Medu3a вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
процедуры без параметров Luckyman Помощь студентам 0 06.06.2011 16:05
Процедуры с параметрами (VBasic) Таня.Ку Помощь студентам 1 15.12.2010 14:19
Процедуры с числовыми параметрами. Wild_klas Помощь студентам 3 26.10.2010 00:05
ADOStoredProc выполнение процедуры с параметрами funball БД в Delphi 3 18.11.2009 15:13
Помогите сделать Процедуру без параметров FreeZZZ Паскаль, Turbo Pascal, PascalABC.NET 1 26.12.2008 15:04