Ask Question

Name:
Title:
Your Question:

Answer Question

Name:
Your Answer:
User Submitted Source Code!


Description:
  пт
Language: PASCAL
Code:
program term;
uses crt;
const 
     dl = 25; 
     mmenu = 12; 
     textw = 13;
     numw = 10;
     taskw = 17;
     fway = 'data.dat';
type
    Trec = record
        F,I,O:string[textw];
        d,m,y,mark:string[numw];
        task:string[taskw];
     end;
     TD = record
          d,m,y:string;
     end;
     
var 
     db : array [1..dl]of trec;
     db1 : array [1..dl]of trec;
     fdb: file of trec;
     tdtemp:td;
     first:trec;
     temp:trec;
     fpage:integer;
     item,cur,iii,d1,m1,y1:integer;
     ssss,result:string;
     menu:array [1..mmenu]of string;
   char1:char;
   needexit:boolean;

procedure init;
begin
     menu[1]:='View table';
     menu[2]:='Add item';
     menu[3]:='Edit item';
     menu[4]:='Delete item';
     menu[5]:='All marked';
     menu[6]:='All time'; {тех у кого срок истекает  на дату}
     menu[7]:='Sort by F';
     menu[8]:='Sort by I';
     menu[9]:='Sort by O';
     menu[10]:='Sort by time';
     menu[11]:='About';
     menu[12]:='Exit';
{$I-}
     assign(fdb,fway);
{$I+}
end;   
function endof:boolean;
begin
     endof:=(cur=dl+1);
