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

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

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

> Схема программы, Схема программы
arcan
сообщение 17.12.2006 12:07
Сообщение #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 
 К началу страницы 
+ Ответить 

Сообщений в этой теме
arcan   Схема программы   17.12.2006 12:07


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

 



- Текстовая версия 18.07.2025 10:02
Хостинг предоставлен компанией "Веб Сервис Центр" при поддержке компании "ДокЛаб"