Версия для печати темы

Автор: qlimax 3.09.2007 19:42

Доброго всем времени суток!

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

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

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

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

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 3.09.2007 20:10

Процедура 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 4.09.2007 13:02

Спасибо огромное!

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

PS:
Как дать "+" в репутацию? ;)

Автор: volvo 4.09.2007 14:08

qlimax Набрать 25 постов... Только потом сможешь изменять репутацию: http://forum.pascal.net.ru/index.php?s=&showtopic=15774&view=findpost&p=92421

Автор: мисс_граффити 4.09.2007 18:33

как вариант - можно просить модеров/админов, чтобы поставили +
добавила...

Автор: qlimax 5.09.2007 12:13

Спасибо за помощь и поддержку!