библеотеки интерфейсных элементов Опции

[KOLYAN]

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