4.1

unit Menu;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Grids, Menus;

type
  TWorker = record
     Name: string[20];
     Department: string[30];
     BirthYear: Word;
     Experience: Byte;
     Post: string[20];
     Salary: Word;
  end;
  TWorkers = array of TWorker;
  TCorrectOrAdd = (caCorrect, caAdd);
  TEugenesDB = class(TForm)
    btAddRecord: TButton;
    sgDataTable: TStringGrid;
    OpenFile: TOpenDialog;
    btReload: TButton;
    btDelete: TButton;
    btCorrect: TButton;
    btShowRet: TButton;
    btAvrExp: TButton;
    MainMenu1: TMainMenu;
    N1: TMenuItem;
    ItemAuthorName: TMenuItem;
    ItemTask: TMenuItem;
    ItemHelp: TMenuItem;
    ItemFile: TMenuItem;
    ItemOpen: TMenuItem;
    ItemSave: TMenuItem;
    SaveFile: TSaveDialog;
    procedure FormCreate(Sender: TObject);
    procedure btAddRecordClick(Sender: TObject);
    procedure btReloadClick(Sender: TObject);
    procedure btDeleteClick(Sender: TObject);
    procedure sgDataTableSelectCell(Sender: TObject; ACol, ARow: Integer;
      var CanSelect: Boolean);
    procedure btCorrectClick(Sender: TObject);
    procedure btShowRetClick(Sender: TObject);
    procedure btAvrExpClick(Sender: TObject);
    procedure ItemHelpClick(Sender: TObject);
    procedure ItemAuthorNameClick(Sender: TObject);
    procedure ItemTaskClick(Sender: TObject);
    procedure ItemOpenClick(Sender: TObject);
    procedure ItemSaveClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
   { Private declarations }
  public
    { Public declarations }
  end;

var
  EugenesDB: TEugenesDB;
  Workers: TWorkers;
   DbFile: File of TWorker;
   CorrectOrAdd: TCorrectOrAdd;
   WorkersCount: Integer;
   RecNumber: Integer;
   Path: string;

implementation

uses AddRecord, Unit1, CorrectRecord, ShowRetired, ShowAvrExp;

const
   ThisYear = 2019;
   MinBYear = 1900;
   MaxBYear = 2001;

var
   IsOpen: Boolean;

{$R *.dfm}

function CheckYear(BirthYear: string; var BYear: Integer): Boolean;
var
   Er: Integer;
   IsValid: Boolean;
begin
   IsValid := True;
   if Length(BirthYear) = 0 then
   begin
      IsValid := False;
   end
   else
   begin
      Val(BirthYear, BYear, Er);
      if Er = 0 then
         if (BYear < MinBYear) or (BYear > MaxBYear) then
         begin
            IsValid := False;
         end
         else
            IsValid := True
      else
      begin
         IsValid := False;
      end;
   end;
   CheckYear := IsValid;
end;

function CheckExperience(Experience: string; BYear: Integer): Boolean;
var
   Er, Exp: Integer;
   IsValid: Boolean;
begin
   IsValid := True;
   if Length(Experience) = 0 then
   begin
      IsValid := False;
   end
   else
   begin
      Val(Experience, Exp, Er);
      if Er = 0 then
         if (Exp > (ThisYear - BYear)) then
         begin
            IsValid := False;
         end
         else
            IsValid := True
      else
      begin
         IsValid := False;
      end;
    end;
    CheckExperience := IsValid;
end;

function CheckSalary(Salary: string): Boolean;
var
   Sal, Er: Integer;
   IsValid: Boolean;
begin
   IsValid := True;
   if Length(Salary) = 0 then
   begin
      IsValid := False;
   end
   else
   begin
      Val(Salary, Sal, Er);
      if Er <> 0 then
      begin
         IsValid := False;
      end
   end;
   CheckSalary := IsValid;
end;

function IsCorrect(const Name, Department, BirthYear, Experience, Post, Salary
                                                            : string): Boolean;
var
   BYear, Er, Sal: Integer;
   Exp: Byte;
   IsValid: Boolean;
