Версия для печати темы

uses crt;
label l1;
const
menu:array[1..5] of string=('Найти номер телефона', {Массив описывающий меню}
                            'Найти фамилию по номеру',
                            'Найти дни рождения',
                            'Сведения об авторе',
                            'ESC - Exit.');

autor:array[1..5] of string[50]=('Курсовая работа по программированию.',
                                 'База Данных "Записная Книжка"',
                                 'Выполнила: Гельдт Анна',     {Заставка}
                                 'Группа: В-123',
                                 'Нажмите любую клавишу для продолжения...');
VAR
 y:byte;
 klav:char;
{============================= Выводит меню =================================}
Procedure DisplayMenu;
var
 i1:Byte;
 begin
  clrscr;
  for i1:=1 to 5 do
   begin
    gotoXY (20,i1*2);
    write (menu[i1]);
   end;
 end;
{=========================== Выводит сведения об авторе =====================}
procedure DisplayAutor;
var
 i2:byte;
 begin
  textcolor(0);
  DisplayMenu;
  textcolor(11);
  for i2:=1 to 5 do
   begin
    gotoxy(trunc((80-length(autor[i2]))/2),i2*3);
    write(autor[i2]);
   end;
 end;
{============================================================================}
Procedure Search(param:String); {Читает записи из файла и осуществляет поиск}
type
 Man=record
       SurName:String[16];
       Name:String[16];
       Otchestvo:String[16];
       Born:String[8];
       Phone:LongInt;
     end;
Var
 f:text;
 i3,tmp,p,q,c,i,j,n,q1,q2:Integer;
 tstr:String;
 tLong:LongInt;
 People:array[1..20] of Man;          {Массив записей книжки}
 Borned,Dates:array[1..20] of byte;   {Массив индексов найденных записей}
Begin
 Assign(f,'c:\ttp\zbook.dat'); Reset(f);             {Открываем файл для чтения}
 CLRSCR; i3:=0;
 While NOT EOF(f) do           {Считываем в цикле содержимое файла zbook.dat}
    Begin
     i3:=i3+1;
     Readln(f,tstr);        {Берем из файла строку и режем на части}
     People[i3].SurName:=Copy(tstr,1,pos(' ',tstr)-1);
     Delete(tstr,1,pos(' ',tstr));
     People[i3].Name:=Copy(tstr,1,pos(' ',tstr)-1);
     Delete(tstr,1,pos(' ',tstr));
     People[i3].Otchestvo:=Copy(tstr,1,pos(' ',tstr)-1);
     Delete(tstr,1,pos(' ',tstr));
     People[i3].Born:=Copy(tstr,1,pos(' ',tstr)-1);
     Delete(tstr,1,pos(' ',tstr));
     val(tstr,People[i3].Phone,tmp);
    End;
 Close(f); tmp:=0; c:=0;

 if param='SurName' then               {Проверяем какой был передан параметр}
    Begin                             {и ищем записи по нужному полю}
     Write('Введите номер телефона (??????) ');
     Readln(tLong);
     for p:=1 to i3 do If People[p].Phone=tLong Then
      Begin
       Write(People[p].SurName,' ');
       Write(People[p].Name,' ');
       Write(People[p].Otchestvo,' ');
       exit;
      End;
     If p=i3 Then Writeln('Ничего не найдено!');
    End;

 if param='Number' then
    Begin
     Write('Введите фамилию ');
     Readln(tstr);
     for p:=1 to i3 do If People[p].SurName=tstr Then
      Begin
       If People[p].Phone<>0
        Then Writeln(People[p].Phone)
        Else Writeln('Нет телефона!');
       exit;
      End;
     If p=i3 Then Writeln('Ничего не найдено!');
    End;

 if param='Borned' then
    Begin
     Write('Введите номер месяца ');
     Readln(tLong);
     for p:=1 to i3 do
      Begin
       val(copy(People[p].Born,4,2),q,tmp);
       If q=tLong Then
        Begin
         c:=c+1;
         Borned[c]:=p;
        End;
      End;
     Writeln('Найдено дней рождений ',c);
     Writeln;
                             {Сортируем по возрастанию дни рождения}
 for i:=1 to c do val(copy(People[Borned[i]].Born,1,2),Dates[i],tmp);
 for i:=1 to c-1 do
 for j:=i+1 to c do
  begin
   if Dates[i]<Dates[j] then
    begin
     n:=Borned[i];
     Borned[i]:=Borned[j];
     Borned[j]:=n;
    end;
  end;
     for p:=1 to c do
      Begin              {Выводим результаты поиска}
       write(People[Borned[p]].Born,' ');
       write(People[Borned[p]].SurName,' ');
       write(People[Borned[p]].Name,' ');
       write(People[Borned[p]].Otchestvo,' ');
       Writeln;
      End;
    End;
