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

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

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

 
 Ответить  Открыть новую тему 
> библеотеки интерфейсных элементов
сообщение
Сообщение #1


Новичок
*

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

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


помогите с решением задачи не получается сделать сортировку по дате (процедура sort) нужно изменить только в основной программе и в модуле Base:
условие: разработать программу которая организует хранение в файле инф о товаре на складе.
по каждому товару необходимознать: наименование дату изготовления сведенья о изготовителе количество.
1 вывести списрк товара;
2 выполнить поиск товара(сделано)
3 вывести список товара отсортированный по дате поступления
основная прога:
 
Program cc1;
Uses Crt,Win,Input,Message,Menu,Form,Base;
{объевление классов - потомков библеотечных классов}
Type TMain=object (TMenu) {главное меню}
may:boolean; {признак открытия файла}
Procedure Enter; virtual;
end;

TIName=object(TInput) {ввод имени файла}
Function Error:boolean; virtual; {проверка имени файла}
end;

TAdd=object(TForm) {форма для добавления записей}
Procedure Enter; virtual; {завершение ввода одной записи}
end;

TFind=object(TForm) {форма для поиска товаров}
Procedure Input; virtual; {ввод данных для поиска}
Procedure Enter; virtual; {поиск одной записи}
Procedure Show; {вывод результата поиска в окно}
end;

Tsort=object(Tform)
procedure enter; virtual;
procedure show;
end;
{объевление объектной переменной}
Var M:TMain; {объект главное меню}
N:TIName; {объект ввод имени файла}
Z:Tsort;
A:TAdd; {объект добавление записей}
F:TFind; {объект поиск записей}
ND:TMessage; {объект Сообщение об отсутствии данных}
B:TBase; {объект файл}
{описание дополнительных методов}
Procedure TMain.Enter; {обработка выбора пунктов главного меню}
Begin
case npos of
1:begin
N.Draw; {выводим окно ввода}
N.Input; {вводим имя файла проверяя его допустимость}
B.Open(N.inp.text);{если файл существует то открываем его иначе-создаем}
may:=true; {устанавливаем признак открытия файла}
End;
2: if may then {если определен файл данных}
A.Run; {осуществляем поиск записей}
3: if may then {если определен файл данных}
F.Run; {осуществляем добавление записей}
4:if may then
Z.Run;
End;
End;

Function TIName.Error; {проверка имени файла}
Var p:integer;
Begin
p:=Pos('.',inp.Text);
if p=0 then p:=length(inp.Text);
if (p>0) and (p<=8) then Error:=false
else Error:=true;
End;

Procedure TAdd.Enter; {обработка пунктов меню добавления}
Begin
case npos of
1:begin
Input; {вводим наименование дату количество сведенья}
B.Add(masinp[1].inp.text,masinp[2].inp.text,
masinp[3].inp.text,masinp[4].inp.text);{записываем в файл}
end;
end;{case}
end;

Procedure TFind.Enter;{обработка пунктов меню}
begin
case npos of
1:begin
Input; {вводим наименование и дату}
if B.Find(masinp[1].inp.text,masinp[2].inp.text) then Show
else ND.Run; {выводим сообщение об отсутствии данных}
end;
2: begin
if B.FindNext then Show
else ND.Run; {выводим сообщение об отсутствии данных}
end;
end;
end;

Procedure TFind.Input; {ввод данных для поиска информации}
begin
Clear; {очищаем поля ввода}
masinp[1].Input; {вводим наименование}
masinp[2].Input; {вводим дату}
end;

Procedure TFind.Show; {вывод данной информации в окно}
begin
Clear;
case npos of
1:begin
masinp[1].inp.text:=B.naim; masinp[1].Draw; {выводим наименование}
masinp[2].inp.text:=B.d; masinp[2].Draw; {выводим дату}
masinp[3].inp.text:=B.kol; masinp[3].Draw; {выводим количество}
masinp[4].inp.text:=B.sv; masinp[4].Draw; {выводим сведенья}
end;
end;
end;

