[N@stya]

Помогите пожалуйста завершить программу!
Дан файл целых чисел F1. Выполнить над элементами файла следующее действие:Среди каждых трех компонент файла F1 удалить максимальное, а два других поменять местами.( То есть например дан файл f1: 123465832, На выходе программы должно быть:215423.

Код:

{$APPTYPE CONSOLE}

uses
  SysUtils;

 type tfile=file of integer;
procedure VvodFile(var f:tfile);
 var k:integer;
begin
   rewrite(f);
   while random(30)<>20 do
  begin
   k:=random(100)-50;
   write(f,k);
  end;
 closefile(f);
end;
procedure VivodFile(var f:tfile);
 var k:integer;
begin
 reset(f);
 while not eof(f) do
  begin
   read(f,k);
   write(k,' ');
  end;
 closefile(f);
 writeln;
end;
var f1,f2,f3:tfile;
     k,k1,p,max,min,i,j,x,im,tmp:integer; a:array of integer;
begin

 randomize;
 assign(f1,'1.dat');
 assign(f2,'2.dat');
 VvodFile(f1);
 writeln('1 file');
 VivodFile(f1);
 reset(f1);

 rewrite(f2);
 while  not eof(f1) do
  begin

   p:=0;
  max:=-100;

   while (p<3) and not eof(f1) do
    begin

     read(f1,k);
     if k>max then  max:=k;

            p:=p+1;  end;  end;               

Вот здесь я нашла все максимумы каждых трех компонент файла f1. Что можно сделать дальше?

[N@stya]

Напишите пожалуйста хотя бы как во второй файл записать все компоненты кроме максимумов...

[m0nzt3r]

У тебя довольно странный алгоритм, честно говоря. В общем, вот что у меня получилось. Как я понял по твоему коду, в одной программе он должен и создавать исходный файл, и на его основе составлять второй файл с результатом. От себя добавил вывод на экран обоих файлов. Если что-то не понятно - спрашивай

Код:

program Project1;

{$APPTYPE CONSOLE}

uses
  SysUtils,Math;

type TFile = file of integer;
var F1,F2:TFile;

procedure MakeFile(name:string);
var k,i:integer; F1:TFile;
begin
  randomize;
  AssignFile(F1,name);
  ReWrite(F1);
  for i:=1 to (random(33)+1)*3 do begin
    k:=random(10);                               //Если хочешь, можешь тут хоть 100 поставить. Это максимальное значение элементов файла
    write(F1,k);
  end;
  CloseFile(F1);
end;

procedure ShowFile(name:string);
var k:integer; F1:TFile;
begin
  AssignFile(F1,name);
  {$I-} ReSet(F1); {$I+}
  if IOResult<>0 then begin
    writeln('Error opening the file!');
    Exit;
  end;
  write('File: ');
  while not EOF(F1) do begin
    read(F1,k);
    write(k,' ');
  end;
  CloseFile(F1);
  writeln;
end;

procedure ProcessFile(name1,name2:string);
var k1,k2,k3,n:integer;
begin
  AssignFile(F1,name1);
  AssignFile(F2,name2);
  {$I-} ReSet(F1); {$I+}
  if IOResult<>0 then begin
    writeln('Error opening the file!');
    Exit;
  end;
  ReWrite(F2);
  while not EOF(F1) do begin
    read(F1,k1);
    read(F1,k2);
    read(F1,k3);
    if Max(k1,k2)>k3 then begin
      write(F2,k3);
      n:=Min(k1,k2);
      write(F2,n)
    end else
    begin
      write(F2,k2);
      write(F2,k1);
    end;
  end;
  CloseFile(F1);
  CloseFile(F2);
end;

begin
  MakeFile('file.dat');
  ProcessFile('file.dat','file2.dat');
  ShowFile('file.dat');
  ShowFile('file2.dat');
  readln;
end.

[N@stya]

Спасибо огромное! А нельзя обойтись без модуля Math?

[Asinkrit]

Сообщение от N@stya

Спасибо огромное! А нельзя обойтись без модуля Math?

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

[Asinkrit]

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

Код:

    ...
    read(F1,k1);
    read(F1,k2);
    read(F1,k3);
    ...

хочу подметить, если размер файла будет некратным трем, тогда получите ошибку...