End;
{==================================Основная программа========================}
BEGIN
 DisplayAutor;ReadKey;    {Выводим заставку}
 l1:
 y:=1;
 textcolor(15);
 DisplayMenu;           {Выводим меню}
 repeat
  textcolor(10);                       {Опрашиваем в цикле нажатия клавишей}
  gotoxy (13,y*2); write(chr(16));
  klav:=readkey;
  gotoxy (13,y*2); write(' ');
  if ord(klav)=97 then if y > 1 then y:=y-1 else y:= 5;
  if ord(klav)=122 then if y < 5 then y:=y+1 else y:= 1;
  if ord(klav)=27 then begin y:=5; klav:=Chr(13) end;
  if (ord(klav)=13) and (y<6) then
   begin                           {выполняем нужное действие}
    case y of                   {в зависимости от выбранного пункта меню}
     1:begin Search('Number');  readkey; goto l1 end;
     2:begin Search('SurName'); readkey; goto l1 end;
     3:begin Search('Borned');  readkey; goto l1 end;
     4:begin DisplayAutor;      readkey; goto l1 end;
     5:exit;
    end;
   end;
 until (ord(klav)=13) and (y=5);
END.

uses crt;
label l1;
const
menu:array[1..7] of string=('Найти номер телефона', {Массив описывающий меню}
                           'Найти фамилию по номеру',
                           'Найти дни рождения',
                           'Сведения об авторе',
                           'DispTabl.',
                           'Добавить юзера',
                           'ESC - Exit.');

autor:array[1..5] of string[50]=('Курсовая работа по программированию.',
                                'База Данных "Записная Книжка"',
                                'Выполнила: Гельдт Анна',     {Заставка}
                                'Группа: В-123',
                                'Нажмите любую клавишу для продолжения...');
VAR
y:byte;
klav:char;
{============================= Выводит меню =================================}
Procedure DisplayMenu;
var
i1:Byte;
begin
 clrscr;
 for i1:=1 to 7 do
  begin
   gotoXY (20,i1*2);
   write (menu[i1]);
  end;
end;
{=========================== Выводит сведения об авторе =====================}
procedure DisplayAutor;
var
i2:byte;
begin
 textcolor(0);
 DisplayMenu;
 textcolor(11);
 for i2:=1 to 5 do
  begin
   gotoxy(trunc((80-length(autor[i2]))/2),i2*3);
   write(autor[i2]);
  end;
end;
{============================================================================}
Procedure Search(param:String); {Читает записи из файла и осуществляет поиск}
type
Man=record
      SurName:String[16];
      Name:String[16];
      Otchestvo:String[16];
      Born:String[8];
      Phone:LongInt;
    end;
Var
f:text;
i3,tmp,p,q,c,i,j,n,q1,q2:Integer;
tstr:String;
tLong:LongInt;
People:array[1..20] of Man;          {Массив записей книжки}
Borned,Dates:array[1..20] of byte;   {Массив индексов найденных записей}
Begin
Assign(f,'zbook.dat'); Reset(f);             {Открываем файл для чтения}
CLRSCR; i3:=0;
While NOT EOF(f) do           {Считываем в цикле содержимое файла zbook.dat}
   Begin
    i3:=i3+1;
    Readln(f,tstr);        {Берем из файла строку и режем на части}
    People[i3].SurName:=Copy(tstr,1,pos(' ',tstr)-1);
    Delete(tstr,1,pos(' ',tstr));
    People[i3].Name:=Copy(tstr,1,pos(' ',tstr)-1);
    Delete(tstr,1,pos(' ',tstr));
    People[i3].Otchestvo:=Copy(tstr,1,pos(' ',tstr)-1);
    Delete(tstr,1,pos(' ',tstr));
    People[i3].Born:=Copy(tstr,1,pos(' ',tstr)-1);
    Delete(tstr,1,pos(' ',tstr));
    val(tstr,People[i3].Phone,tmp);
   End;
Close(f); tmp:=0; c:=0;

if param='SurName' then               {Проверяем какой был передан параметр}
   Begin                             {и ищем записи по нужному полю}
    Write('Введите номер телефона (??????) ');
    Readln(tLong);
    for p:=1 to i3 do If People[p].Phone=tLong Then
     Begin
      Write(People[p].SurName,' ');
      Write(People[p].Name,' ');
      Write(People[p].Otchestvo,' ');
      exit;
     End;
    If p=i3 Then Writeln('Ничего не найдено!');
   End;

