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 
 К началу страницы 
+ Ответить 

Сообщений в этой теме


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

 





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