Файл из одномерных массивов.

[OTuser]

Здравствуйте. Помогите пожалуйста доделать задачу, осталось совсем чуть-чуть.
Что требуется:

Создать файл, где компонентой будет массив из N чисел. Все четные по номеру компоненты участвуют в поиске минимального числа в файле, все нечетные – в поиске максимального числа файла. Компоненты, содержащие эти максимальное и минимальное значения, удалить из файла.

Что я, собственно, написал:

program Project6;

{$APPTYPE CONSOLE}

Const
N=10;
Type
mas=array[1..N] of integer;
files=file of mas;
Var
f1:files;
a:mas;
i,j,k,min,max,kmin,kmax:integer;

Procedure sozd_file;
begin
rewrite(f1);
For k:=1 to N do
begin
For i:=1 to N do
a[i]:=-1000+random(2000);
write(f1,a);
end;
close(f1);
reset(f1);
end;

Procedure vivod_file(Var f:files);
begin
reset(f);
k:=0;
while not eof(f) do
begin
read(f,a);
inc(k);
write(k,':');
For i:=1 to N do
write(a[i]:4);
writeln;
end;
end;
{Сдвиг компонент с минимальным и максимальным значениями в конец файла}
Procedure kminmax(minmax:integer);
begin
For i:=minmax to filesize(f1)-1 do
begin
seek(f1,i);
read(f1,a);
seek(f1,i-1);
write(f1,a);
end;
end;
{Обрезание сдвинутых в конец компонент}
procedure SeekAndDestroy;
begin
 seek(f1,filesize(f1)-2);
 truncate(f1);
end;


Begin
writeln;
randomize;
assign(f1,'f1-lab.txt');
{$I-}
reset(f1);
{$I+}
if ioresult<>0 then
begin
writeln('sozd_file');
sozd_file;
end;
sozd_file;
vivod_file(f1);
writeln;
reset(f1);
k:=0;
max:=-maxint;
min:=maxint;
while not eof(f1) do {Считывание компонент из файла}
begin
 read(f1,a);
 inc(k);
{-------------Начало куска-------------}
 if odd(k) then {Если компонента нечетная - поиск максимума в компоненте}
  begin
   For i:=1 to N do
   if a[i]>max then
    begin
     max:=a[i];
     kmax:=k;
    end;
 end
else {Если четная - поиск минимума}
 begin
  For i:=1 to N do
  if a[i]<min then
   begin
    min:=a[i];
    kmin:=k;
   end;
 end;
{--------------Конец-куска----------------}
end;
writeln('MIN=',min,', komponenta ',kmin);
writeln('MAX=',max,', komponenta ',kmax);
if kmin>kmax then
 begin
  kminmax(kmin);
  kminmax(kmax);
  SeekAndDestroy;
 end
else
 begin
  kminmax(kmax);
  kminmax(kmin);
  SeekAndDestroy;
end;
writeln;
vivod_file(f1);
close(f1);
readln
End.

Все работает отлично, но требуется из выделенного куска сделать функцию с передаваемым булевым параметром.
Что-то навроде:

function nomextrem(p:boolean):byte;
begin
if (a[i]>extrem)=p then...
end;

К сожалению, пропустил лекцию на тему "Процедуры и функции". Процедуры успел разобрать, а вот с функциями пока не очень получается. Исправьте пожалуйста, надеюсь этот пример поможет мне разобраться.

[OTuser]

Помогите пожалуйста, через день сдавать =\

[OTuser]

Прошу, уделите немного внимания...

[Sazary]

OTuser Я переписал это в функцию, но получилось криво, т.к., чтобы получилось нормально, нужно было изначально писать прогу под функцию.
Но есть одно "НО"! При компиляции комп виснет и помогает только ребут!
Пробовал 2 раза. Больше не рискну ) Может, это только у меня. В причине пока не разобрался.

Вот код:

program Project6;

Const
N=10;
Type
mas=array[1..N] of integer;
files=file of mas;
Var
f1:files;
a:mas;
i,j,k,min,max,kmin,kmax:integer;

Procedure sozd_file;
begin
rewrite(f1);
For k:=1 to N do
begin
For i:=1 to N do
a[i]:=-1000+random(2000);
write(f1,a);
end;
close(f1);
reset(f1);
end;

Procedure vivod_file(Var f:files);
begin
reset(f);
k:=0;
while not eof(f) do
begin
read(f,a);
inc(k);
write(k,':');
For i:=1 to N do
write(a[i]:4);
writeln;
end;
end;
{Сдвиг компонент с минимальным и максимальным значениями в конец файла}
Procedure kminmax(minmax:integer);
begin
For i:=minmax to filesize(f1)-1 do
begin
seek(f1,i);
read(f1,a);
seek(f1,i-1);
write(f1,a);
end;
end;
{Обрезание сдвинутых в конец компонент}
procedure SeekAndDestroy;
begin
 seek(f1,filesize(f1)-2);
 truncate(f1);
end;

{-----------Та самая функция ----------}
function func(bl : boolean; ar : mas; FN : integer; fk : integer; var fkmxn : integer) : integer;
  var fi,fmax,fmin : integer;
 begin
 if bl then
 begin
   For fi:=1 to FN do
   if ar[fi]>fmax then
    begin
     fmax:=ar[fi];
     fkmxn:=fk;
    end;
  func := fmax;
  end
 else {Если четная - поиск минимума}
 begin
  For fi:=1 to FN do
  if ar[fi]<fmin then
   begin
    fmin:=ar[fi];
    fkmxn:=fk;
   end;
  func := fmin;
 end;
end;
{--------------------}

