USES CRT,Printer, Dos; Type TZ=record CodeOTD:string; CodeLab:string; Tabnomr:string; Data:string; CodeNach:string; SymmNach:string; End; HZ=record CODEOTDELA:string; TAB:string; End; TZ2=record TabNom:string; FIOsotr:string; SP:string; Deti:string; End; VD1=record Cod_OTDELA:string; Nazva_otdela:string; Code_lab:string; Tab_nom:string; FIO_sotr:string; Nachisleno:string; End; VD2=record Cod_OTDELA:string; FIO_zava:string; telefnchik:string; kol_vo_sotr:string; End; masiv= array[1..100] of VD2; tmasiv= ^masiv; mas=array[1..100] of TZ; tmas=^mas; vmas=array[1..100] of VD1; tvmas=^vmas; hmas=array[1..100] of HZ; thmas=^hmas; VAR spravochnik1:text; Zap2:TZ2; spravochnik2: file of TZ2; Zap_ved2: VD2; vedomost2: file of VD2; Zap_ved1: VD1; vedomost1: file of VD1; Zap:TZ; osnov: file of TZ; helpzap:HZ; procedure sortirovkaVED2; Var t,k,j,i:integer; z:tmasiv; c:VD2; Begin assign(vedomost2,'vedomost2'); reset(vedomost2); t:=filesize(vedomost2); getmem(z,t*sizeof(Zap_ved2)); k:=0; while not(eof(vedomost2)) do begin read(vedomost2,Zap_ved2); inc(k); z^[k]:=Zap_ved2; end; close(vedomost2); For j:=1 to k-1 do For i:=1 to k-j do if z^[i].Cod_OTDELA > z^[i+1].Cod_OTDELA then begin c:=z^[i]; z^[i]:=z^[i+1]; z^[i+1]:=c; end; rewrite(vedomost2); For i:=1 to t do write(vedomost2,z^[i]); close(vedomost2); freemem(z,t*sizeof(Zap_ved2)); End; procedure Shapka1; Var a,b,c,d:word; Begin clrscr; GetDate(a,b,c,d); writeln;writeln; writeln(' Ведомость № 1 ВЕДОМОСТЬ НАЧИСЛЕНИЯ Дата: ',c,'.',b,'.',a,''); writeln('--------------------------------------------------------------------------------'); writeln('№':3,' Код Название Код Таб. ФИО Начислено'); writeln(' Отдела отдела Лаб. Номер Сотрудника '); writeln('--------------------------------------------------------------------------------'); end; procedure Shapka2; Begin clrscr; writeln;writeln; writeln(' Ведомость № 2 ВЕДОМОСТЬ ПО КОЛИЧЕСТВУ СОТРУДНИКОВ '); writeln('-------------------------------------------------------------------------------'); writeln('№':3,' Код ФИО Телефон Количество'); writeln(' Отдела зав.отделом сотрудников '); writeln('-------------------------------------------------------------------------------'); end; procedure vedomost1_sozdanie; VAR i,w,k,j,t:integer; s1,s2,s3,s4,s,q:string; z:tvmas; Begin assign(vedomost1,'vedomost1'); assign(spravochnik1,'spravka1.txt'); assign(osnov,'osnov'); assign(spravochnik2,'spravka2'); rewrite(vedomost1); reset(osnov); with Zap_ved1 do While not(eof(osnov)) do begin with Zap do begin read(osnov,Zap); Cod_OTDELA:=CodeOTD; Nazva_otdela:=''; Code_lab:=CodeLab; Tab_nom:=Tabnomr; FIO_sotr:=''; Nachisleno:=SymmNach; write(vedomost1,Zap_ved1); end; end; close(osnov); close(vedomost1); reset(vedomost1); t:=filesize(vedomost1); getmem(z,t*sizeof(Zap_ved1)); k:=0; while not(eof(vedomost1)) do begin read(vedomost1,Zap_ved1); inc(k); z^[k]:=Zap_ved1; end; close(vedomost1); reset(spravochnik1); While not(eof(spravochnik1)) do begin readln(spravochnik1,s1); readln(spravochnik1,s2); readln(spravochnik1,s3); readln(spravochnik1,s4); For j:=1 to k do IF z^[j].Cod_OTDELA=s1 then z^[j].Nazva_otdela:=s2; end; rewrite(vedomost1); For i:=1 to t do write(vedomost1,z^[i]); close(vedomost1); close(spravochnik1); freemem(z,t*sizeof(Zap_ved1)); reset(vedomost1); t:=filesize(vedomost1); getmem(z,t*sizeof(Zap_ved1)); k:=0; while not(eof(vedomost1)) do begin read(vedomost1,Zap_ved1); inc(k); z^[k]:=Zap_ved1; end; close(vedomost1); reset(spravochnik2); While not(eof(spravochnik2)) do begin With Zap2 do begin read(spravochnik2,Zap2); For j:=1 to k do IF z^[j].Tab_nom=Zap2.TabNom then z^[j].FIO_sotr:=FIOsotr; end; end; rewrite(vedomost1); For i:=1 to t do write(vedomost1,z^[i]); close(vedomost1); close(spravochnik2); freemem(z,t*sizeof(Zap_ved1)); End; procedure sortirovka; Var t,k,j,i:integer; z:tmas; c:TZ; Begin assign(osnov,'osnov'); reset(osnov); t:=filesize(osnov); getmem(z,t*sizeof(Zap)); k:=0; while not(eof(osnov)) do begin read(osnov,Zap); inc(k); z^[k]:=zap; end; close(osnov); For j:=1 to k-1 do For i:=1 to k-j do if z^[i].Tabnomr > z^[i+1].Tabnomr then begin c:=z^[i]; z^[i]:=z^[i+1]; z^[i+1]:=c; end; rewrite(osnov); For i:=1 to t do write(osnov,z^[i]); close(osnov); For j:=1 to k-1 do For i:=1 to k-j do if z^[i].CodeLab > z^[i+1].CodeLab then begin c:=z^[i]; z^[i]:=z^[i+1]; z^[i+1]:=c; end; rewrite(osnov); For i:=1 to t do write(osnov,z^[i]); close(osnov); For j:=1 to k-1 do For i:=1 to k-j do if z^[i].CodeOTD > z^[i+1].CodeOTD then begin c:=z^[i]; z^[i]:=z^[i+1]; z^[i+1]:=c; end; rewrite(osnov); For i:=1 to t do write(osnov,z^[i]); close(osnov); reset(osnov); End; procedure sortirovkaosnovpo3_1; Var t,k,j,i:integer; z:tmas; c:TZ; Begin assign(osnov,'osnov'); reset(osnov); t:=filesize(osnov); getmem(z,t*sizeof(Zap)); k:=0; while not(eof(osnov)) do begin read(osnov,Zap); inc(k); z^[k]:=zap; end; close(osnov); For j:=1 to k-1 do For i:=1 to k-j do if z^[i].Tabnomr > z^[i+1].Tabnomr then begin c:=z^[i]; z^[i]:=z^[i+1]; z^[i+1]:=c; end; rewrite(osnov); For i:=1 to t do write(osnov,z^[i]); close(osnov); For j:=1 to k-1 do For i:=1 to k-j do if z^[i].CodeOTD > z^[i+1].CodeOTD then begin c:=z^[i]; z^[i]:=z^[i+1]; z^[i+1]:=c; end; rewrite(osnov); For i:=1 to t do write(osnov,z^[i]); close(osnov); reset(osnov); freemem(z,t*sizeof(Zap)); End; procedure vedomost2_sozdanie; VAR i,w,k,j,t,p,n:integer; s1,s2,s3,s4,s,q:string; z:tmas; x:thmas; l:tmasiv; Begin w:=0; q:='0'; i:=0; assign(spravochnik1,'spravka1.txt'); assign(vedomost2,'vedomost2'); reset(spravochnik1); while not(eof(spravochnik1)) do begin inc(w); readln(spravochnik1,s); end; rewrite(vedomost2); reset(spravochnik1); with Zap_ved2 do While not(eof(spravochnik1)) do begin readln(spravochnik1,s1); readln(spravochnik1,s2); readln(spravochnik1,s3); readln(spravochnik1,s4); Cod_OTDELA:=s1; FIO_zava:=s3; telefnchik:=s4; kol_vo_sotr:=q; write(vedomost2,Zap_ved2); end; close(spravochnik1); close(vedomost2); sortirovkaVED2; sortirovkaosnovpo3_1; t:=filesize(osnov); getmem(z,t*sizeof(Zap)); getmem(x,t*sizeof(HZ)); k:=0; while not(eof(osnov)) do begin read(osnov,Zap); inc(k); z^[k]:=zap; end; close(osnov); k:=0; reset(osnov); while not(eof(osnov)) do begin read(osnov,Zap); inc(k); x^[k]:=helpzap; end; close(osnov); p:=1; For i:=1 to t do begin IF z^[i].CodeOTD <> z^[i+1].CodeOTD then begin x^[i].CODEOTDELA:=z^[i].CodeOTD; str(p,x^[i].TAB); p:=1; end Else begin IF z^[i+1].Tabnomr<>z^[i].Tabnomr then inc(p); end; end; freemem(z,t*sizeof(Zap)); reset(vedomost2); j:=filesize(vedomost2); getmem(l,j*sizeof(Zap_ved2)); k:=0; while not(eof(vedomost2)) do begin read(vedomost2,Zap_ved2); inc(k); l^[k]:=Zap_ved2; end; close(vedomost2); For i:=1 to j do FOR n:=1 to t do IF l^[i].Cod_OTDELA=x^[j].CODEOTDELA then l^[i].kol_vo_sotr:=x^[j].TAB; rewrite(vedomost2); For i:=1 to j do write(vedomost2,l^[i]); close(vedomost2); freemem(l,j*sizeof(Zap_ved2)); freemem(x,t*sizeof(HZ)); sortirovka; End; procedure vivod1; VAR i:integer; a,b,c:integer; Begin clrscr; Shapka1; assign(vedomost1,'vedomost1'); reset(vedomost1); i:=0; c:=0; repeat read(vedomost1,Zap_ved1); with Zap_ved1 do begin inc(i); write(i:3); writeln(Cod_OTDELA:6,Nazva_otdela:14,Code_lab:6,Tab_nom:6,FIO_sotr:33,Nachisleno:10); end; until eof(vedomost1); close(vedomost1); readkey; End; procedure vivod2; VAR i:integer; a,b,c:integer; Begin clrscr; Shapka2; assign(vedomost2,'vedomost2'); reset(vedomost2); i:=0; c:=0; repeat read(vedomost2,Zap_ved2); with Zap_ved2 do begin inc(i); write(i:3); writeln(Cod_OTDELA:8,FIO_zava:35,telefnchik:17,kol_vo_sotr:12); Val(Zap_ved2.kol_vo_sotr,a,b); c:=c+a; end; until eof(vedomost2); close(vedomost2); writeln; write('Общий итог: ':73); write(c); readkey; End; { procedure vivodilka; var k,curr_pos,n,p:integer; refresh:boolean; Begin assign(osnov,'osnov'); reset(osnov); curr_pos:= 0; refresh:=true; while not eof(osnov) do begin read(osnov,Zap); inc(n); end; repeat if refresh then begin reset(osnov); k:=1; vivodShapki; p:=0; repeat read (osnov,Zap); If k in [curr_pos+1..curr_pos+10] then with Zap do begin inc(p); write(curr_pos+p:3); writeln(CodeOTD:9,CodeLab:12,Tabnomr:15,Data:11,CodeNach:11,SymmNach:14); end; inc(k); until (eof(osnov)); refresh:=false; end; case ord(readkey) of 80:if (curr_pos+10 < n) and ((eof(osnov))) then begin inc(curr_pos,10); refresh:=true; end; 72:if curr_pos-10>=0 then begin dec(curr_pos, 10); refresh:=true; end; 13:break; end; until false; close(osnov); End; } procedure formerovanie_vedomoste; Begin clrscr; vedomost1_sozdanie; vedomost2_sozdanie; writeln('Ведомости сформированы'); readkey; End; procedure podmenu3; VAR F:integer; ch:char; begin repeat F:=0; clrscr; writeln(' Формирование ведомостей: '); writeln('1 -> Вывод ведомостей в файл'); writeln('2 -> Просмотр 1й ведомости на экране'); writeln('3 -> Просмотр 2й ведомости на экране'); writeln('4 -> Вывод ведомостей на печать'); writeln('5 -> Возврат в главное меню'); repeat ch:=readkey; IF not(ch in ['1'..'5']) then begin writeln('неверная клавиша!'); F:=F+1; if F=4 then begin writeln('программа завершена из-за неправильного ввода данных'); writeln('нажмите любую кнопку для выхода'); readkey; end else if F=3 then begin writeln('у вас ещё ', 4-F,' попытка'); writeln('выберите существующий пункт подменю'); end else begin writeln('у вас ещё ', 4-F,' попытки'); writeln('выберите существующий пункт подменю'); end; end; until (ch in ['1'..'5']) or (F=4); case ch of '1': formerovanie_vedomoste; '2': vivod1; '3': vivod2; '4': ; end; until (F=4) or (ch='5'); end; Begin podmenu3; End.