БД спортиков ;)

uses
  crt, sysutils;

const
  DB_NAME = 'Ulyana.dat';// Имя файла БД

type
  content = record
    surname: string[16];// Фамилия
    name: string[16];//Имя
    patronymic: string[16];//Отчество
    year: string[4];//Год рождения
    month: string[2];//Месяц рождения
    day: string[2];//День рождения
  end;

  TData = array of content;// Опишем тип содержимого
  TFile = file of content;// Опишем тип файла

var
  data: TData;
  id: integer;
  key: char;

procedure PrintLine;// Просто линия ;)
begin
  TextColor(White);
  Write('--------------------------------------------------------------------------------');
end;

procedure PrintHeader(st_1: string; st_2: string);// Процедура вывода загловка
begin
  PrintLine;
  TextColor(Yellow);GotoXY((80 - Length(st_1)) div 2, WhereY);WriteLn(st_1);
  TextColor(Green);GotoXY((80 - Length(st_2)) div 2, WhereY);WriteLn(st_2);
  PrintLine;
end;

procedure MainMenu;// Процедура вывода основного меню программы
const
  menu: array [0..8] of string = ('Добавить запись', 'Удалить запись', 'Изменить запись',
                                  'Просмотр информации базы данных',
                                  'Сохранить информацию в файл ' + DB_NAME,
                                  'Загрузить информацию из файла ' + DB_NAME,
                                  'Поиск информации', 'Об авторе', 'Выход');

var
  i: byte;

begin
  clrscr;
  PrintHeader('ОСНОВНОЕ МЕНЮ ПРОГРАММЫ', 'Управление: для выбора нужного действия используйте клавиши (0-8)');
  for i := Low(menu) to High(menu) - 1 do
  begin
    TextColor(Yellow);Write(' { ', Succ(i), ' } ');TextColor(Cyan);Writeln(menu[i]);PrintLine;
  end;
  TextColor(Yellow);Write(' { 0 } ');TextColor(Cyan);Writeln(menu[High(menu)]);PrintLine;
end;

procedure Return;// Функция возврата к основному меню
var
  key: char;