Procedure Tsort.Enter; {обработка пунктов меню добавления}
Begin
case npos of
1:begin {вводим наименование дату количество сведенья}
B.sort;{записываем в файл}
masinp[1].inp.text:=B.naim; masinp[1].Draw; {выводим наименование}
masinp[2].inp.text:=B.d; masinp[2].Draw; {выводим дату}
masinp[3].inp.text:=B.kol; masinp[3].Draw; {выводим количество}
masinp[4].inp.text:=B.sv; masinp[4].Draw;
end;
end;{case}
end;
Procedure Tsort.show;
begin
clear;
masinp[1].inp.text:=B.naim; masinp[1].Draw; {выводим наименование}
masinp[2].inp.text:=B.d; masinp[2].Draw; {выводим дату}
masinp[3].inp.text:=B.kol; masinp[3].Draw; {выводим количество}
masinp[4].inp.text:=B.sv; masinp[4].Draw;
End;

{описание констант для инициализации полей массивов}
const menu1:array[1..5] of TWin=
((x1:10;y1:14;x2:23;y2:18;attr:113;xt:1;yt:2;text:'открыть создать файл'),
(x1:26;y1:14;x2:39;y2:18;attr:113;xt:1;yt:2;text:'добавить товар'),
(x1:42;y1:14;x2:55;y2:18;attr:113;xt:1;yt:2;text:'поиск товара'),
(x1:58;y1:14;x2:71;y2:18;attr:113;xt:1;yt:2;text:'сортировка списка '),
(x1:10;y1:20;x2:71;y2:24;attr:113;xt:1;yt:2;text:'выход'));

menu2:array[1..2] of TWin=
((x1:28;y1:18;x2:38;y2:21;attr:113;xt:2;yt:2;Text:'Добавить'),
(x1:42;y1:18;x2:52;y2:21;attr:113;xt:2;yt:2;text:'Выход'));

menu3:array[1..3] of TWin=
((x1:23;y1:18;x2:33;y2:21;attr:113;xt:2;yt:2;text:'Найти'),
(x1:35;y1:18;x2:45;y2:21;attr:113;xt:2;yt:2;text:'Следующий'),
(x1:47;y1:18;x2:57;y2:21;attr:113;xt:2;yt:2;text:'Выход'));

menu4:array[1..2] of TWin=
((x1:23;y1:18;x2:33;y2:21;attr:113;xt:2;yt:2;text:'следующий'),
(x1:35;y1:18;x2:45;y2:21;attr:113;xt:2;yt:2;text:'выход'));

inpp:array[1..4] of TInput=
((x1:22;y1:8;x2:42;y2:8;attr:94;xt:1;yt:1;text:'Наименование';
Inp:(x1:34;y1:8;x2:54;y2:8;attr:112;xt:1;yt:1;text:'')),
(x1:20;y1:10;x2:42;y2:10;attr:94;xt:1;yt:1;text:'Дата поступления';
Inp:(x1:34;y1:10;x2:54;y2:10;attr:112;xt:1;yt:1;text:'')),
(x1:22;y1:12;x2:32;y2:12;attr:94;xt:1;yt:1;text:'Количество';
Inp:(x1:32;y1:12;x2:54;y2:12;attr:112;xt:1;yt:1;text:'')),
(x1:22;y1:14;x2:32;y2:14;attr:94;xt:1;yt:1;text:'Сведения';
Inp:(x1:32;y1:14;x2:54;y2:14;attr:112;xt:1;yt:1;text:'Выход')));
{основная программа}
begin
{инициализируем объекты}
M.Init(1,1,80,50,40,5,3,'*** ТОВАР ***',5,menu1);
A.Init(20,2,60,22,94,5,3,'Добавление',2,menu2,4,inpp);
N.Init(30,8,50,19,94,3,3,'Открыть файл:',35,12,45,12,112,1,1,'');
F.Init(20,2,60,22,94,5,3,'Поиск',3,menu3,4,inpp);
Z.Init(20,2,60,22,94,5,3,'Сортировка',2,menu4,4,inpp);
ND.Init(30,6,50,14,30,6,2,'Нет данных',34,11,46,12,71,2,1,'Продолжить');
{начинаем работу}
M.may:=false; {устанавливаем признак файл не открыт}
M.Run; {передаем управление Главному меню}
if M.may then B.Closef;
TextBackGround(0);
window(1,1,100,90);
ClrScr;
end.


