IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения.
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

 
 Ответить  Открыть новую тему 
> Схема программы, Схема программы
сообщение
Сообщение #1





Группа: Пользователи
Сообщений: 7
Пол: Мужской

Репутация: -  0  +


Помогите пожалуйста составить схему программы
Код
program dinam; {однонаправленный список}
uses crt;
const cr=#13#10;
type telem = ^tspisok;
     tspisok = record
                 simvol: char;
                 next: telem;
               end;
var
   spisok:telem;
   nmenu: byte;

function menu:byte;
var
   i:integer;
begin
  clrscr;
  writeln('1. Создать список',cr,'2. Заменить элемент',cr,
          '3. Вставить элемент',cr,'4. Вывод списка в прямом направлении',cr,
          '5. Вывод списка в обратном направлении',cr,'6. Выход');
  read(i);
  menu:=i;
end;{menu}

procedure pause;
begin
  repeat until keypressed;
end;{pause}

procedure udalenie(spisok:telem);
begin
  if spisok^.next=nil then dispose(spisok)
  else
    udalenie(spisok^.next)
end;{udalenie}

procedure sozdat(spisok:telem);
var
   sim: char;
   p:pointer;
begin
  if spisok^.next<>nil then udalenie(spisok^.next);
  writeln('Введите символы (enter - конец ввода):');
  repeat
    sim:=readkey;
    write(sim);
    if sim<>#13 then
    begin
      spisok^.simvol:=sim;
      new(spisok^.next);
      p:=spisok;
      spisok:=spisok^.next;
      spisok^.next:=nil;
    end;
  until sim=#13;
  spisok:=p;
  dispose(spisok^.next);
  spisok^.next:=nil;
end;

procedure vivodp(spisok:telem);
begin
  while spisok<>nil do
    begin
    write(spisok^.simvol);
    spisok:=spisok^.next;
    end
end;{vivodp}

procedure vivodn(spisok:telem);
begin
  if spisok^.next<>nil then vivodn(spisok^.next);
  write(spisok^.simvol);
end;{vivodn}

procedure zamena(spisok:telem);
var
   number,i:word;
   sim: char;
begin
  vivodp(spisok);
  writeln(cr,'Введите порядковый номер элемента перед которым нужно сделать замену:');
  readln(number);
  writeln('Введите символ');
  read(sim);
  i:=1;
  while (spisok<>nil) and (i<number) do
    if (i+1)=number then
      begin
        spisok^.simvol:=sim;
        i:=number+1;
      end
    else
      begin
        i:=i+1;
        spisok:=spisok^.next
      end;
  if (i=number) or (spisok=nil) then
    begin
      writeln('Замена невыполнима');
      pause;
    end
end;

procedure vstavka(spisok:telem);
var
   number,i: word;
   sim,el: char;
   p:pointer;
begin
  vivodp(spisok);
  writeln(cr,'Введите порядковый номер элемента перед которым нужно сделать вставку:');
  readln(number);
  writeln('Введите символ');
  read(sim);
  i:=1;
  while (spisok<>nil) and (i<number) do
    begin
      spisok:=spisok^.next;
      i:=i+1;
    end;
  if i=number then
    begin
      while spisok<>nil do
      begin
        el:=spisok^.simvol;
        spisok^.simvol:=sim;
        sim:=el;
        p:=spisok;
        spisok:=spisok^.next;
      end;
      spisok:=p;
      new(spisok^.next);
      spisok^.next^.simvol:=sim;
      spisok^.next^.next:=nil;
    end
  else
    begin
    writeln('Вставка невозможна');
    pause;
    end;
end;

begin
  new(spisok);
  spisok^.next:=nil;
  nmenu:=0;
  while nmenu<6 do
    begin
      case nmenu of
        1: sozdat(spisok);
        2: zamena(spisok);
        3: vstavka(spisok);
        4: begin vivodp(spisok);pause end;
        5: begin vivodn(spisok);pause end;
      end;
      nmenu:=menu;
    end;
  udalenie(spisok);
end.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 





- Текстовая версия 29.09.2020 8:29
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name