begin
  PrintLine;
  GotoXY(15, WhereY);TextColor(Yellow);Writeln('Для возврата в главное меню нажмите клавишу "Enter"');
  PrintLine;
  repeat
    key := ReadKey;
  until (key = #13);
  MainMenu; // Основное меню программы
end;

procedure SeachMenu;// Процедура вывода меню поиска
const
  menu: array [0..6] of string = ('Поиск по фамилии', 'Поиск по имени', 'Поиск по отчеству',
                                  'Поиск по первой букве фамилии', 'Поиск по первой букве имени',
                                  'Поиск по первой букве отчества', 'Вернуться в главное меню');
var
  i: byte;
begin
  clrscr;
  PrintHeader('МЕНЮ ПОИСКА', 'Управление: для выбора нужного действия используйте клавиши (0-6)');
  for i := Low(menu) to High(menu) - 1 do
  begin
    TextColor(Yellow);Write(' { ', Succ(i), ' } ');TextColor(Cyan);Writeln(menu[i]);PrintLine;
  end;
  TextColor(Yellow);Write(' { 0 } ');TextColor(Cyan);Writeln(menu[High(menu)]);PrintLine;
end;

procedure PrintInfoAuthor;// Информация об авторе программы
begin
  clrscr;
  PrintHeader('ОБ АВТОРЕ', 'Подробная информация об авторе программы');
  TextColor(Cyan);Write(' Университет: ');
  TextColor(Yellow);Writeln('Помогите Тупому Устроиться (ПТУ)');
  TextColor(Cyan);Write(' Факультет:   ');TextColor(Yellow);Writeln('Упс...непомню...');
  TextColor(Cyan);Write(' Кафедра:     ');TextColor(Yellow);Writeln('Автосервис');
  TextColor(Cyan);Write(' Группа:      ');TextColor(Yellow);Writeln('34');
  TextColor(Cyan);Write(' Студентка:   ');TextColor(Yellow);Writeln('Фомин Александр Сергеевич');
  Return;
end;

function InPutString(st: string): string;// Прверка корректности ввода строки
var
  temp, msg: string;
begin
  repeat
    TextColor(Cyan);Write(' ' + st + ': ');
    TextColor(Yellow);GotoXY(20, WhereY);ReadLn(temp);
    if Length(temp) = 0 then
    begin
      msg := 'ОШИБКА: Введена пустая строка... Повторите ввод через 3 сек.';
      TextColor(Red);GotoXY((80 - Length(msg)) div 2, WhereY);Write(msg);
      Delay(3000);GotoXY(1, WhereY);ClrEol;GotoXY(1, WhereY - 1);ClrEol;
    end;
  until Length(temp) <> 0;
  InPutString := UpCase(temp[1]) + Copy(temp, 2, Length(temp))
end;

function InPutDate(st: string; low: integer; high: integer): string;// Прверка корректности ввода даты
var
  temp: integer;
  msg: string;
begin
  repeat
    TextColor(Cyan);Write(' ' + st + ' (', low, '..', high, '): ');
    TextColor(Yellow);GotoXY(20, WhereY);ReadLn(temp);
    if not (low > temp) and (temp > high) then
    begin
      msg := 'ОШИБКА: Неверный диапазон... Повторите ввод через 3 сек.';
      TextColor(Red);GotoXY((80 - Length(msg)) div 2, WhereY);Write(msg);
      Delay(3000);GotoXY(1, WhereY);ClrEol;GotoXY(1, WhereY - 1);ClrEol;
    end;
  until (low <= temp) and (temp <= high);

  if temp < 10 then InPutDate := '0' + IntToStr(temp) else InPutDate := IntToStr(temp);
end;

procedure ChangeDataBase(var data: content);// Процедура ввода данных в БД
var
  temp: integer;
begin
  clrscr;
  PrintHeader('ВВОД ДАННЫХ', 'Управление: для ввода данных используйте клавиатуру');
  with data do
  begin
    surname := InPutString('Фамилия');
    name := InPutString('Имя');
    patronymic := InPutString('Отчество');
    year := InPutDate('Год', 1901, 2100);
    month := InPutDate('Месяц', 1, 12);
    case StrToInt(month) of // Определим кол-во дней в выбранном месяце
      4, 6, 9, 11: temp := 30;
      1, 3, 5, 7, 8, 10, 12: temp := 31;
      2: if ((StrToInt(year) mod 4 = 0) and (StrToInt(year) mod 100 <> 0)) or (StrToInt(year) mod 400 = 0) then temp := 29 else temp := 28;
    end;
    day := InPutDate('День', 1, temp);
  end;

  Return; // Возврат в основное меню
end;

procedure SaveDataBase(data: TData);// Процедура сохранения данных в файл DB_NAME
var
  id: integer;
  fdata: TFile;
  msg: string;
begin
  clrscr;
  PrintHeader('СОХРАНЕНИЕ ДАННЫХ', 'Сохранение данных в файл ' + DB_NAME);
  Assign(FData, DB_NAME); // Подключаем файл "DB_NAME"
  Rewrite(FData); // Создаем файл "DB_NAME" и открываем для записи
  for id := Low(data) to High(data) do Write(FData, data[id]); // Записываем информацию в файл "DB_NAME"
  Close(FData); // Закрываем файл "DB_NAME"
  msg := 'ВНИМАНИЕ: База данных успешно сохранена в файл "' + DB_NAME + '"';
  TextColor(LightGreen);GotoXY((80 - Length(msg)) div 2, WhereY);WriteLn(msg);
  Return; // Возврат в основное меню
end;

procedure LoadingDataBase(var data: TData; var id: integer);// Загрузка информации из файла "DB_NAME"
var
  fdata: TFile;
  msg: string;
begin
  clrscr;
  PrintHeader('ЗАГРУЗКА ДАННЫХ', 'Загрузка данных из файла ' + DB_NAME);
  Assign(FData, DB_NAME); // Подключаем файл "DB_NAME"
  Reset(FData); // Открываем файл "DB_NAME" для чтения}
  while not Eof(FData) do
  begin
    Inc(id);
    SetLength(data, id);
    Read(FData, Data[Pred(id)]);
  end;
  Close(FData); // Закрываем файл "DB_NAME"
  msg := 'ВНИМАНИЕ: База данных успешно загружена из файла "' + DB_NAME + '"';
  TextColor(LightGreen);GotoXY((80 - Length(msg)) div 2, WhereY);WriteLn(msg);
  Return; // Возврат в основное меню
end;

procedure ShortStory(data: TData; var id: integer);// Строка вывода информации из БД на экран
var
  count: integer;
begin
  clrscr;
  PrintHeader('ПРОСМОТР ДАННЫХ', 'Управление: клавиши "' + #24 + '", "' + #25 + '", "Esc" - выход в основное меню');
  Write('| ID |      Фамилия      |        Имя       |     Отчество     | Дата рождения |');
  PrintLine;
  count := 0;
  repeat
    Inc(id);
    Inc(Count);
    with Data[id] do // Печатаем "таблицу"
    begin
      GotoXY(1, WhereY);Write('|', id:3);
      GotoXY(6, WhereY);Write('| ', surname);
      GotoXY(26, WhereY);Write('| ', name);
      GotoXY(45, WhereY);Write('| ', patronymic);
      GotoXY(64, WhereY);Write('|   ', day + '.' + month + '.' + year, '  |');
    end;
  until (count = 15) or (id = High(data));
  PrintLine;
end;

procedure PrintShortStory(data: TData);// Процедура просмотра информации
var
  id: integer;
  key: char;
  msg: string;

begin
  clrscr;
  id := -1;
  if (High(data) < 0) then
  begin
    PrintHeader('ПРОСМОТР ДАННЫХ', 'Управление: клавиши "' + #24 + '", "' + #25 + '", "' + #26 + '", "' + #27 + '", ' + 'Esc - выход в основное меню');
    msg := 'ОШИБКА: Файл базы данных не загружен или отсутствует информация';
    TextColor(LightRed);GotoXY((80 - Length(msg)) div 2, WhereY);WriteLn(msg);
    Return; // Возврат в главное меню
  end
            else
  begin
    ShortStory(Data, id);
    // ----- Управление Start ----- //
    repeat
      key := Readkey; // Считываем ASCII-код клавиши
      case key of
        #80: // Стрелка вниз
          begin// Если элемент был последним, то возвращаемся к первому
            if (id >= High(data)) then id := -1; // Первый элемент массива}
            ShortStory(Data, id)
          end; // Case key #80
        #72:// Стрелка вверх
          begin
            if (High(data) > 14) then // Хер его знает как объяснить, но без этого работать небыдет (иными словами - КОСТЫЛЬ)
            begin
              if (id < High(data)) and (id > 14) then Dec(id, 30)
                                         else
              begin
                if (id >= High(data)) then
                begin
                  id := High(data) - (High(data) mod 15);
                  Dec(id, 16);
                end
                else if (id <= 14) and (High(data) > 14) then id := High(data) - (High(data) mod 15) else Dec(id, 15);
              end;
              ShortStory(Data, id)
            end;
          end;// Case key #72
      end; // Case key
    until key = #27; // Клавиша "Esc"
    // ----- Управление End ----- //
  end;
  MainMenu; // Возврат в основное меню
end;

function SelectionID(id: integer): integer;// Функция выбора ID записи
var
  temp: integer;
  msg: string;
  key: char;
begin
  clrscr;
  repeat
    PrintHeader('ВЫБОР ЗАПИСИ', 'Выберите номер записи от 0 до ' + IntToStr(id));
    TextColor(Cyan);Write(' Введите номер: ');TextColor(Yellow);Readln(temp);
    if ((temp < 0) or (id < temp)) then
    begin
      PrintLine;
      msg := 'ОШИБКА: Неверный диапазон... Повторите ввод через 3 сек.';
      TextColor(LightGreen);GotoXY((80 - Length(msg)) div 2, WhereY);WriteLn(msg);
      PrintLine;
      Delay(3000); // Задержка 3 сек
      clrscr;
    end;
  until ((0 <= temp) and (temp <= id));
  SelectionID := temp;
  PrintLine;
  TextColor(Yellow);GotoXY(19, WhereY);Writeln('Для продолжения нажмите клавишу "Enter"');
  PrintLine;
  repeat
    key := Readkey;
  until key = #13;
  clrscr;
end;

procedure DeleteDataBase(var data: TData; var id: integer; n: integer);// Процедура удаления записи из базы данных
var
  i: integer;
  msg: string;
begin
  PrintHeader('УДАЛЕНИЕ ЗАПИСИ', 'Удаление записи с выбранным ID (' + IntToStr(n) + ') из базы данных');
  if (0 <= n) and (n <= id) then
  begin
    for i := n to Pred(id) - 1 do Data[i] := Data[Succ(i)];
    Dec(id);
    SetLength(data, id);
  end;
  msg := 'ИНФОРМАЦИЯ: Выбранная запись успешно удалена';
  TextColor(LightGreen);GotoXY((80 - Length(msg)) div 2, WhereY);WriteLn(msg);
  Return; // Возврат в основное меню
end;

procedure Seach(data: TData; field: char);// Процедура поиска информации
var
  id, count: integer;
  sdata: TData;
  msg, temp: string;
  key:char;
begin
  clrscr;
  PrintHeader('ПОИСК ДАННЫХ', 'Управление: ввод с клавиатуры, Enter - подтвердить');
  count := 0;
  case Field of
    #49:
      begin// По фамилии
        temp := InPutString('Фамилия');
        PrintLine;
        for id := Low(data) to High(data) do
          if data[id].surname = temp then
          begin
            Inc(count);
            SetLength(sdata, count); // Выделяем память
            sdata[Pred(count)] := data[id];
          end;
      end;
    #50:
      begin// По имени
        temp := InPutString('Имя');
        PrintLine;
        for id := Low(data) to High(data) do
          if data[id].name = temp then
          begin
            Inc(count);
            SetLength(sdata, count); // Выделяем память
            sdata[Pred(count)] := data[id];
          end;
      end;
    #51:
      begin// По отчеству
        temp := InPutString('Отчество');
        PrintLine;
        for id := Low(data) to High(data) do
          if data[id].patronymic = temp then
          begin
            Inc(count);
            SetLength(sdata, count); // Выделяем память
            sdata[Pred(count)] := data[id];
          end;
      end;
    #52:
      begin// По первой букве фамилии
        temp := InPutString('Фамилия');
        PrintLine;
        for id := Low(data) to High(data) do
          if data[id].surname[1] = UpCase(temp[1]) then
          begin
            Inc(count);
            SetLength(sdata, count); // Выделяем память
            sdata[Pred(count)] := data[id];
          end;
      end;
    #53:
      begin// По первой букве имени
        temp := InPutString('Имя');
        PrintLine;
        for id := Low(data) to High(data) do
          if data[id].name[1] = UpCase(temp[1]) then
          begin
            Inc(count);
            SetLength(sdata, count); // Выделяем память
            sdata[Pred(count)] := data[id];
          end;
      end;
    #54:
      begin// По первой букве отчества
        temp := InPutString('Отчество');
        PrintLine;
        for id := Low(data) to High(data) do
          if data[id].patronymic[1] = UpCase(temp[1]) then
          begin
            Inc(count);
            SetLength(sdata, count); // Выделяем память
            sdata[Pred(count)] := data[id];
          end;
      end;
  end; // case field
  if (count = 0) then
  begin
    msg := 'Результаты поиска: по данному критерию найдено ' + IntToStr(count) + ' из ' + IntToStr(Succ(High(data))) + ' записей';
    TextColor(Red);GotoXY((80 - Length(msg)) div 2, WhereY);WriteLn(msg);
    Delay(3000); // Задержка 3 секунды
    Return; // Возврат в главное меню
  end
  else
  begin
    msg := 'Результаты поиска: по данному критерию найдено ' + IntToStr(count) + ' из ' + IntToStr(Succ(High(data))) + ' записей';
    TextColor(LightGreen);GotoXY((80 - Length(msg)) div 2, WhereY);WriteLn(msg);
    Delay(3000); // Задержка 3 секунды
    PrintLine;
    TextColor(Yellow);GotoXY(19, WhereY);Writeln('Для продолжения нажмите клавишу "Enter"');
    PrintLine;
    repeat
        key := Readkey;
    until key = #13;
    PrintShortStory(sdata);
  end;
end;

begin// Основная программа
  id := 0;
  MainMenu; // Выводим основное меню программы
  repeat
    key := ReadKey;
    case key of
      #49:
        begin
          Inc(id);
          SetLength(data, id); // Выделяем память
          ChangeDataBase(data[Pred(id)]); // Добавление записи
        end;
      #50: DeleteDataBase(Data, id, SelectionID(Pred(id))); // Удаление записи
      #51: ChangeDataBase(Data[SelectionID(Pred(id))]); // Изменение записи
      #52: PrintShortStory(Data); // Вывод информации на экран
      #53: SaveDataBase(Data); // Сохранение информации в файл "DB_NAME"
      #54: LoadingDataBase(Data, id); // Загрузка информации из файла "DB_NAME"
      #55:
        begin
          clrscr;
          SeachMenu; // Выводим меню поиска
          repeat
            key := ReadKey;
            case key of
              #49: Seach(data, #49); // Поиск по фамилии
              #50: Seach(data, #50); // Поиск по имени
              #51: Seach(data, #51); // Поиск по отчеству
              #52: Seach(data, #52); // Поиск по первой букве фамилии
              #53: Seach(data, #53); // Поиск по первой букве имени
              #54: Seach(data, #54); // Поиск по первой букве отчества
              #48: MainMenu;
            end; // case key
          until key in [#48..#54];
        end;
      #56: PrintInfoAuthor; // Вывод информации об авторе
      #48: Exit;
    end; // End case
  until key = #48;
end.