модуль base:
 
Unit Base;
interface
Type tStr2=string[30];
rec=record
rnaim,rd,rkol,rsv:tStr2;
End;
TBase=object
f:file of rec;
naim,d,kol,sv:tStr2;{результаты поиска}
p_naim,p_d:tStr2; {данные поиска}
k1,k2:boolean; {ключи поиска}
st,st1:rec;
Procedure Open(fd:tStr2); {открытие/создание файла}
Procedure Add(anaim,ad,akol,asv:tStr2); {добавление записей}
Procedure sort;
Function Find(anaim,ad:tStr2):boolean; {поиск первого}
Function FindNext:boolean; {поиск следующего}
Procedure Closef; {закрытие файла}
End;

implementation

Procedure TBase.Open;
Begin
Assign(f,fd); {инициализация файловой переменной}
{$i-}
Reset(f);
{$i+} {открытие с проверкой существования}
If IOResult<>0 then rewrite(f); {создание файла}
End;

Procedure TBase.Add;
Var r:rec;
Begin
Seek(f,FileSize(f)); {устанавливаем файловый указатель на конец файла}
r.rnaim:=anaim; {создаем запись}
r.rd:=ad;
r.rkol:=akol;
r.rsv:=asv;
Write(f,r); {выводим запись в файл}
End;

Procedure TBase.sort;
Var r,r1,s:rec; i,j:integer;
Begin
reset(f);
for i:=0 to filesize(f)-2 do
begin
Seek(f,i);
read(f,r);
for J:=i+1 to filesize(f)-1 do
begin
seek(f,j);
read(f,r1);
if r.rnaim>r1.rnaim then
begin
seek(f,i);
write(f,r1);
seek(f,j);
write(f,r);
Write(f,r);
s:=r1;
r1:=r;
r:=s;
end;
end;
end;
End;

Function TBase.Find;
Begin
Close(f); {закрываем файл}
Reset(f); {открываем файл для чтения}
p_naim:=anaim; {сохраняем данные поиска}
p_d:=ad;
k1:=p_naim<>''; {устанавливаем два ключа поиска}
k2:=p_d<>'';
Find:=FindNext; {ищем запись по ключам}
End;
Function TBase.FindNext;
Var r:rec;
k3,k4,Ok:boolean; {ключи поиска и его результат}
Begin
ok:=false; {ключ поиска "запись не найдена"}
While not eof(f) and not Ok do
Begin
Read(f,r);
k3:=p_naim=r.rnaim; {строим еще два ключа поиска}
k4:=p_d=r.rd;
{выбираем записи}
If (k1 and k2 and k3 and k4) or
(not k1 and k2 and k4) or (k1 and not k2 and k3) then
Begin
Ok:=true; {ключ поиска "запись найдена"}
naim:=r.rnaim; {копируем результаты поиска}
d:=r.rd;
kol:=r.rkol;
sv:=r.rsv;
End;
End;
FindNext:=Ok; {возвращаем ключ поиска}
End;

Procedure TBase.Closef;
Begin
Close(f); {закрываем файл}
End;
End.


модуль input:
 
