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

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

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

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

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

Ответ
 
Опции темы Поиск в этой теме
Старый 29.05.2016, 16:24   #1
E1337
Пользователь
 
Регистрация: 24.01.2016
Сообщений: 20
По умолчанию Процедура удаления. Динамический список

Не как не выходит написать код... Требуется процедура удаления по ФИО, т.е мы пишем ФИО, удаляется фио и вместе с этим для фио - дата, семейное положение, увлечение и любимое время года.
Код:
type
  prec = ^trec;
  trec = record
    FIO: string[50];
    born: integer;
    famst: string[50];
    hobby: string[50];
    season: string[50];
    next,Previous: prec;
  end;
 
var
  list, p: prec;
  b: integer;
  s,s1, s2, s3: string;
  vib:Char;
 
procedure addtolist(anum: integer; const s1, s2, s3, s: string);
var
  p: prec;
begin
  new(p);
  p^.born := anum;
  p^.famst := s1;
  p^.hobby := s2;
  p^.season := s3;
  p^.FIO := s;
  p^.next := list;
  list := p;
end;
 
procedure printlist;
var
  p: prec;
begin
  p := list;
  while p <> nil do
  begin
    writeln('Fio: ',p^.FIO, '. Data rojdenya: ',p^.born, '. Semeynoe polojeniye: ', p^.famst, '.  Yvlechenie ', p^.hobby, '. Lubimoe vremya goda: ', p^.season);
    p := p^.next;
  end;
end;
 
begin
  list := nil;
   repeat
    Writeln('Veberite deystvie');
    Writeln('1) Dobavleniye harakteristik');
    Writeln('2) Udaleniye harakteristik');
    Writeln('3) Vivod');
    Writeln('4) Vihod');
    Readln(vib);
    case vib of
     '1':begin
         Writeln('Vveidte FIO');
         readln(s);
         writeln('Vvedite datu rojdeniya');
         readln(b);
         writeln('Vvedite semeynoe polojenie');
         readln(s1);
         writeln('Vvdite hobby');
         readln(s2);
         writeln('Vvedite lubimooe vremya goda');
         readln(s3);
         addtolist(b, s1, s2, s3, s);
         end;
     '2':begin
         Delete(list);
         end;
     '3':begin
         printlist;
         end;
         end;
    until vib = '4';
  readln;
end.

Последний раз редактировалось Аватар; 29.05.2016 в 16:49.
E1337 вне форума Ответить с цитированием
Старый 29.05.2016, 23:05   #2
ViktorR
Старожил
 
Регистрация: 23.10.2010
Сообщений: 2,304
По умолчанию

И всё же ...
Рекомендую посмотреть книжку Т.А. Павловская, Программирование на ЯВУ (имеется в списке литературы и качается просто ...)
Там точно есть простой и понятный код для работы со списком.
На доработку потребуется немного времени.


Как-то так, ...
Как-то так, ...
ViktorR вне форума Ответить с цитированием
Старый 30.05.2016, 13:02   #3
CMY_3
Пользователь
 
Регистрация: 24.02.2016
Сообщений: 38
По умолчанию

я бы сделал так:
Код:
type
  pNode = ^Node;
  Node = record
    FIO: string[50];
    born: integer;
    famst: string[50];
    hobby: string[50];
    season: string[50];
    next, prev : pNode;
  end;
procedure CreateNode(var aNode:pNode);
begin
   With aNode^ do begin
   Write('Vveidte FIO');
         readln(FIO);
         write('Vvedite datu rojdeniya');
         readln(born);
         write('Vvedite semeynoe polojenie');
         readln(famst);
         write('Vvdite hobby');
         readln(hobby);
         write('Vvedite lubimooe vremya goda');
         readln(season);
         next := nil; prev := nil;
   end;
end;
procedure addtolist(var aBeg,aEnd:pNode;aNode:pNode);
begin
  If aBeg=nil then begin
    aBeg:=aNode;
    aBeg^.next:=nil; aBeg^.prev:=nil;
    aEnd:=aBeg;
  end else begin
    aEnd^.next:=aNode;
    aNode^.prev:=aEnd;
    aEnd:=aEnd^.next;
  end;
end;
procedure printlist(aBeg:pNode);
begin
  while aBeg <> nil do
  begin
    with aBeg^ do
       writeln('Fio: ',FIO, '. Data rojdenya: ',born, '. Semeynoe polojeniye: ',famst, '.  Yvlechenie ',hobby, '. Lubimoe vremya goda: ',season);
    aBeg := aBeg^.next;
  end;
end;
procedure DelNode(var aBeg,aEnd:pNode;aNode:pNode);
begin
   If (aNode=aBeg) and (aNode=aEnd) then begin
     aBeg:=nil; aEnd:=nil;
   end else If aNode=aBeg then begin
     aBeg:=aBeg^.next;
     aBeg^.prev:=nil;
   end else If aNode=aEnd then begin
     aEnd:=aEnd^.prev;
     aEnd^.next:=nil;
   end else begin
     aNode^.prev^.next:=aNode^.next;
     aNode^.next^.prev:=aNode^.prev;
   end;
   Dispose(aNode);
end;

var
  pBeg, pEnd, p : pNode;
  c, vib : char;
begin
   pBeg := nil;  pEnd := nil;
   repeat
    Writeln('Veberite deystvie');
    Writeln('1) Dobavleniye harakteristik');
    Writeln('2) Udaleniye harakteristik');
    Writeln('3) Vivod');
    Writeln('4) Vihod');
    Readln(vib);
    case vib of
     '1':begin
         New(p);
         CreateNode(p);
         addtolist(pBeg,pEnd,p);
         end;
     '2':begin
         p:=pBeg;
         while p<>nil do begin
           writeln(p^.FIO);
           write('Delete Node? Y/N'); readln(c);
           if c='Y' then begin
             DelNode(pBeg,pEnd,p);
             break;
           end;
           p:=p^.next;
         end;
         end;
     '3':begin
         printlist(pBeg);
         end;
         end;
    until vib = '4';
  readln;
end.
CMY_3 вне форума Ответить с цитированием
Ответ


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

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

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


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Процедура удаления в двунаправленном списке mishammm Помощь студентам 1 04.05.2014 07:05
процедура удаления данных из типизированного файла Mikheeva_Ksu Помощь студентам 0 21.06.2013 17:59
Рекурсивная процедура удаления Kehl Помощь студентам 3 13.05.2013 17:16
Процедура удаления в односвязном динамическом списке по ключевым полям Riesig Помощь студентам 0 28.03.2013 21:03
Список. Ошибка удаления pobedin Общие вопросы Delphi 8 08.09.2011 13:28