program phone; uses crt; type precord=^trecord; trecord=record fname,lastname,phone,street:string[30]; house,room:string[5]; next:precord; end; var list,current,tmpcurr:precord; menu:array[1..9] of string; actmenu,rez,allrec,currec:integer; procedure setmenu; begin menu[1]:='Загрузить'; menu[2]:='Сохранить'; menu[3]:='Изменить'; menu[4]:='Добавить'; menu[5]:='Вперед'; menu[6]:='Назад'; menu[7]:='Поиск'; menu[8]:='Постранично'; menu[9]:='Выход'; actmenu:=1; end; procedure printmenu; var n:integer; begin for n:=1 to 9 do begin window (3,2+n,23,2+n); if n=1 then textbackground(4) else textbackground(1); textcolor(15); clrscr; write(' ',menu[n]); end; end; function controlmenu:integer; var key:char; exitcode,move:integer;act:integer; begin exitcode:=0; while exitcode=0 do begin if keypressed then begin; key:=readkey; if key=#13 then exitcode:=actmenu; if key=#0 then begin key:=readkey; {writeln(actmenu);} act:=actmenu; move:=0; if (key='H') and (act>1) then move:=-1; if (key='P') and (act<9) then move:=1; if move<>0 then begin window (3,2+actmenu,23,2+actmenu); textbackground(1); clrscr;write(' ',menu[actmenu]); actmenu:=actmenu+move; window (3,2+actmenu,23,2+actmenu); textbackground(4); clrscr;write(' ',menu[actmenu]); end; end; end; end; controlmenu:=exitcode; end; procedure disposelist; var n:integer; begin current:=list;n:=0; while current^.next<>nil do begin {n:=n+1;write(n);} tmpcurr:=current; current:=current^.next; dispose(tmpcurr); end; dispose(current); {readln;} end; procedure drawrecord(num:integer); var n:integer; begin window (30,3,70,20); textbackground(2); clrscr; window (32,4,70,20); current:=list; n:=0; while (current^.next<>nil) and (n nil do begin n:=n+1; current:=current^.next; {writeln(n);} end; new(current^.next); current:=current^.next; current^.next:=nil; readln; write ('Имя: '); readln(current^.fname); write ('Фамилия: '); readln(current^.lastname); write ('Улица: '); readln(current^.street); write ('Дом: '); readln(current^.house); write ('Квартира: '); readln(current^.room); write ('Телефон: '); readln(current^.phone); window (32,20,70,20); currec:=allrec; end; procedure loadfile; var f:text;n:integer;tmp:string; begin assign(f,'c:\phones2.txt'); reset(f); n:=0; readln(f,allrec); disposelist; new(list); current:=list; for n:=1 to allrec do begin readln(f,tmp);current^.fname:=tmp; readln(f,tmp);current^.lastname:=tmp; readln(f,tmp);current^.street:=tmp; readln(f,tmp);current^.house:=tmp; readln(f,tmp);current^.room:=tmp; readln(f,tmp);current^.phone:=tmp; if n=allrec then current^.next:=nil else begin new(current^.next); current:=current^.next; end; end; end; { procedure editrecord(num:integer); var tmp:string; begin window (30,3,70,20); textbackground(4); clrscr; window (32,4,70,20); write ('Имя: '); window (42,4,62,6); writeln(phones[num].fname); readln(tmp); if tmp>'' then phones[num].fname:=tmp; window (32,5,62,5); write ('Фамилия: '); window (42,5,62,7); writeln(phones[num].lastname); readln(tmp); if tmp>'' then phones[num].lastname:=tmp; window (32,6,62,6); write ('Улица: '); window (42,6,62,8); writeln(phones[num].street); readln(tmp); if tmp>'' then phones[num].street:=tmp; window (32,7,62,7); write ('Дом: '); window (42,7,62,9); writeln(phones[num].house); readln(tmp); if tmp>'' then phones[num].house:=tmp; window (32,8,62,8); write ('Квартира: '); window (42,8,62,10); writeln(phones[num].room); readln(tmp); if tmp>'' then phones[num].room:=tmp; window (32,9,62,9); write ('Телефон: '); window (42,9,62,11); writeln(phones[num].phone); readln(tmp); if tmp>'' then phones[num].phone:=tmp; window (32,11,62,10); end; } procedure savefile; var f:text;n:integer; begin assign(f,'c:\phones2.txt'); rewrite(f); current:=list; writeln(f,allrec); for n:=1 to allrec do begin writeln(f,current^.fname); writeln(f,current^.lastname); writeln(f,current^.street); writeln(f,current^.house); writeln(f,current^.room); writeln(f,current^.phone); current:=current^.next; end; close(f); end; { procedure drawtable(num:integer); var n:integer; begin window (30,3,70,20); textbackground(2); clrscr; window (32,4,70,21); for n:=0 to 4 do begin gotoxy (1,n*3+1); writeln(phones[n+1].fname); gotoxy (1,n*3+2); writeln(phones[n+1].lastname); gotoxy (14,n*3+1); writeln(phones[n+1].street); gotoxy (14,n*3+2); writeln(phones[n+1].house); gotoxy (19,n*3+2); writeln(phones[n+1].room); gotoxy (28,n*3+1); writeln(phones[n+1].phone); end; end; } {procedure search; var n,r:integer;sfm,stn,res:string; begin window (30,3,70,20); textbackground(3); clrscr; window (32,4,70,21); r:=0; res:=''; writeln('Поиск записей'); write('Фамилия: ');readln(sfm); write('Телефон: ');readln(stn); for n:=1 to allrec do if ((pos(sfm,phones[n].lastname)>0) or (sfm='')) and ((pos(stn,phones[n].phone)>0) or (stn='')) then r:=r+1; writeln('Найдено записей: ',r); writeln('Сейчас наснется их просмотр!'); n:=0; while (res='') and (n0) or (sfm='')) and ((pos(stn,phones[n].phone)>0) or (stn='')) then begin drawrecord(n); write(' Продолжить?'); readln(res); end; end; Write('Поиск завершен.'); end; } begin new(list); current:=list; list^.next:=nil; list^.fname:='First'; list^.lastname:='Record'; list^.phone:='00-00-00'; list^.street:=''; list^.house:=''; list^.room:=''; allrec:=1; currec:=1; textbackground(0); clrscr; setmenu; printmenu; drawrecord(0); repeat rez:=controlmenu; if rez=1 then begin loadfile; currec:=1; drawrecord(1); end; if rez=2 then begin savefile; end;{ if rez=3 then begin editrecord(currec); drawrecord(currec); end; } if rez=4 then begin addrecord;drawrecord(allrec); end; if (rez=5) and (currec1) then begin currec:=currec-1; drawrecord(currec); end; {if (rez=7) then search; if rez=8 then drawtable(1);} until rez=9; disposelist; end.