Версия для печати темы

Нажмите сюда для просмотра этой темы в обычном формате

Форум «Всё о Паскале» _ Задачи _ библеотеки интерфейсных элементов

Автор: KOLYAN 19.03.2008 1:03

помогите с решением задачи не получается сделать сортировку по дате (процедура 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.