if param='Number' then
   Begin
    Write('Введите фамилию ');
    Readln(tstr);
    for p:=1 to i3 do If People[p].SurName=tstr Then
     Begin
      If People[p].Phone<>0
       Then Writeln(People[p].Phone)
       Else Writeln('Нет телефона!');
      exit;
     End;
    If p=i3 Then Writeln('Ничего не найдено!');
   End;

if param='Borned' then
   Begin
    Write('Введите номер месяца ');
    Readln(tLong);
    for p:=1 to i3 do
     Begin
      val(copy(People[p].Born,4,2),q,tmp);
      If q=tLong Then
       Begin
        c:=c+1;
        Borned[c]:=p;
       End;
     End;
    Writeln('Найдено дней рождений ',c);
    Writeln;
                            {Сортируем по возрастанию дни рождения}
for i:=1 to c do val(copy(People[Borned[i]].Born,1,2),Dates[i],tmp);
for i:=1 to c-1 do
for j:=i+1 to c do
 begin
  if Dates[i]<Dates[j] then
   begin
    n:=Borned[i];
    Borned[i]:=Borned[j];
    Borned[j]:=n;
   end;
 end;
    for p:=1 to c do
     Begin              {Выводим результаты поиска}
      write(People[Borned[p]].Born,' ');
      write(People[Borned[p]].SurName,' ');
      write(People[Borned[p]].Name,' ');
      write(People[Borned[p]].Otchestvo,' ');
      Writeln;
     End;
   End;
if param='DispTabl' then               {Проверяем какой был передан параметр}
   Begin                             {и ищем записи по нужному полю}
    Writeln('ФИО':10,'День рождения ':35,'Телефон':20);
    writeln;
    for p:=1 to i3 do
     Begin
      Write(People[p].SurName,' ');
      Write(People[p].Name,' ');
      Write(People[p].Otchestvo,' ':30-ord(People[p].Otchestvo[0])-ord(People[p].name[0])-ord(People[p].surname[0]));
      Write(People[p].Born,' ':30);
      Write(People[p].Phone,' ');
      writeln;
     End;
if param='DispTablSortSurname' then               {Проверяем какой был передан параметр}
   Begin                             {и ищем записи по нужному полю}
    Writeln('ФИО':10,'День рождения ':35,'Телефон':20);
    writeln;

    for p:=1 to i3 do
     Begin
      Write(People[p].SurName,' ');
      Write(People[p].Name,' ');
      Write(People[p].Otchestvo,' ':30-ord(People[p].Otchestvo[0])-ord(People[p].name[0])-ord(People[p].surname[0]));
      Write(People[p].Born,' ':10);
      Write(People[p].Phone,' ');
      writeln;
     End;
   End;
   End;
End;

procedure AddUser;
var
      SurName:String[16];
      Name:String[16];
      Otchestvo:String[16];
      Born:String[8];
      Phone:LongInt;
      f:text;
 Begin
 clrscr;
Assign(f,'zbook.dat'); Append(f);             {Открываем файл для чтения}
writeln('Введите фамилию');
readln(SurName);
write(f,SurName,' ');
writeln('Введите имя');
readln(Name);
write(f,Name,' ');
writeln('Введите Отчество');
readln(Otchestvo);
write(f,Otchestvo,' ');
writeln('Введите дату рождения');
readln(born);
write(f,born,' ');
writeln('Введите телефон');
readln(phone);
writeln(f,phone);
close(f);
end;
{==================================Основная программа========================}
BEGIN
DisplayAutor;ReadKey;    {Выводим заставку}
l1:
y:=1;
textcolor(15);
DisplayMenu;           {Выводим меню}
repeat
 textcolor(10);                       {Опрашиваем в цикле нажатия клавишей}
 gotoxy (13,y*2); write(chr(16));
 klav:=readkey;
 gotoxy (13,y*2); write(' ');
 if ord(klav)=97 then if y > 1 then y:=y-1 else y:= 7;
 if ord(klav)=122 then if y < 7 then y:=y+1 else y:= 1;
 if ord(klav)=27 then begin y:=7; klav:=Chr(13) end;
 if (ord(klav)=13) and (y<8) then
  begin                           {выполняем нужное действие}
   case y of                   {в зависимости от выбранного пункта меню}
    1:begin Search('Number');  readkey; goto l1 end;
    2:begin Search('SurName'); readkey; goto l1 end;
    3:begin Search('Borned');  readkey; goto l1 end;
    4:begin DisplayAutor;      readkey; goto l1 end;
    5:begin Search('DispTabl');      readkey; goto l1 end;
    6:begin AddUser;      readkey; goto l1 end;
    7:exit;
   end;
  end;
until (ord(klav)=13) and (y=5);
END.