begin
   IsValid := True;
   //Проверка фамилии
   if Length(Name) = 0 then
   begin
      IsValid := False;
   end;
   //Проверка года
   if IsValid then
      IsValid := CheckYear(BirthYear, BYear);
   //Проверка стажа
   if IsValid then
      IsValid := CheckExperience(Experience, BYear);
   //Проверка зарплаты
   if IsValid then
      IsValid := CheckSalary(Salary);
   //Проверка отдела
   if IsValid then
      if Length(Department) = 0 then
       begin
          IsValid := False;
       end;
   //Проверка должности
   if IsValid then
      if Length(Post) = 0 then
      begin
         IsValid := False;
      end;
   IsCorrect := IsValid;
end;

function DbOpen(const Path: string): Boolean;
var
   Temp: TWorker;
begin
   AssignFile(DbFile, Path);
   {$I-}
      Reset(DbFile);
   {$I+}
   if IOResult = 0 then
   begin
      IsOpen := True;
      while not EOF(DbFile) and (IsOpen) do
         try
            Read(DbFile, Temp);
            IsOpen := IsCorrect(Temp.Name, Temp.Department, IntToStr(Temp.BirthYear),
               IntToStr(Temp.Experience), Temp.Post, IntToStr(Temp.Salary));
            if not IsOpen then
            begin
               MessageDlg('Ошибка! Файл содержит некорректные данные', mtError, [mbOk], 0);
            end;
         except
            IsOpen := False;
            MessageDlg('Ошибка! В файле содержатся некорректные данные.', mtError, [mbOk], 0);
         end;
      WorkersCount := FileSize(DbFile);
   end
   else
   begin
      MessageDlg('Ошибка! Файл невозможно открыть', mtError, [mbOk], 0);
      IsOpen := False;
   end;
   DbOpen := IsOpen;
end;

procedure ReadFile();
var
   i: Integer;
begin
   SetLength(Workers, WorkersCount);
   Seek(DbFile, 0);
   for i := 0 to High(Workers) do
      Read(DbFile, Workers[i]);
end;

procedure FillTable(Table: TStringGrid);
var
   i: Integer;
begin
   Table.RowCount := WorkersCount + 1;
   if Table.RowCount > 1 then
      for i := 1 to Table.RowCount do
      begin
         Table.Cells[0, i] := IntToStr(i);
         Table.Cells[1, i] := Workers[i - 1].Name;
         Table.Cells[2, i] := Workers[i - 1].Department;
         Table.Cells[3, i] := IntToStr(Workers[i - 1].BirthYear);
         Table.Cells[4, i] := IntToStr(Workers[i - 1].Experience);
         Table.Cells[5, i] := Workers[i - 1].Post;
         Table.Cells[6, i] := IntToStr(Workers[i - 1].Salary);
      end
   else
   begin
      Table.RowCount := 2;
      Table.Cells[0, 1] := '';
      Table.Cells[1, 1] := '';
      Table.Cells[2, 1] := '';
      Table.Cells[3, 1] := '';
      Table.Cells[4, 1] := '';
      Table.Cells[5, 1] := '';
      Table.Cells[6, 1] := '';
   end;
   Table.FixedRows := 1;
end;

function CheckName(const Name: string): Boolean;
var
   Ending: string;
   IsCorrect: Boolean;
begin
   Ending := Copy(Name, Length(Name) - 3, 4);
   if Ending = '.dat' then
      IsCorrect := True
   else
      IsCorrect := False;
   CheckName := IsCorrect;
end;


procedure TEugenesDB.FormCreate(Sender: TObject);
var
   UserFile: TextFile;
begin
   sgDataTable.Cells[0, 0] := '№';
   sgDataTable.Cells[1, 0] := 'Фамилия';
   sgDataTable.Cells[2, 0] := 'Отдел';
   sgDataTable.Cells[3, 0] := 'Год рождения';
   sgDataTable.Cells[4, 0] := 'Стаж работы';
   sgDataTable.Cells[5, 0] := 'Должность';
   sgDataTable.Cells[6, 0] := 'Оклад';
   IsOpen := False;
   RecNumber := -1;
end;

procedure TEugenesDB.btAddRecordClick(Sender: TObject);
begin
   CorrectOrAdd := caAdd;
   AddWorker.Show;
end;

procedure TEugenesDB.btReloadClick(Sender: TObject);
begin
   FillTable(sgDataTable);
end;

procedure TEugenesDB.btDeleteClick(Sender: TObject);
var
   i, Choice: Integer;