Begin
writeln;
randomize;
assign(f1,'f1-lab.txt');
{$I-}
reset(f1);
{$I+}
if ioresult<>0 then
begin
writeln('sozd_file');
sozd_file;
end;
sozd_file;
vivod_file(f1);
writeln;
reset(f1);
k:=0;
max:=-maxint;
min:=maxint;
while not eof(f1) do {Считывание компонент из файла}
begin
 read(f1,a);
 inc(k);
{-------------Начало куска-------------}
{--
 if odd(k) then {Если компонента нечетная - поиск максимума в компоненте
  begin
   For i:=1 to N do
   if a[i]>max then
    begin
     max:=a[i];
     kmax:=k;
    end;
 end
else {Если четная - поиск минимума
 begin
  For i:=1 to N do
  if a[i]<min then
   begin
    min:=a[i];
    kmin:=k;
   end;
 end;
--}

if odd(k) then max := func(odd(k),a,N,k,kmax)
else min := func(odd(k),a,N,k,min);
{--------------Конец-куска----------------}
end;
writeln('MIN=',min,', komponenta ',kmin);
writeln('MAX=',max,', komponenta ',kmax);
if kmin>kmax then
 begin
  kminmax(kmin);
  kminmax(kmax);
  SeekAndDestroy;
 end
else
 begin
  kminmax(kmax);
  kminmax(kmin);
  SeekAndDestroy;
end;
writeln;
vivod_file(f1);
close(f1);
readln
End.

PS: Не хотел вообще это выкладывать, но, раз пока больше ответов нет...

[OTuser]

но получилось криво, т.к., чтобы получилось нормально, нужно было изначально писать прогу под функцию.

У меня, к сожалению тоже виснет...да, согласен, надо было изначально писать под ф-цию, но препод сказала что: "можно ничего не переписывая сделать ф-цию с минимальным кол-вом передаваемых параметров" =\

[Sazary]

OTuser
Ну, если с минимальным, то можно, например N не передавать в качестве параметра и в функции использовать не FN,а N.
Да и вообще, учитывая, что все переменные глобальные, можно в функцию передавать только булево значение. Но это имхо неправильно.

У меня, к сожалению тоже виснет.

А это вообще отдельный вопрос.. Очень странно, что так происходит. Впервые с таким сталкиваюсь.
Попробуйте переписать функцию (вместе с куском, где она используется) сами (за основу можно взять и мой вариант). Думаю, принцип работы там понятен..

[OTuser]

Хм...перезагрузился, мистическим образом перестало зависать. Однако от этого прога работать не стала, выдает рантайм эррор. Насчет "переписать функцию" - я ее уже раз 5 по-разному переписывать пробовал =\
Сейчас вот накорябал чет, минимум и максимум находится, а вот номера компонент с этими экстремумами - неверно запоминаются, и вследствие, из файла удаляются не те компоненты

program Project6rasras;

{$APPTYPE CONSOLE}

Const
N=10;
Type
mas=array[1..N] of integer;
files=file of mas;
Var
f1:files;
a:mas;
i,j,k,l,min,max,kmin,kmax,extrem,extrem2:integer;

Procedure sozd_file;
begin
rewrite(f1);
For k:=1 to N do
begin
For i:=1 to N do
a[i]:=-1000+random(2000);
write(f1,a);
end;
close(f1);
reset(f1);
end;

Procedure vivod_file(Var f:files);
begin
reset(f);
k:=0;
while not eof(f) do
begin
read(f,a);
inc(k);
write(k,':');
For i:=1 to N do
write(a[i]:4);
writeln;
end;
end;

Procedure kminmax(minmax:integer);
begin
For i:=minmax to filesize(f1)-1 do
begin
seek(f1,i);
read(f1,a);
seek(f1,i-1);
write(f1,a);
end;
end;
{--------------------obrezanie------------------------------}
procedure SeekAndDestroy;
begin
 seek(f1,filesize(f1)-2);
 truncate(f1);
end;
{Злосчастная функция}
function nextr(p:boolean):integer;
begin
if p=true then
 begin
  for i:=1 to N do
    begin
     if a[i]>extrem then
     begin
      extrem:=a[i];
      l:=k;
     end;
    end;
   nextr:=l;
 end;
if p=false then
 begin
  for i:=1 to N do
   begin
    if a[i]<extrem2 then
     begin
      extrem2:=a[i];
      l:=k;
     end;
   end;
  nextr:=l;
 end;

end;

Begin
writeln;
randomize;
assign(f1,'f1-lab.txt');
{$I-}
reset(f1);
{$I+}
if ioresult<>0 then
begin
writeln('sozd_file');
sozd_file;
end;
sozd_file;
vivod_file(f1);
writeln;
reset(f1);
k:=0;
l:=0;
extrem:=-maxint;
extrem2:=maxint;
while not eof(f1) do
begin
read(f1,a);
inc(k);
if odd(k) then
kmax:=nextr(odd(k))
else kmin:=nextr(odd(k));


end;
writeln('MAX=',extrem,', komponenta ',kmax);
writeln('MIN=',extrem2,', komponenta ',kmin);
if kmin>kmax then
 begin
  kminmax(kmin);
  kminmax(kmax);
  SeekAndDestroy;
 end
else
 begin
  kminmax(kmax);
  kminmax(kmin);
  SeekAndDestroy;
end;
writeln;
vivod_file(f1);
close(f1);
readln
End.

[Sm1Le]

а не легче просто даже не передавать ничего в функцию ... зделать только возврат булеан ? !

[OTuser]

Преподаватель сказала сделать именно с передаваемым булевым параметром. Неужели никто не может подправить задачу?

[Sm1Le]

Если препад сказал с минимальным количеством параметров то это = 0 ! Выдели код который надо засунуть в функцию ...