Сортировка Опции

[ve7er]

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

1. Продажа программных продуктов.
Наименование Фирма-изготовитель Стоимость, руб. Объем, Мбайт. Количество на складе
.... ...... ...... ...... ......

program kursovik;

{$APPTYPE CONSOLE}

uses
  SysUtils,console;
  type
  Stnaz=string[30];
  Stfirma=string[50];
  Stsumma=string[12];
  Stves=string[10];
  Stkolvo=string[10];
  RecBook=record
          naz:Stnaz;
          firma:Stfirma;
          summa:Stsumma;
          ves:Stves;
          kolvo:Stkolvo;
      end;
  var
  bookfile:file of RecBook;
  Work:RecBook;
  Vid:byte;
  End_Menu:boolean;
  Name:string[12];

  procedure Name_File;
  begin
  write('file name>');
  readln(Name);
  end;

  procedure AddRec;
  begin
  writeln('information ¹',FilePos(BookFile)+1);
  with Work do
  begin
  writeln('name:');
  readln(naz);
  writeln('Firma:');
  readln(firma);
  writeln('stoimost:');
  readln(summa);
  writeln('ves v metrah:');
  readln(ves);
  writeln('kolichestvo na sklade:');
  readln(kolvo);
  write(BookFile,work);
  end;
  end;

  procedure Create_Book;
  var
  ind, Count:integer;
  begin
  Name_File;
  Assign(BookFile, Name);
  Rewrite(BookFile);
  writeln('Sozdanie zapisej fajla',  Name);
  writeln('vvedite chislo zapisej');
  readln(count);
  for ind:=1 to count do
  AddRec;
  writeln('file sozdan');
  writeln('file imeet',FileSize(BookFile),'zapisi');
  Close(BookFile);
  end;

  procedure OutputRec;
  begin
  read(BookFile,Work);
  with Work do
  begin
  writeln('zapis ¹',FilePos(BookFile),':');
  writeln('name:',naz,'Firma:',firma,'stoimost:',summa,'ves v metrah:',
             ves,'kolichestvo na sklade:',kolvo);
  end;
  end;
  procedure OutputAllRec;
  begin
  Name_File;
  assign(BookFile, Name);
  {$I-}
  reset(BookFile);
  {$I+}
  if IOresult=0 then
  begin
  Seek(BookFile,0);
  writeln('*** vyvod dannyh ',Name,'***');
  while (not Eof(BookFile)) do
  OutputRec;
  end
  else
  writeln('file'+Name+' not found');
  end;

  procedure UpdateRec;
  var
  NumRec:LongInt;
  begin
  Name_File;
  assign(BookFile, Name);
  {$I-}
  reset(BookFile);
  {$I+}
  if IOresult=0 then
  begin
  writeln('ukazhite nomer izmenyaemoj zapisi:');
  readln(NumRec);
  Seek(BookFile, NumRec-1);
  writeln('-- staroe znachenie --');
  OutputRec;
  Seek(BookFile,NumRec-1);
  writeln('zadaem novoe znachenie',NumRec,'zapisi');
  AddRec;
  Close(BookFile);
  end
  else
  writeln('file'+Name+'not found');
  end;

  procedure AddRecToEnd;
  begin
  Name_File;
  assign(BookFile,Name);
  {$I-}
  reset(BookFile);
  {$I+}
  if IOresult=0 then
  begin
  Seek(BookFile,FileSize(BookFile));
  AddRec;
  writeln('izmenennyj file dannyh imeet',FileSize(BookFile),'zapisi');
  close(BookFile);
  end
  else
  writeln('file'+Name+'not found');
  end;

  procedure FindNaz;
  var
  BookFile:file of RecBook;
  Work:RecBook;
  Maska:Stnaz;
  Rez_Find:boolean;
  CountRec:integer;
  begin
  Name_File;
  assign(BookFile,Name);
  {$I-}
  reset(BookFile);
  {$I+}
  if IOresult=0 then
  begin
  writeln('vvedite nazvanie produkta:');
  readln(Maska);
  Rez_Find:=false;
  CountRec:=0;
  while (not Eof(BookFile)) do
  begin
  read(BookFile,Work);
  with work do
  if Pos(Maska,naz)<>0 then
  begin
  Rez_Find:=true;
  Inc(CountRec);
  writeln('name:',naz,'Firma:',firma,'stoimost:',summa,'ves v metrah:',
             ves,'kolichestvo na sklade:',kolvo);
  end;
  end;
  if Rez_Find then
  writeln('chislo zapisej dly',Maska,'=',CountRec)
  else
  writeln('not found',Maska);
  Close(BookFile);
  end
  else
  writeln('file'+Name+'not found');
  end;
