Помощь - Поиск - Пользователи - Календарь
Полная версия: Сортировка
Форум «Всё о Паскале» > Pascal, Object Pascal > Задачи
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; и почему выдает ошибку?
Ozzя
Судя по названию, процедура, которая печатает шапку таблицы.
Цитата
нашел похожий

Воможно, описана где-то в одном из доп. модулей
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.