Program project2; Uses CRT,GRAPH; Type Ppost=^post; Post=record Title,Datein,Dateout:string; NextP:ppost; end; pItem=^Item; Item=record Surname,Name,Patronymic,Birthday,Place,Address,Family:string; Posts,firstpost:ppost; kolP:integer; NextI:pItem; end; ZZZ=object firstitem,a:pItem; kolI:integer; procedure addItem(n:integer); procedure addPost(n:integer); procedure delItem(n:integer); procedure delPost(n:integer); procedure Correct(n:integer); procedure Prosmotrpost(n:integer); procedure Prosmotr; procedure Sozdanie; procedure Save; procedure Load; procedure DisposeBaza; end; Var gd,gm:integer; f:file of string; Temp:zzz; key:char; op:integer; sr,sr1:string; i,J,l,r:integer; key1,key2:char; s:array[1..6] of string; Function Stroka(var s:string; l,x0,y0:integer):string; Var x:integer; Begin sr:=s; repeat setcolor(9); outtextxy(x0,y0,sr); x:=x0+8*length(sr); repeat setcolor(2); outtextxy(x,y0,'_'); delay(6000); setcolor(0); outtextxy(x,y0,'_'); delay(6000); until keypressed; key1:=readkey; if (key1=#8)and(length(sr)>0) then begin setfillstyle(0,1); bar(x0,y0,x0+8*length(sr),y0+8); delete(sr,length(sr),1); end; if key1=#13 then begin stroka:=sr; sr:=''; s:=''; l:=0; exit; end; if key1 in [#27,#80,#72,#77,#75,'+','-'] then begin stroka:=s; setfillstyle(0,1); bar(x0,y0,x0+8*length(sr),y0+8); setcolor(9); outtextxy(x0,y0,s); x:=x0+8*length(s); sr:=''; s:=''; l:=0; exit; end; if (key1 in[':','\',' ','.','0'..'9','A'..'Z','a'..'z','А'..'Я','а'..'я'])and(length(sr)(n-2) div 10 then begin setfillstyle(1,0); bar(15,234,630,454); end; str(n,sr); setcolor(2); outtextxy(56-8*length(sr),220+20*(n-10*j),sr); sr:=''; setcolor(1); rectangle(60,218+20*(n-10*j),396,218+20*(n-10*j)+12); rectangle(406,218+20*(n-10*j),502,218+20*(n-10*j)+12); rectangle(512,218+20*(n-10*j),608,218+20*(n-10*j)+12); a^.posts^.title:=stroka(sr,40,64,220+20*(n-10*j)); a^.posts^.datein:=stroka(sr,10,410,220+20*(n-10*j)); a^.posts^.dateout:=stroka(sr,10,516,220+20*(n-10*j)); a^.posts^.NextP:=nil; End; Procedure zzz.AddItem(n:integer); Begin str(n,sr); forma; setcolor(14); sr:=' Ввод данных '+sr+'-ого сотрудника'; outtextxy(100,50,sr); setcolor(1); outtextxy(50,460,' "+" - добавить должность, "Esc" - закончить ввод'); if n=1 then begin new(a); FirstItem:=a; end else begin a:=FirstItem; for i:=1 to n-2 do a:=a^.NextI; new(a^.NextI); a:=a^.NextI; end; sr:=''; a^.surname:=stroka(sr,20,274,80); a^.name:=stroka(sr,20,274,100); a^.patronymic:=stroka(sr,20,274,120); a^.birthday:=stroka(sr,10,274,140); a^.place:=stroka(sr,20,274,160); a^.address:=stroka(sr,20,274,180); a^.family:=stroka(sr,20,274,200); a^.NextI:=nil; I:=1; zzz.AddPost(i); repeat key2:=readkey; if key2='+' then begin inc(i); AddPost(i); end; until key2=#27; a^.kolP:=i; End; Procedure zzz.Sozdanie; Begin kolI:=1; zzz.Additem(kolI); repeat cleardevice; setcolor(14); outtextxy(100,100,'"+" -Добавить сотрудника, "Esc" - Закончить ввод'); key1:=readkey; if key1='+' then begin inc(kolI); zzz.additem(kolI); end; until key1=#27; End; Procedure zzz.delItem(n:integer); var p:pitem; Begin if n=1 then begin a:=firstitem; firstitem:=a^.nexti; end; if (n>1)and(n1) then begin a:=firstitem; for j:=1 to n-2 do a:=a^.nexti; a^.nexti:=nil; end; End; Procedure zzz.delPost(n:integer); var p:ppost; Begin if n=1 then begin a^.posts:=a^.firstpost; a^.firstpost:=a^.posts^.nextp; end; if (n>1)and(n1) then begin a^.posts:=a^.firstpost; for j:=1 to n-2 do a^.posts:=a^.posts^.nextp; a^.posts^.nextp:=nil; end; End; Procedure zzz.Correct(n:integer); Begin case n of 1:begin sr:=a^.surname; a^.surname:=stroka(sr,20,274,80); end; 2:begin sr:=a^.name; a^.name:=stroka(sr,20,274,100); end; 3:begin sr:=a^.patronymic; a^.patronymic:=stroka(sr,20,274,120); end; 4:begin sr:=a^.birthday; a^.birthday:=stroka(sr,10,274,140); end; 5:begin sr:=a^.place; a^.place:=stroka(sr,20,274,160); end; 6:begin sr:=a^.address; a^.address:=stroka(sr,20,274,180); end; 7:begin sr:=a^.family; a^.family:=stroka(sr,20,274,200); end; end; if (n>8) then begin a^.posts:=a^.firstpost; for j:=1 to ((n-9) div 3) do a^.posts:=a^.posts^.Nextp; case n mod 3 of 1:begin sr:=a^.posts^.datein; a^.posts^.datein:=stroka(sr,10,410,220+20*(((n div 3)-2)-10*((n-9) div 30))); end; 2:begin sr:=a^.posts^.dateout; a^.posts^.dateout:=stroka(sr,10,516,220+20*(((n div 3)-2)-10*((n-9) div 30))); end; 0:begin sr:=a^.posts^.title; a^.posts^.title:=stroka(sr,40,64,220+20*(((n div 3)-2)-10*((n-9) div 30))); end; end; end; end; Procedure zzz.prosmotrpost(n:integer); Begin setfillstyle(1,0); bar(5,234,630,454); a^.posts:=a^.firstpost; for j:=1 to 10*n do Temp.a^.posts:=Temp.a^.posts^.Nextp; for j:=1 to 10 do begin if (j+10*n)>a^.kolp then break; str(j+10*n,sr); setcolor(2); outtextxy(56-8*length(sr),220+20*j,sr); setcolor(1); rectangle(60,218+20*j,396,218+20*j+12); rectangle(406,218+20*j,502,218+20*j+12); rectangle(512,218+20*j,608,218+20*j+12); setcolor(9); sr:=a^.posts^.title; outtextxy(64,220+20*j,sr); sr:=a^.posts^.datein; outtextxy(410,220+20*j,sr); sr:=a^.posts^.dateout; outtextxy(516,220+20*j,sr); a^.posts:=a^.posts^.NextP; end; End; Procedure zzz.Prosmotr; var r,nItem,nPost:integer; Begin if not assigned(FirstItem) then exit; nItem:=1; repeat a:=FirstItem; for i:=1 to nItem-1 do a:=a^.NextI; r:=1; forma; outtextxy(50,460,'"+","-" - доб./удал. сотрудника или должность, "Esc" - выход'); str(nitem,sr); setcolor(14); sr:=' Просмотр данных '+sr+'-ого сотрудника'; str(kolI,sr1); sr:=sr+' ╚╟ '+sr1; outtextxy(320-length(sr)*4,50,sr); setcolor(9); sr:=a^.surname; outtextxy(274,80,sr); sr:=a^.name; outtextxy(274,100,sr); sr:=a^.patronymic; outtextxy(274,120,sr); sr:=a^.birthday; outtextxy(274,140,sr); sr:=a^.place; outtextxy(274,160,sr); sr:=a^.address; outtextxy(274,180,sr); sr:=a^.family; outtextxy(274,200,sr); l:=0; repeat prosmotrpost(l); if ((Temp.a^.kolp-1) div 10)>l then begin setcolor(13); outtextxy(5,420,'*'); end; if l>0 then begin setcolor(13); outtextxy(5,240,'*'); end; repeat correct(r); case key1 of #80,#13:if r<(a^.kolp*3+8) then begin inc(r); if r=8 then r:=9; end; #72:if r>1 then begin r:=r-1; if r=8 then r:=7; end; '+':begin if r<8 then begin inc(kolI); additem(kolI); nItem:=koli; end; if r>8 then begin l:=((a^.kolp) div 10); prosmotrpost(l); inc(a^.kolP); AddPost(a^.kolP); end; r:=(a^.kolp*3+8); end; '-':begin if r<8 then begin delitem(nItem); if nitem=koli then dec(nitem); dec(koli); if koli=0 then exit; end; if (r>8)and(a^.kolp>1) then begin delPost(((r div 3)-2)); if ((r div 3)-2)=a^.kolp then dec(r,3); dec(a^.kolP); end; end; end; until (key1 in [#77,#75,#27,'+','-'])or(((r-9) div 30)<>l); if (l<((Temp.a^.kolp) div 10))and(((r-9) div 30)>l) then inc(l); if (l>0)and(((r-9) div 30)1 then dec(nItem); end; until key1=#27; end ; Procedure zzz.Save; Begin if FirstItem=nil then exit; cleardevice; setcolor(14); outtextxy(150,100,'Сохранение базы данных в файл'); rectangle(70,150,570,190); outtextxy(80,166,'Введите имя файла:'); sr:=''; sr:=stroka(sr,40,225,166); assign(f,sr); rewrite(f); a:=FirstItem; for j:=1 to kolI do begin write(f,a^.surname); write(f,a^.name); write(f,a^.patronymic); write(f,a^.birthday); write(f,a^.place); write(f,a^.address); write(f,a^.family); str(a^.kolp,sr); write(f,sr); a^.posts:=a^.firstpost; for i:=1 to a^.kolp do begin write(f,a^.posts^.title); write(f,a^.posts^.datein); write(f,a^.posts^.dateout); a^.posts:=a^.posts^.NextP; end; a:=a^.NextI; end; close(f); end; Procedure zzz.DisposeBaza; begin if assigned(firstItem) then begin repeat a:=FirstItem; FirstItem:=a^.NextI; a^.firstpost:=nil; Dispose(a); until FirstItem=nil; end; end; Procedure zzz.Load; begin cleardevice; setcolor(14); outtextxy(150,100,' Загрузка базы данных из файла'); rectangle(70,150,570,190); outtextxy(80,166,'Введите имя файла:'); sr:=''; sr:=stroka(sr,40,225,166); assign(f,sr); reset(f); kolI:=0; DisposeBaza; while not eof(f) do begin if FirstItem=nil then begin new(a); FirstItem:=a; end else begin new(a^.NextI); a:=a^.NextI; end; inc(kolI); read(f,a^.surname); read(f,a^.name); read(f,a^.patronymic); read(f,a^.birthday); read(f,a^.place); read(f,a^.address); read(f,a^.family); read(f,sr); val(sr,a^.kolp,i); for i:=1 to a^.kolp do begin if a^.firstpost=nil then begin new(a^.posts); a^.firstpost:=a^.posts; end else begin new(a^.posts^.Nextp); a^.posts:=a^.posts^.nextp; end; read(f,a^.posts^.title); read(f,a^.posts^.datein); read(f,a^.posts^.dateout); end; a^.posts^.nextp:=nil; end; a^.nexti:=nil; close(f); end; Begin gd:=Vga; gm:=Vgahi; initgraph(gd,gm,''); repeat cleardevice; op:=menu; case op of 1:Temp.prosmotr; 2:Temp.Sozdanie; 3:Temp.Save; 4:begin Temp.Load; Temp.Prosmotr; end; 5:Temp.DisposeBaza; end; until op=5; End.