Тема 5: «Типизированные файлы»
В файле, содержащем целые числа, найти количество компонент стоящих между первым отрицательным и последним отрицательным значением, и записать это количество в конец файла.
program Project1;
const //Объявление констант
Fn = 'file.dat';
M = 20;
Var //объявление переменных
F : file of Integer;
i, CntRes, CntAdd, Num : Integer;
First : Boolean;
S : String;
Begin //начало
repeat
//Создаём файл и записываем в него элементы.
Assign(F, Fn);
Rewrite(F);
Randomize;
for i := 1 to M do begin
Num := -10 + Random(21); //-10..10;
Write(F, Num);
end;
//Распечатка.
Writeln('Создан файл целых чисел. Его содержание:');
Reset(F);
i := 0;
while not Eof(F) do begin //цикл до конца файла
Inc(i);
Read(F, Num);
if i > 1 then Write(', ');
Write(Num);
end;
Writeln;
//Поиск количества компонентов файла, расположенных между
//первым и последним отрицательными элементами.
Reset(F);
CntRes := 0;
CntAdd := 0;
First := False;
while not Eof(F) do begin
Read(F, Num);
//Пропускаем все элементы, начиная от начала файла по первый
//отрицательный элемент.
if not First then begin
//При обнаружении первого отрицательного элемента устанавливаем флаг в True.
if Num < 0 then First := True;
Continue;
end;
//Подсчёт количества элементов, идущих после предыдущего отрицательного
//элемента.
Inc(CntAdd); //CntAdd := CntAdd + 1;
//Если найден отрицательный элемент, то добавляем к результату значение
//переменной CntAdd.
if (Num < 0) then begin
Inc(CntRes, CntAdd); //CntRes := CntRes + CntAdd;
//Сброс счётчика.
CntAdd := 0;
end;
end;
//Закрываем файл.
Close(F);
//Ответ.
if CntRes = 0 then begin
if First then
Writeln('В файле только одно отрицательное число.')
else
Writeln('В файле нет отрицательных чисел.')
;
end else begin
Writeln('В файле, между первым и последним отрицательными');
Writeln('элементами расположено ', CntRes - 1, ' элементов.');
end;
Writeln('Повторить - Enter. Выход - любой символ + Enter.');
Readln(S);
until S <> '';
end.
Тема 6: «Записи»
Записать в типизированный файл компоненты типа запись – «Товары» (наименование товара, вид упаковки, количество на складе, цена за 1 штуку). Организовать работу пользователя с файлом в следующих режимах: перезапись файла, добавление информации в конец файла, чтение из файла информации:
О товарах, которых мало на складе (менее 5 штук)
О товарах, цена которых наибольшая (три товара)
uses crt;
type tovar=record //объявление типа рекорд
nam:string[20];
upk:string[20];
kol:integer;
cen:real;
end;
tfile=file of tovar;
const fname='tovar.dat'; //значения не меняются в процессе выполнения
var f:tfile;
b:boolean;
procedure ResetFile(var f:tfile); //процедура для перезаписи данных
begin
{$I-}reset(f);{$I+}
b:=IOResult=0;
end;
procedure CreateFile(var f:tfile); создание файла
var z:tovar;
c:char;
t:boolean;
i:integer;
begin
ResetFile(f); открытие существующего файла
t:=false;
if b then
begin
writeln('Файл уже существует');
writeln('Желаете переписать? 1-да, 0-нет');
repeat
readln(c);
until c in ['1','0'];
if c='0' then
begin
readln;
close(f);
exit; // досрочный выход из функции
end
else t:=true;
end
else t:=true;
if t then
begin
rewrite(f);
writeln('Введите данные о товарах, окончание ввода Esc:');
i:=0;
repeat
i:=i+1;
writeln('Запись ',i);
with z do // оператор присоединения, чтобы упростить доступ к полям записи. метод ускорения доступа к полям записи.
begin
write(' - наименование: ');readln(nam);
write(' - вид упаковки: ');readln(upk);
write(' - количество(натуральное число): ');readln(kol);
write(' - цена (действительное число): ');readln(cen);
write(f,z);
end;
c:=readkey;// Считывает символ из буфера клавиатуры
until c=#27;
close(f);
end;
end;
procedure AddFile(var f:tfile); //добавление в файл
var z:tovar;
c:char;
i:integer;
begin
clrscr;
ResetFile(f);
if not b then
begin
writeln('Файл еще не создан, вернитесь к пункту 1');
readln;
exit;
end;
writeln('Введите данные о товарах, окончание ввода Esc:');
i:=0;
repeat
i:=i+1;
writeln('Запись ',i);
with z do оператор присоединения, чтобы упростить доступ к полям записи. метод ускорения доступа к полям записи.
begin
write(' - наименование: ');readln(nam);
write(' - вид упаковки: ');readln(upk);
write(' - количество(натуральное число): ');readln(kol);
write(' - цена (действительное число): ');readln(cen);
seek(f,filesize(f)); Устанавливает текущую позицию файла на указанный элемент
write(f,z);
end;
c:=readkey;
until c=#27;
close(f);
readln;
end;
Procedure ReadFile(var f:tfile);
var z:tovar;
begin
clrscr;
ResetFile(f);
if not b then
begin
writeln('Файл еще не создан, вернитесь к пункту 1');
readln;
exit;
end;
writeln('Полный список товаров:');
writeln('-----------------------------------------------------------');
writeln('| Наименование | Вид упаковки | Количество | Цена |');
writeln('-----------------------------------------------------------');
reset(f);
while not eof(f) do
begin
read(f,z);
with z do
begin
gotoXY(1,whereY);write('| ',nam);
gotoXY(20,whereY);write('| ',upk);
gotoXY(37,whereY);write('|',kol:7);;
gotoXY(50,whereY);write('|',cen:8:2);
gotoXY(59,whereY);writeln('|');
end;
end;
writeln('-----------------------------------------------------------');
close(f);
readln;
end;
Procedure Count(var f:tfile);
var z:tovar;
k:byte;
begin
clrscr;
ResetFile(f);
if not b then
begin
writeln('Файл еще не создан, вернитесь к пункту 1');
readln;
exit;
end;
writeln('Список товаров, количество которых меньше 5:');
writeln('-----------------------------------------------------------');
writeln('| Наименование | Вид упаковки | Количество | Цена |');
writeln('-----------------------------------------------------------');
reset(f);
k:=0;
while not eof(f) do
begin
read(f,z);
if z.kol<5 then
begin
k:=1;
with z do
begin
gotoXY(1,whereY);write('| ',nam);
gotoXY(20,whereY);write('| ',upk);
gotoXY(37,whereY);write('|',kol:7);;
gotoXY(50,whereY);write('|',cen:8:2);
gotoXY(59,whereY);writeln('|');
end;
end;
end;
writeln('-----------------------------------------------------------');
if k=0 then write('Таких товаров нет');
close(f);
readln;
end;
Procedure MaxCen(var f:tfile);
var x,y,z:tovar;
i,j:integer;
begin
clrscr;
ResetFile(f);
if not b then
begin
writeln('Файл еще не создан, вернитесь к пункту 1');
readln;
exit;
end;
if filesize(f)<3 then
begin
writeln('В файле нет трех элементов.');
writeln('Вернитесь к пункту 2 и добавьте.');
readln;
close(f);
exit;
end;
{сортируем по убыванию}
for i:=0 to filesize(f)-2 do
for j:=i+1 to filesize(f)-1 do
begin
seek(f,i); Устанавливает текущую позицию файла на указанный элемент
read(f,x);
seek(f,j);
read(f,y);
if x.cen<y.cen then
begin
z:=x;
x:=y;
y:=z;
seek(f,i);
write(f,x);
seek(f,j);
write(f,z);
end;
end;
writeln('Список товаров, цена которых наибольшая:');
writeln('-----------------------------------------------------------');
writeln('| Наименование | Вид упаковки | Количество | Цена |');
writeln('-----------------------------------------------------------');
seek(f,0);
for i:=0 to 2 do
begin
read(f,z);
with z do
begin
gotoXY(1,whereY);write('| ',nam);
gotoXY(20,whereY);write('| ',upk);
gotoXY(37,whereY);write('|',kol:7);;
gotoXY(50,whereY);write('|',cen:8:2);
gotoXY(59,whereY);writeln('|');
end;
end;
writeln('-----------------------------------------------------------');
close(f);
readln;
end;
var w:char;
begin**/
clrscr;
assign(f,fname);
repeat
clrscr;
writeln('Выберите действие:');
writeln('1-Создание нового файла');
writeln('2-Добавление записей');
writeln('3-Чтение файла');
writeln('4-Поиск товаров, которых мало на складе');
writeln('5-Поиск товаров, цена которых наибольшая');
writeln('Другое - Выход');
readln(w);
case w of
'1':CreateFile(f);
'2':AddFile(f);
'3':ReadFile(f);
'4':Count(f);
'5':MaxCen(f);
else exit;
end;
until not (w in ['1'..'5']);
end.