begin

End_Menu:=false;
repeat
clrscr;
writeln('*** Prodazha programnyh produktov ***');
writeln('Vyberite vid raboty');
writeln('1- create new file');
writeln('2- prosmotr spiska');
writeln('3- izmenenie zapisi');
writeln('4- dopolnenie spiska');
writeln('5- poisk produkta');
writeln('0- Exit');
readln(vid);
case vid of
1: Create_Book;
2: OutputAllRec;
3: UpdateRec;
4: AddRecToEnd;
5: Findnaz;
0: exit;
end;
writeln('please Enter for next');
readln;
until End_Menu;
readln;
end.

[Ozzя]

Методы сортировок

[ve7er]

Вот пытаюсь написать модуль для сортировки, нашел похожий, подделываю под свою прогу:

unit sort;
 interface
 uses
     SysUtils,Console;
 Type
    Stnaz=string[30];
  Stfirma=string[50];
  Stsumma=string[12];
  Stves=string[10];
  Stkolvo=string[10];
  RecBook=record
          naz:Stnaz;
          firma:Stfirma;
          summa:Stsumma;
          ves:Stves;
          kolvo:Stkolvo;

    end;

Procedure PrintSortByIndex(const FileName:string;SortBy:char);
implementation
       Procedure PrintSortByIndex(const FileName:string;SortBy:char);

var F : file of RecBook;
    P:RecBook;
    M:array of RecBook;
    X:array of integer;
    CountRecBook:Integer;
    j,i,n,t:integer;
Function Compare(const P1,P2:RecBook; SortBy:char):boolean;
begin
     Case SortBy of
               'a','A': Result:=P1.naz>P2.naz;
               'b','B': Result:=P1.firma>P2.firma;
               'c','C': Result:=P1.summa>P2.summa;
               'd','D': Result:=P1.ves>P2.ves;
               'e','E': Result:=P1.kolvo>P2.kolvo
              end;  {case }
end;
begin
  if not FileExists(FileName) then
                              begin
                                writeln('File not Exists !!!');
                                Sleep(500);
                                Exit;
                              end;
  if not (SortBy in['a','A','b','B','c','C','d','D','e','E']) then
                         begin
                             writeln('Sort key  incorrect');
                             Writeln('Stop sort');
                             sleep(1000);
                             Exit;
                         end;
  Assign(f,FileName);
  Reset(f);
  CountRecBook:=FileSize(F);
  SetLength(M,CountRecBook);
  SetLength(x,CountRecBook);
  For I:=0 to CountRecbook-1 do
                  begin
                       read(f,m[i]);
                       X[i]:=i;
                  end;
  N:=CountRecBook-1;

     For J:=N downto 0 do
       For i:=0 to N-1 do
            If Compare(M[x[i]],M[x[i+1]],SortBy) then
                        begin
                           T:=X[i];
                           X[i]:=X[i+1];
                           X[i+1]:=T;
                        end;
  PrintTitel;
  For I:=0 to N do
       PrintRecordSt(M[x[i]]);
  Writeln('****************************************************************');
  Writeln('All record = ',CountPerson);
  Close(f);
end.

Что такое PrintTitel; и почему выдает ошибку?

Сообщение отредактировано: ve7er - 2.06.2007 10:37

[Ozzя]

Судя по названию, процедура, которая печатает шапку таблицы.

нашел похожий

Воможно, описана где-то в одном из доп. модулей