Новичок
Джуниор
Регистрация: 17.03.2019
Сообщений: 1
|
[Pascal ABC] сортировка методом пузырька
Сортировка записей (результат записать в типизированный и текстовый файл)
кто может помочь?
Код:
procedure sort(var f:tfile);
var x, y, z : integer;
begin
for i:=1 to N-1 do
begin
for j:=i+1 to N do
begin
if m[i]<m[j] then
begin
a:=m[i];
m[i]:=m[j];
m[j]:=a;
end;
end;
end;
Пожалуйста, оформляйте Ваш код согласно правилам.
а вот вся программа
Код:
uses crt;
type
vl=record
nv:integer;
fio: string[15];
adres: string[15];
marka: string[10];
nomer:string[15];
year:integer;
end;
tfile=file of vl;
var
b:boolean;
n:integer;
procedure new(var f:tfile);
var
i,k:integer;
a:vl;
q:char;
begin
clrscr;
assign(f,'C:\Users\Александр\Desktop\lol.txt');
rewrite(f);
Writeln('Кол-во записей не менее 15 : ');
Readln(n);
For i:=1 to n do
with a do
begin
writeln('введите номер владельца');
readln(a.nv);
writeln('Введите фио');
readln(fio);
writeln('Введите адрес');
readln(adres);
writeln('Введите марку автомобиля');
readln(marka);
writeln('Введите регистрационный номер');
readln(nomer);
writeln('Введите год выпуска');
readln(year);
write(f,a);
end;
writeln(' ');
write('Для продолжения Ввода данных нежмите ENTER, Для завершения нажмите - e:',' ',q);
readln(q);
close(f);
end;
procedure print(var f:tfile);
var
a:vl;
begin
clrscr;
assign(f,'C:\Users\Александр\Desktop\lol.txt');
reset(f);
writeln('Список владельцев:');
begin
while not eof(f) do
begin
read(f,a);
writeln(a.nv,' ',a.fio,' ',a.adres,' ',a.marka,' ',a.nomer,' ',a.year);
end;
end;
close(f);
writeln('для продолжения нажмите Enter');
readln;
end;
Procedure add(var f:tfile);
var a:vl;
begin
clrscr;
assign(f,'C:\Users\Александр\Desktop\lol.txt');
reset(f);
with a do
begin
writeln('введите номер владельца');
readln(a.nv);
writeln('Введите фио');
readln(fio);
writeln('Введите адрес');
readln(adres);
writeln('Введите марку автомобиля');
readln(marka);
writeln('Введите регистрационный номер');
readln(nomer);
writeln('Введите год выпуска');
readln(year);
end;
seek(f,filesize(f));
write(f,a);
close(f);
writeln('Запись добавлена');
writeln('для продолжения нажмите Enter');
readln
end;
{удаление записи}
procedure del(var f:tfile);
var a,c:vl;
n,i,j,k,b:integer;
begin
clrscr;
assign(f,'C:\Users\Александр\Desktop\lol.txt');
reset(f);
write('номер владельца: nv=');
readln(n);
i:=0;
b:=-1;
while (i<filesize(f))and(b=-1) do{ищем нужный номер}
begin
seek(f,i);
read(f,a);
if a.nv=n then b:=i
else i:=i+1
end;
if b=-1 then writeln('Такого номера нет')
else
begin
if b=filesize(f)-1 then{если последний}
begin
seek(f,filesize(f)-1);{встаем в последнюю запись}
truncate(f);{обрезаем файл}
end
else
begin
for j:=b to filesize(f)-2 do{идем вперед}
begin
seek(f,j+1);{переставляем - сдвигаем - записи вверх на 1}
read(f,c);
seek(f,j);
write(f,c);
end;
seek(f,filesize(f)-1);{встаем в последнюю запись}
truncate(f);{обрезаем файл}
end;
writeln('Запись удалена')
end;
close(f);
writeln('для продолжения нажмите Enter');
readln
end;
procedure sort(var f:tfile);
var x, y, z : integer;
begin
for i:=1 to N-1 do
begin
for j:=i+1 to N do
begin
if m[i]<m[j] then
begin
a:=m[i];
m[i]:=m[j];
m[j]:=a;
end;
end;
end;
procedure count(var f:tfile);
var
a:vl;
mar:array[1..3] of string[15];
kol:array[1..3] of integer;//массив количеств каждой марки.
i,j,k,d: byte;
g:text;
begin
clrscr;
assign(f,'C:\Users\Александр\Desktop\lol.txt');
reset(f);
while not eof(f) do
begin
read(f,a);
with a do
begin
k:=0;
for j:=1 to i do
if mar[j]=a.marka then inc(k);
if k=0 then
begin
inc(i);
mar[i]:=a.marka;
end;
end;
end;
reset(f);
d:=i;
while not eof(f) do
begin
read(f,a);
with a do
for i:=1 to d do
if mar[i]=a.marka then inc(kol[i]);
end;
writeln('Количество автомобилей каждой марки:');
for i:=1 to d do
writeln(mar[i],'-',kol[i]);
assign(g,'C:\Users\Александр\Desktop\mas.txt');
rewrite(g);
writeln(g,mar);
writeln(g,kol);
writeln;
close(f);
close(g);
writeln('для продолжения нажмите Enter');
readln;
end;
procedure poisc(var f:tfile);
var a:vl;
g:text;
mar:string[15];
k:integer;
begin
clrscr;
assign(f,'C:\Users\Александр\Desktop\lol.txt');
reset(f);
write('Введите марку для поиска: ');
readln(mar);
k:=0;
while not eof(f) do
begin
read(f,a);
if a.marka=mar then
begin
k:=1;
writeln(a.nv,' ',a.fio,' ',a.nomer);
assign(g, 'C:\Users\Александр\Desktop\mas.txt');
rewrite(g);
writeln(g,a.nv,' ',a.fio,' ',a.nomer);
end;
end;
if k=0 then writeln('Владельца с такой маркой нет');
close(f);
Close(g);
writeln('для продолжения нажмите Enter');
readln;
end;
procedure PoiskA (f:tfile);
var k: byte;
a:vl;
g:text;
ss,sn: integer;
begin
clrscr;
k:=0;
assign(f,'C:\Users\Александр\Desktop\lol.txt');
reset(f);
while not eof(f) do
begin
read(f,a);
inc(k);
if k=1 then
begin
ss:=a.year; sn:=a.year;
end;
if a.year<ss then ss:=a.year;
if a.year>sn then sn:=a.year;
end;
writeln('Владелец самого старого автомобиля:');
k:=0;
reset(f);
while not eof(f) do
begin
read(f,a);
with a do
if year=ss then
begin
writeln(a.nv,' ',a.fio);
assign(g,'C:\Users\Александр\Desktop\mas.txt');
rewrite(g);
writeln(g,a.nv,' ',a.fio);
end;
end;
close(f);
Close(g);
writeln('для продолжения нажмите Enter');
readln;
end;
var f:tfile;
w:char;
begin
clrscr;
b:=false;
repeat
clrscr;
writeln('Выберите действие:');
writeln('1-создать файл');
writeln('2-прочитать файл');
writeln('3-добавить запись в файл');
writeln('4-удалить запись из файла');
writeln('5-сортировка файла');
writeln('6- найти запись в файл о количестве автомобилей каждой марки ');
writeln('7-найти запись в файле о фамилии владельцев и номера автомобилей данной марки');
writeln('8-найти запись в файле о владельце самого старого авто');
writeln('другое-выход');
readln(w);
case w of
'1':new(f);
'2':print(f);
'3':add(f);
'4':del(f);
'5':sort(f);
'6':count(f);
'7':poisc(f);
'8':poiska(f) ;
else exit;
end;
until not (w in ['1'..'8']);
end.
Пожалуйста, оформляйте Ваш код согласно правилам.
Последний раз редактировалось Вадим Мошев; 17.03.2019 в 01:29.
|