Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Паскаль, Turbo Pascal, PascalABC.NET
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 17.03.2019, 00:56   #1
Алексиос
Новичок
Джуниор
 
Регистрация: 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.
Алексиос вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Сортировка списка методом пузырька Dmitriyy1 Общие вопросы C/C++ 4 07.02.2019 21:04
Сортировка массива методом пузырька ХардХэви Общие вопросы C/C++ 9 03.06.2013 18:24
Сортировка методом пузырька marina12 Помощь студентам 1 13.04.2013 16:04
сортировка методом пузырька в делфи7 dragodar Помощь студентам 2 05.11.2012 19:25
Сортировка методом пузырька fygas1991 Общие вопросы C/C++ 5 15.11.2009 21:39