Unit Input;
interface
Uses Crt,Win;
Type TInput=object(TWin)
inp:TWin;
Constructor Init(ax1,ay1,ax2,ay2,aattr,axt,ayt:integer;atext:tStr;
bx1,by1,bx2,by2,battr,bxt,byt:integer;btext:tStr);
Procedure Draw; {вывод окна}
Procedure Clear; {очистка поля ввода}
Procedure Input; {ввод строки из окна}
Function Error:boolean;virtual; {проверка введенных данных}
End;

implementation

Constructor TInput.Init;
Begin
inherited Init(ax1,ay1,ax2,ay2,aattr,axt,ayt,atext);
inp.Init(bx1,by1,bx2,by2,battr,bxt,byt,'');
End;

Procedure TInput.Draw;
Begin
inherited Draw;
inp.Draw;
End;

Procedure TInput.Clear;
Begin
inp.text:='';
inp.Draw;
End;

Procedure TInput.Input;
Begin
window(inp.x1,inp.y1,inp.x2,inp.y2);
TextBackGround(inp.attr div 16);
TextColor(inp.attr mod 16);
repeat
GotoXY(inp.xt,inp.yt);
Clear;
readln(inp.text);
GotoXY(inp.xt,inp.yt);
write(inp.text);
until not Error;
End;

Function TInput.Error:boolean; {проверка не выполняется}
Begin
Error:=false;
End;
End.


модуль form:
 
Unit Form;
interface
Uses crt,win,input,Menu;
Type TForm=object(TMenu)
ninput:integer; {количество полей ввода}
masinp:array[1..10]of TInput; {массив полей ввода}
Constructor Init(ax1,ay1,ax2,ay2,aattr,axt,ayt:integer;
atext:tStr; n:integer;
Const w1:array of TWin; k:integer;
Const w2:array of TInput);
Procedure Draw;virtual; {вывод окна}
Procedure Clear; {очистка окон ввода}
Procedure Input; {ввод информации из окон ввода}
End;

Implementation

Constructor TForm.Init;
Var i:integer;
Begin
Inherited Init(ax1,ay1,ax2,ay2,aattr,axt,ayt,atext,n,w1);
ninput:=k; {количество задействованных окон ввода}
for i:=1 to ninput do
masinp[i].Init(w2[i-1].x1,w2[i-1].y1,w2[i-1].x2,w2[i-1].y2,
w2[i-1].attr,w2[i-1].xt,w2[i-1].yt,w2[i-1].text,
w2[i-1].inp.x1,w2[i-1].inp.y1,w2[i-1].inp.x2,w2[i-1].inp.y2,
w2[i-1].inp.attr,w2[i-1].inp.xt,w2[i-1].inp.yt,w2[i-1].inp.text);
End;

Procedure TForm.Draw;
Var i:integer;
Begin
inherited Draw; {выводим основное окно}
for i:=1 to nalt do {выводим окна ввода}
masalt[i].Draw;
for i:=1 to ninput do
masinp[i].Draw;
End;

Procedure TForm.Clear;
Var i:integer;
Begin
for i:=1 to ninput do
masinp[i].Clear; {чистим окна вввода}
End;

Procedure TForm.Input;
Var i:integer;
Begin
Clear;
for i:=1 to ninput do
masinp[i].Input; {вводим данные}
End;
End.


модуль menu:
 
Unit Menu;
interface
Uses crt,win;
Type TMenu=object(TWin)
nalt:integer;{количество альтернатив в меню}
masalt:array[1..20]of TWin;{массив альтернатив в меню}
npos:integer; {номер выбранного альтернатива}
constructor Init(ax1,ay1,ax2,ay2,aattr,axt,ayt:integer;
atext:tStr;n:integer;
const w:array of TWin); {открытый массив Twin}
Procedure Run; {реализация работы меню}
Procedure Draw;virtual; {вывести окно}
Procedure Enter;virtual; {при нажатии на Enter}
End;
implementation

