Помощь - Поиск - Пользователи - Календарь
Полная версия: Программа с однонаправленным списком
Форум «Всё о Паскале» > Pascal, Object Pascal > Задачи
qlimax
Доброго всем времени суток!

Помогите, пожалуйста, разобраться с такой задачей:

Разработать программу, которая обеспечивает последовательное занесение информации о школьных кабинетах (название кабинета, номер кабинета, количество мест) в однонаправленный список с одновременным упорядочением по количеству мест в кабинете. Упорядоченный список записать в текстовый файл.

Не могу сообразить, как одновременное упорядочивание сделать... Исправить чуть-чуть надо, а не получается.

Текст программы:


program list1;

uses crt;

type
pKAB=^KAB;
KAB=record
nazv:string[20];
nomer:word;
kolvo:word;
pNEXT:pKAB;
end;

var
pBEGIN, pEND, pAUX, pKEY: pKAB;
sNAZV: string[20];
sNOMER, sKOLVO: word;
rezh: char;
input_end: boolean;
RFILE: text;

procedure create (var pBEGIN, pEND: pKAB; sNAZV: string; sNOMER, sKOLVO: word);
begin
new(pBEGIN);
pBEGIN^.pNEXT:=nil;
pBEGIN^.nazv:=sNAZV;
pBEGIN^.nomer:=sNOMER;
pBEGIN^.kolvo:=sKOLVO;
pEND:=pBEGIN;
end;

procedure add (var pBEGIN: pKAB; sNAZV: string; sNOMER, sKOLVO: word);
var pAUX: pKAB;
begin
pKEY:=pBEGIN;
while pKEY<>nil do
begin
if sKOLVO < pKEY^.kolvo then pKEY:=pKEY^.pNEXT;
end;
new(pAUX);
pAUX^.nazv:=sNAZV;
pAUX^.nomer:=sNOMER;
pAUX^.kolvo:=sKOLVO;
pAUX^.pNEXT:=pKEY^.pNEXT;
pKEY^.pNEXT:=pAUX;
if pBEGIN=pKEY then pBEGIN:=pKEY^.pNEXT;
end;

procedure input;
begin
clrscr;
write('Vvedite nazvanie kabineta: ');
readln(sNAZV);
write('Vvedite nomer kabineta: ');
readln(sNOMER);
write('Vvedite kolichestvo mest v kabinete: ');
readln(sKOLVO);
add(pBEGIN,sNAZV,sNOMER,sKOLVO);
end;

procedure print;
begin
assign(RFILE,'kabs.txt');
rewrite(RFILE);
pAUX:=pBEGIN;
repeat
writeln(RFILE,pAUX^.nazv,' ',pAUX^.nomer,' ',pAUX^.kolvo);
pAUX:=pAUX^.pNEXT;
until pAUX=nil;
close(RFILE);
end;

procedure per;
begin
clrscr;
write('Nazvanie kabineta: ');
readln(sNAZV);
write('Nomer kabineta: ');
readln(sNOMER);
write('Kolichestvo mest: ');
readln(sKOLVO);
create(pBEGIN,pEND,sNAZV,sNOMER,sKOLVO);
end;

begin

clrscr;
writeln('Vyberite rezhim raboty:');
writeln;
writeln('1 - vvod informatsii o kabinete');
writeln('2 - vyhod iz programmy');
writeln;
readln(rezh);
case rezh of
'1' : per;
'2' : exit;
end;

clrscr;
input_end:=false;
repeat
clrscr;
writeln('Vyberite rezhim raboty:');
writeln;
writeln('1 - vvod informatsii o kabinete');
writeln('2 - zapis'' uporyadochennogo spiska kabinetov v fajl');
writeln;
readln(rezh);
case rezh of
'1' : input;
'2' : input_end:=true;
else
begin
writeln('Nepravil''niy rezhim! Povtorite vvod');
readln;
end;
end;
until input_end;

print;

writeln;
write('Dannye zapisany. Vykhod iz programmy...');
readln;
end.



Заранее спасибо!
volvo
Процедура Add немного меняется:

procedure add (var pBEGIN: pKAB; sNAZV: string; sNOMER, sKOLVO: word);
var pAUX, pAfter: pKAB;
begin
pAfter := nil;
pKEY:=pBEGIN;
while (pKEY<>nil) and (sKOLVO > pKEY^.kolvo) do
begin
pAfter := pKEY;
pKEY:=pKEY^.pNEXT;
end;
new(pAUX);
pAUX^.nazv:=sNAZV;
pAUX^.nomer:=sNOMER;
pAUX^.kolvo:=sKOLVO;

pAUX^.pNEXT:=pKEY;
if pAfter = nil then pBEGIN := pAUX;
else pAfter^.pNEXT := pAUX;
end;

По-моему, так...
qlimax
Спасибо огромное!

Действительно так работает правильно, а у меня уже тямы не хватало! :)

PS:
Как дать "+" в репутацию? ;)
volvo
qlimax smile.gif Набрать 25 постов... Только потом сможешь изменять репутацию: репутация

мисс_граффити
как вариант - можно просить модеров/админов, чтобы поставили + smile.gif
добавила...
qlimax
Спасибо за помощь и поддержку!
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.