{ Создать файл, содержащий сведения о работниках фирмы: фамилия, домашний адрес: улица, дом, квартира, дата рождения: день, месяц, год, дата приема на работу: день, месяц, год, табельный номер. Написать программу, которая выдает список сотрудников, принятых на работу в текущем году, отсортированный по дате рождения, определяет, есть ли сотрудники, живущие на одной улице } program tip_file29; uses Crt; const NVCol=10; { цвет невыделенного пункта } VCol=18; { цвет невыделенного пункта } n=5; { кол-во пунктов } TYPE t_sv=RECORD fam, yl, dom, kv:string; { записи о работниках } rd, rm, rg, pd, pm, tabn, pg:string; END; t_F = File of t_sv; var menu:array[1..N] of string[22]; punkt:integer; { номер выделенного пункта } Ch:char; x, y, j, s:integer; fam, yl, dom, kv, otvet, name, loadf, str:string; rd, rm, rg, pd, pm, pg, tabn:string; i, i1, ih:byte; { номер строки } var sv: array[1..8] of t_sv; sv1: array[1..8] of t_sv; f:t_f; r:t_sv; {*******************************************************************} Procedure create; { создание файла } begin Write ('Хотите создать новый файл (y/n): '); Readln(otvet); If (otvet='y')or(otvet='Y')or(otvet='Н')or(otvet='н') then begin Write ('Введите название нового файла: '); Readln(name); Assign (f,'name'); j:=1; end; Assign (f,name); If (otvet='n')or(otvet='N')or(otvet='т')or(otvet='Т') then begin assign(f, 'temp'); Rewrite (F); j:=1; End; {$I-} Reset (F); If ioresult <>0 then Rewrite (F); j:=1; {$I+} Close (F); ClrScr; End; {*******************************************************************} Procedure Vvod; { ввод данных } begin ClrScr; reset(f); Repeat writeln(' Ввод сведений о работнике #',j); write(' Фамилия '); Readln(sv[i].fam); writeln('Домашний адрес'); write(' улица '); Readln(sv[i].yl); write(' дом '); Readln(sv[i].dom); write(' квартира '); Readln(sv[i].kv); writeln('Дата рождения'); write(' день '); Readln(sv[i].rd); write(' месяц '); Readln(sv[i].rm); write(' год '); Readln(sv[i].rg); writeln('Дата приема на работу'); write(' день '); Readln(sv[i].pd); write(' месяц '); Readln(sv[i].pm); write(' год '); Readln(sv[i].pg); write(' Табельный номер '); Readln(sv[i].tabn); writeln; write('Хотите доавить сведения о новом работнике? (y/n) '); Readln(otvet); Inc(j); Write(f,sv[i]); Inc(i); ClrScr; Until (otvet='n') or (otvet='N') or (otvet='т') or (otvet='Т'); Seek(f,FileSize(f)); Close(f); end; {*******************************************************************} Procedure punkt2; { вывод списка работников } begin ClrScr; s:=5; reset(f); write('Список работников'); Textcolor(5); writeln(' Всего работников: ',j-1); Textcolor(3); WriteLn(' │ Домашний адрес ',' │Дата рождения',' │ Дата приема │'); textcolor(10); WriteLn(' Фамилия ','│улица │дом │кв. ','│день│мес.│год ',' │день│мес.│год ','│Табел. номер'); i:=0; repeat gotoxy(1,s); Write(sv[i].fam:2,sv[i].yl:13,sv[i].dom:13,sv[i].kv:5,sv[i].rd:5,sv[i].rm:5,sv[i].rg:5,sv[i].pd:6,sv[i].pm:5); Write(sv[i].pg:5,sv[i].tabn:5); i:=i+1; s:=s+1; until i>j; readln; close(f); end; {*******************************************************************} Procedure MenuToScr; { вывод меню на экран } var i:integer; begin ClrScr; for i:=1 to N do begin GoToXY(x,y+i-1); write(menu[i]); end; TextAttr:=VCol; GoToXY(x,y+punkt-1); write(menu[punkt]); TextAttr:=NVCol; end; {*******************************************************************} Procedure god; { вывод списка работников принятых в текущем году } Begin ClrScr; s:=5; reset(f); write('Список работников'); Textcolor(5); writeln(' Всего работников: ',j-1); Textcolor(3); WriteLn(' │ Домашний адрес ',' │Дата рождения',' │ Дата приема │'); textcolor(10); WriteLn(' Фамилия ','│улица │дом │кв. ','│день│мес.│год ',' │день│мес.│год ','│Табел. номер'); i:=0; For i:=0 to j do begin If sv[i].pg='2004' then begin Write(sv[i].fam:2,sv[i].yl:13,sv[i].dom:13,sv[i].kv:5,sv[i].rd:5,sv[i].rm:5,sv[i].rg:5,sv[i].pd:6); Write(sv[i].pm:5,sv[i].pg:5,sv[i].tabn:5); s:=s+1; gotoxy(1,s); end; end; Close(f); Writeln; Write('Хотите сортировать список (y/n)?'); Readln(otvet); If (otvet='y')or(otvet='Y')or(otvet='Н')or(otvet='н') then begin Clrscr; write('Список работников'); Textcolor(5); writeln(' Всего работников: ',j-1); Textcolor(3); WriteLn(' │ Домашний адрес ',' │Дата рождения',' │ Дата приема │'); textcolor(10); WriteLn(' Фамилия ','│улица │дом │кв. ','│день│мес.│год ',' │день│мес.│год ','│Табел. номер'); { начало сортировки } { i1:=0; s:=5; For i:=0 to j do begin if sv[i].rg>sv1[i1].rg then begin sv1[i1].rg:=sv[i].rg; i1:=i1+1; i:=i+1; end; end;} { конец сортировки } Readkey; end; end; {*******************************************************************} Procedure street; { вывод списка работников живущих на одной улице } Begin ClrScr; s:=5; reset(f); write('Список работников'); Textcolor(5); writeln(' Всего работников: ',j-1); Textcolor(3); WriteLn(' │ Домашний адрес ',' │Дата рождения',' │ Дата приема │'); textcolor(10); WriteLn(' Фамилия ','│улица │дом │кв. ','│день│мес.│год ',' │день│мес.│год ','│Табел. номер'); i:=0; For i:=0 to j do begin str:=sv[i].yl; ih:=i; for i1:=0 to j-1 do begin if (str=sv[i1].yl) and (ih<>i1) then begin Write(sv[i].fam:2,sv[i].yl:13,sv[i].dom:13,sv[i].kv:5,sv[i].rd:5,sv[i].rm:5,sv[i].rg:5,sv[i].pd:6); Writeln(sv[i].pm:5,sv[i].pg:5,sv[i].tabn:5); Write(sv[i1].fam:2,sv[i1].yl:13,sv[i1].dom:13,sv[i1].kv:5,sv[i1].rd:5,sv[i1].rm:5,sv[i1].rg:5,sv[i1].pd:6); Writeln(sv[i1].pm:5,sv[i1].pg:5,sv[i1].tabn:5); s:=s+1; gotoxy(1,s); End; end; end; Readkey; End; {0000000000000000000000000000000000000000000000000000000000000000000} begin textcolor(10); Clrscr; Create; menu[1]:=' Добавить работника '; menu[2]:=' Просмотр списка '; menu[3]:=' Принятые в этом году '; menu[4]:=' Одна улица '; menu[5]:=' Выход '; punkt:=1; x:=5; y:=5; TextAttr:=NVCol; MenuToScr; repeat ch:=ReadKey; if ch=char(0) then begin ch:=ReadKey; case ch of chr(80):{ стрелка вниз } if punkt1 then begin GoToXY(x,y+punkt-1); write(menu[punkt]); punkt:=punkt-1; TextAttr:=VCol; GoToXY(x,y+punkt-1); write(menu[punkt]); TextAttr:=NVCol; end; end; end else if ch=chr(13) then begin case punkt of 1:Vvod; 2:punkt2; 3:god; 4:street; 5:ch:=chr(27); end; MenuToScr; end; MenuToScr; until ch=chr(27); end.