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

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

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

 
 Ответить  Открыть новую тему 
> Сортировка
сообщение
Сообщение #1


Разведчик
*

Группа: Пользователи
Сообщений: 14
Пол: Мужской
Реальное имя: Диман

Репутация: -  0  +


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

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.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #2


Гуру
*****

Группа: Пользователи
Сообщений: 1 220
Пол: Мужской

Репутация: -  16  +


Методы сортировок
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3


Разведчик
*

Группа: Пользователи
Сообщений: 14
Пол: Мужской
Реальное имя: Диман

Репутация: -  0  +


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

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 -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #4


Гуру
*****

Группа: Пользователи
Сообщений: 1 220
Пол: Мужской

Репутация: -  16  +


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

Воможно, описана где-то в одном из доп. модулей
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

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

 





- Текстовая версия 24.09.2020 21:23
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name