begin
   if WorkersCount > 0 then
      if RecNumber = -1 then
         MessageDlg('Пожалуйста, выберите запись для удаления', mtWarning, [mbOk], 0)
      else
      begin
         Choice := MessageDlg('Вы точно хотите удалить запись?', mtConfirmation, [mbYes, mbNo], 0);
         if Choice = mrYes then
         begin
            for i := RecNumber to (High(Workers) - 1) do
               Workers[i] := Workers[i + 1];
            SetLength(Workers, High(Workers));
            Dec(WorkersCount);
            RecNumber := -1;
            btReload.Click;
         end;
      end;
end;

procedure TEugenesDB.sgDataTableSelectCell(Sender: TObject; ACol,
  ARow: Integer; var CanSelect: Boolean);
begin
   RecNumber := ARow - 1;
end;

procedure TEugenesDB.btCorrectClick(Sender: TObject);
begin
   if WorkersCount > 0 then
      if RecNumber = -1 then
         MessageDlg('Пожалуйста, выберите запись для корректирования', mtWarning, [mbOk], 0)
      else
      begin
         CorrectOrAdd := caCorrect;
         AddWorker.Show;
      end;
end;

procedure TEugenesDB.btShowRetClick(Sender: TObject);
begin
   ShowPensioners.Show
end;

procedure TEugenesDB.btAvrExpClick(Sender: TObject);
begin
   ShowAverageExperience.Show;
end;

procedure TEugenesDB.ItemHelpClick(Sender: TObject);
const
   TextA1 = 'Чтобы посмотреть список работников пенсионного возраста';
   TextA2 = 'с указанием стажа работы нажмите "Пенсия"';
   TextB1 = 'Чтобы посмотреть средний стаж работающих в определённом отделе';
   TextB2 = 'нажмите "Ср. стаж" и далее в поле "отдел" введите название';
   TextB3 = 'требуемого отдела';
begin
   MessageDlg(TextA1 + #10#13 + TextA2 + #10#13 + TextB1 + #10#13 + TextB2 + #10#13 + TextB3, mtInformation, [mbOk], 0);
end;

procedure TEugenesDB.ItemAuthorNameClick(Sender: TObject);
begin
   MessageDlg('Данная программа разработана Трахановым Евгением,' + #10#13 + 'студентом группы №851001', mtInformation, [mbOk], 0);
end;

procedure TEugenesDB.ItemTaskClick(Sender: TObject);
const
   TextA = 'Данная программа выводит список сотрудников пенсионного возраста';
   TextB = 'а также средний стаж, работающих в заданном отделе';
begin
   MessageDlg(TextA + #10#13 + TextB, mtInformation, [mbOk], 0);
end;

procedure TEugenesDB.ItemOpenClick(Sender: TObject);
var
   IsCorrect: Boolean;
begin
   if OpenFile.Execute then
   begin
      Path := OpenFile.FileName;
      IsCorrect := CheckName(Path);
      if not IsCorrect then
         MessageDlg('Ошибка! Данный файл не соответсвует формату.', mtError, [mbOk], 0)
      else
         if DbOpen(Path) then
         begin
            ReadFile;
            FillTable(sgDataTable);
         end;
   end;
end;

procedure TEugenesDB.ItemSaveClick(Sender: TObject);
var
   i: Integer;
   IsCorrect: Boolean;
begin
   if SaveFile.Execute then
   begin
      Path := SaveFile.FileName;
      IsCorrect := CheckName(Path);
      if IsCorrect then
      begin
         AssignFile(DbFile, Path);
         Rewrite(DbFile);
         for i := 0 to High(Workers) do
            Write(Dbfile, Workers[i]);
         MessageDlg('Файл сохранён', mtInformation, [mbOk], 0);
      end
      else
      begin
         AssignFile(DbFile, Path + '.dat');
         Rewrite(DbFile);
         for i := 0 to High(Workers) do
            Write(Dbfile, Workers[i]);
         MessageDlg('Файл сохранён', mtInformation, [mbOk], 0);
      end;
   end;
end;

procedure TEugenesDB.FormClose(Sender: TObject; var Action: TCloseAction);
var
   Choice: Byte;
begin
   Choice := MessageDlg('Вы действительно хотите выйти?' + #10#13 + '(Все несохранённые данные будут утрачены)', mtConfirmation, [mbYes, mbNo], 0);
   if Choice = mrNo then
      Action := caNone;
end;

end.