Constructor TMenu.Init;
Var i:integer;
Begin
inherited Init(ax1,ay1,ax2,ay2,aattr,axt,ayt,atext);
nalt:=n; {количество реально исполняемых пунктов}
for i:=1 to nalt do
masalt[i].Init(w[i-1].x1,w[i-1].y1,w[i-1].x2,w[i-1].y2,
w[i-1].attr,w[i-1].xt,w[i-1].yt,w[i-1].text);
End;

Procedure TMenu.Draw;
Var i:integer;
Begin {очищаем экран}
TextBackGround(0);
TextColor(1);
Window(1,1,100,90);
ClrScr;
inherited Draw; {выводим основное окно}
for i:=1 to nalt do masalt[i].Draw;{выводим окно пунктов}
End;

Procedure TMenu.Run;
Var ch1,ch2:char;
temp:integer;
Begin
Draw;
npos:=nalt;
masalt[npos].SetAttr(71);
repeat
ch1:=ReadKey; {читаем код клавиши}
if ch1=#0 then ch2:=ReadKey;
case ch1 of
#0: case ch2 of
#75: Begin {перемещение курсора влево}
temp:=npos-1;
if temp=0 then temp:=nalt; {закольцовываем}
masalt[npos].SetAttr(113); {убираем выделение}
masalt[temp].SetAttr(71); {выделяем пункт}
npos:=temp;
End;
#77: Begin {перемещение курсора вправо}
temp:=npos+1;
if temp=nalt+1 then temp:=1; {закольцовываем}
masalt[npos].SetAttr(113); {убираем выделение}
masalt[temp].SetAttr(71); {выделяем пункт}
npos:=temp;
End;
End;
#13: Begin
masalt[npos].SetAttr(113); {убираем выделение}
Enter; {при нажатии Enter выполняем пункт}
Draw; {выводим главное меню}
masalt[npos].SetAttr(71);{выделяем пункт меню}
End;
End;
until ((npos=nalt)and(ch1=#13))or(ch1=#27);{по завершению работы}
End;

Procedure TMenu.Enter; {абстрактный метод выполнения пунктов}
Begin
End;
End.


модуль message:
 
Unit Message;
interface
Uses Crt,win;
Type TMessage=object (TWin)
Ok:tWin;
Procedure Init(ax1,ay1,ax2,ay2,aattr,axt,ayt:integer;atext:tStr;
bx1,by1,bx2,by2,battr,bxt,byt:integer;btext:tStr);
Procedure Run;
Procedure Draw;
End;

implementation

Procedure TMessage.Init;
Begin
inherited Init(ax1,ay1,ax2,ay2,aattr,axt,ayt,atext);
Ok.Init(bx1,by1,bx2,by2,battr,bxt,byt,btext);
End;

Procedure TMessage.Draw;
Begin
inherited Draw;
Ok.Draw;
End;

Procedure TMessage.Run;
Begin
Draw;
ReadKey;
End;
End.


модуль win:
 
Unit Win;
interface
Uses Crt;
Type tStr=string[80];
TWin=object
x1,y1,x2,y2:integer;
attr:integer;
xt,yt:integer;
text:tStr;
Procedure Init(ax1,ay1,ax2,ay2,aattr,axt,ayt:integer;
atext:tStr);
Procedure SetAttr(aattr:integer);
Procedure Draw;
End;

implementation

Procedure TWin.Init;
Begin
x1:=ax1;
y1:=ay1;
x2:=ax2;
y2:=ay2;
attr:=aattr;
xt:=axt;
yt:=ayt;
text:=atext;
End;

Procedure TWin.Draw;
Begin
TextBackGround(attr div 16);
TextColor(attr mod 16);
window(x1,y1,x2,y2);
ClrScr;
GotoXY(xt,yt);
write(text);
End;

Procedure TWin.SetAttr;
Begin
attr:=aattr;
Draw;
End;
End.

 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

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

 





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