Procedure Del_N(var f:fail); var n,i:integer; c:char; x:stud; begin write('Удалить запись № '); readln(n); reset(f); if (filesize(f)<n)or(n<0) then begin writeln('В файле нет такой записи'); close(f); write('Press Enter...'); readln; exit; end; if n=filesize(f)then begin seek(f,filesize(f)-1); truncate(f); close(f); write('Press Enter...'); readln; exit; end; seek(f,n-1); for i:=n-1 to filesize(f)-2 do begin seek(f,i+1); read(f,x); seek(f,i); write(f,x); end; seek(f,filesize(f)-1); truncate(f); close(f); write('Press Enter...'); readln end;
Из текста задания непонятно, нужен ли промежуточный вывод, поэтому он присутствует после каждого этапа, чтобы убедиться в правильности работы программы. Программа написана и отлажена в среде PascalABC.Net.
const n = 4; var a:array[1..n,1..n] of integer; i,j,s,amin,jmin,amax,imax: integer;
begin { инициализация массива } Writeln('Исходный массив'); for i:=1 to n do begin for j:=1 to n do begin a[i,j]:=Random(51)-25; { случайные числа на [-25;25] } Write(a[i,j]:4) end; Writeln end; { сумма элементов побочной диагонали } s:=0; for i:=1 to n do s:=s+a[n-i+1,i]; Writeln('Сумма элементов побочной диагонали: ',s); Writeln('Меняем местами первый и последний столбцы'); for i:=1 to n do begin s:=a[i,1]; a[i,1]:=a[i,n]; a[i,n]:=s end; { вывод } for i:=1 to n do begin for j:=1 to n do Write(a[i,j]:4); Writeln end; { меняем местами минимальный элемент первой строки и максимальный элемент последнего столбца } amin:=a[1,1]; jmin:=1; for j:=2 to n do if amin>a[1,j] then begin amin:=a[1,j]; jmin:=j end; amax:=a[1,n]; imax:=1; for i:=2 to n do if amax<a[i,n] then begin amax:=a[i,n]; imax:=i end; a[1,jmin]:=amax; a[imax,n]:=amin; Writeln('Массив после обмена местами найденных элементов'); for i:=1 to n do begin for j:=1 to n do Write(a[i,j]:4); Writeln end end.
Тестовое решение: Исходный массив -14 -25 -14 -11 8 -5 5 0 5 20 -7 -9 -23 4 -3 18 Сумма элементов побочной диагонали: -9 Меняем местами первый и последний столбцы -11 -25 -14 -14 0 -5 5 8 -9 20 -7 5 18 4 -3 -23 Массив после обмена местами найденных элементов -11 8 -14 -14 0 -5 5 -25 -9 20 -7 5 18 4 -3 -23
var n,i:integer;
c:char;
x:stud;
begin
write('Удалить запись № ');
readln(n);
reset(f);
if (filesize(f)<n)or(n<0) then
begin
writeln('В файле нет такой записи');
close(f);
write('Press Enter...');
readln;
exit;
end;
if n=filesize(f)then
begin
seek(f,filesize(f)-1);
truncate(f);
close(f);
write('Press Enter...');
readln;
exit;
end;
seek(f,n-1);
for i:=n-1 to filesize(f)-2 do
begin
seek(f,i+1);
read(f,x);
seek(f,i);
write(f,x);
end;
seek(f,filesize(f)-1);
truncate(f);
close(f);
write('Press Enter...');
readln
end;