end;
{
procedure CreateFile;
begin
{$I-}{
     rewrite(f);
{$I+}{
end;
procedure OpenFile;
begin
{$I-}{
     reset(fdb);
{$I+}{
 if IOresult<>0 then
 begin
     createfile;
 end; 
end;}

{function npts:string;
var
begin

end;}
procedure nptd;
var {result,}s:string; i,a,d,m,y:integer; k:char;
begin
 clrscr;
 a:=-1; d:=0; m:=0;
 y:=0; k:='!'; i:=-1;
 write('Input date(): ',d,'.',m,'.',y);
 s:=' ';
 {result:='';}
     repeat
          a:=ord(k)-ord('0');
          if ((k='.')or(k=#13))and(d<>0) then break;
        if (a>=0)and(a<=9) then
        if d<>0 then d:=d*10+a else d:=a;
        clrscr;
        write('Input date(day): ',d,'.',m,'.',y);
        k:=readkey;
     until false;
     if d>31 then d:=31;
     if d<1 then d:=1;
     repeat
          a:=ord(k)-ord('0');
          if ((k='.')or(k=#13))and(m<>0) then break;
        if (a>=0)and(a<=9) then
        if m<>0 then m:=m*10+a else m:=a;
        clrscr;
        write('Input date(month): ',d,'.',m,'.',y);
        k:=readkey;
     until false;
     if m>12 then m:=12;
     if m<1 then m:=1;
     k:=readkey;
     repeat
          a:=ord(k)-ord('0');
          if ((k='.')or(k=#13))and(y<>0) then break;
        if (a>=0)and(a<=9) then
        if y<>0 then y:=y*10+a else y:=a;
        clrscr;
        write('Input date(year): ',d,'.',m,'.',y);
        k:=readkey;
     until false;
     if y>2100 then y:=2100;
     if y<1 then y:=1;

 {str(d,result); if d<10 then result:='0'+result; result:=result+'.';
 str(m,s); if m<10 then s:='0'+s; result:=result+s+'.';
 str(y,s); if y<10 then s:='000'+s else if y<100 then s:='00'+s else if y<1000 then s:='0'+s; result:=result+s;}
 str(d,tdtemp.d);
 str(m,tdtemp.m);
 str(y,tdtemp.y);
 clrscr;
end;

{function filelen:integer;
begin
     filelen:=205;
end;
function filepage:integer;
var n,m:integer;
begin
     m:=filelen;
     n:=m div dl;
     if m mod dl >0 then n:=n+1;
     filepage:=n;
end;}

procedure AddRecord;
var h:char; name,sname,father,task,mark:string;
begin
     repeat
          clrscr;
          textcolor(lightred);writeln('Fill following fields or press <ESC>'); 
          textcolor(yellow);write('Name: ');textcolor(white);
          h:=readkey;
          while h<>#13 do
          begin
          end;
     until false;
end;

procedure readnext;
begin
     temp:=db1[cur];
     cur:=cur+1;
end;

procedure draw;
var i:integer;
begin
    clrscr;
     cur:=fpage*dl+1;
     {seek(fdb,cur);}
     textcolor(white);
     for i:=1 to mmenu do begin if i=item then textcolor(lightred) else textcolor(white); writeln(menu[i]); end;
     
     textcolor(13);
     writeln('len= ',105);
     textcolor(1);
end;

procedure view(par:integer);
var i,d,d0,m,m0,y,y0,a,code,l:integer; k:char; s:string;   p,viewst:boolean;
begin    p:=false;
 repeat
 viewst:=false;
 if par=2 then 
 begin
     nptd;
     val(tdtemp.d,d0,code);
     val(tdtemp.m,m0,code);
     val(tdtemp.y,y0,code);
          
     l:=1;
     cur:=fpage*dl+1;
     {seek(fdb,cur);}
     while (l<=dl) and not endof do
     begin
          readnext; {read from file, wtite to temp}
          val(temp.y,y,code);
          if y<=y0 then 
               if y=y0 then
               begin
                    val(temp.m,m,code);
                    if m<=m0 then 
                         if m=m0 then
                              begin
                                   val(temp.d,d,code);
                                   p:=(d<=d0);
                              end 
                         else p:=true
                    else p:=false;
               end 
               else p:=true
          else p:=false;
          
          if p then begin
               db[l]:=temp;
               l:=l+1;
          end;
         writeln(temp.d,'.',temp.m,'.',temp.y,'> ',p);
          readkey;
     end;
 end;

 if par=1 then
 begin
     l:=1;
     cur:=fpage*dl+1;
     {seek(fdb,cur);}
     while (l<=dl) and not endof do
     begin
          readnext;
          if (temp.mark='TRUE')
          then begin
               db[l]:=temp;
               l:=l+1;
          end;
     end;
 end;
 if par=0 then
 begin
     l:=1;
     cur:=fpage*dl+1;
     {seek(fdb,cur);}
     while (l<=dl) and not endof do
     begin
          readnext;
          db[l]:=temp;
          l:=l+1;
     end;
 end;
 clrscr;
 l:=l-1;
 for i:=1 to l do begin
     write(i:2,'|',db[i].d:2,'.',db[i].m:2,'.',db[i].y,'|');
     {if db[i].mark='TRUE' then write(' TRUE | ') else }
     write(db[i].mark:5,'|');
     write(db[i].task:taskw,'|',db[i].f:textw,' ',db[i].i:textw,' ',db[i].o:textw);
     writeln;
     end;
 k:=readkey;
 if k=#75 then {left}
     if (fpage-1)>=0 then
     begin
          fpage:=fpage-1;
          viewst:=true;
     end;
 if k=#77 then {right}
     if (fpage+1)<(105) then
     begin
          fpage:=fpage+1;
          viewst:=true;
     end;
 if k=#27 then break;
 until not viewst;
end;
   
procedure perform(c:char);
begin
 case c of
     #13: case item of
               1: view(0);
               {2: addrec;
               3: editrec;
               4: deleterec;}
               5: view(1);
               6: view(2);{
               7: sort(1);
               8: sort(2);
               9: sort(3);
               10: sort(4);
               11: about;}
               12: needexit:=true;
               else end;
     #27: needexit:=true;
     #75:; {left}
     #77:; {right}
     #72:if (item-1)>0 then item:=item-1 else item:=mmenu;{down}
     #80:if (item+1)<=mmenu then item:=item+1 else item:=1; {up}
 else end;
     draw;
end;

BEGIN
randomize;
clrscr;
needexit:=false;
init;
for iii:=1 to 105 do
begin 
result:='';
     str(iii,ssss); db1[iii].task:=ssss+'personaltask'; db1[iii].f:=ssss+'familia'; db1[iii].I:=ssss+'name';
        db1[iii].o:=ssss+'father';
     
      d1:=random(31)+1;m1:=random(12)+1;y1:=random(200)+1900;
      str(d1,db1[iii].d);str(m1,db1[iii].m);str(y1,db1[iii].y);
      {str(d1,result); if d1<10 then result:='0'+result; result:=result+'.';
     str(m1,ssss); if m1<10 then ssss:='0'+ssss; result:=result+ssss+'.'; str(y1,ssss); result:=result+ssss;
      db1[iii].date:=result;}
     if (iii mod (random(4)+1)=0)
     then db1[iii].mark:='TRUE' else db1[iii].mark:='FALSE'; 
end;
cur:=1;
item:=1;
fpage:=0;
{draw;}
  repeat
   {read( char1);
   perform(char1);}
   perform(readkey);
  until (needexit);
END.
Comments: