unit UnitIncidenceMatrix;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ComCtrls, Vcl.StdCtrls, Vcl.Grids,
  Vcl.Menus, Vcl.ExtCtrls;


type
   TMatrix = array of array of Integer;

type
  TFindPathForm = class(TForm)
    Label1: TLabel;
    edtCountOfNodes: TEdit;
    UpDown1: TUpDown;
    btCreateMatrix: TButton;
    sgIncidenceMatrix: TStringGrid;
    Label2: TLabel;
    Label3: TLabel;
    cbFirstNode: TComboBox;
    cbSecondNode: TComboBox;
    Label4: TLabel;
    btAddAdge: TButton;
    btCreateGraph: TButton;
    PopupMenu1: TPopupMenu;
    pmForSG: TPopupMenu;
    ItemAddNode: TMenuItem;
    ItemDeleteNode: TMenuItem;
    InputFile: TOpenDialog;
    SaveFile: TSaveDialog;
    MainMenu: TMainMenu;
    N1: TMenuItem;
    InputData: TMenuItem;
    SaveData: TMenuItem;
    N2: TMenuItem;
    ItemExit: TMenuItem;
    N3: TMenuItem;
    AboutAuthor: TMenuItem;
    AboutProgramm: TMenuItem;
    btClear: TButton;
    pbGraph: TPaintBox;
    Label5: TLabel;
    btFindPath: TButton;
    lResultPath: TLabel;
    procedure btCreateMatrixClick(Sender: TObject);
    procedure edtCountOfNodesKeyPress(Sender: TObject; var Key: Char);
    procedure btAddAdgeClick(Sender: TObject);
    procedure ClearStringGrid;
    procedure ItemDeleteNodeClick(Sender: TObject);
    procedure ItemAddNodeClick(Sender: TObject);
    procedure AboutAuthorClick(Sender: TObject);
    procedure AboutProgrammClick(Sender: TObject);
    procedure btClearClick(Sender: TObject);
    procedure InputDataClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure btCreateGraphClick(Sender: TObject);
    procedure btFindPathClick(Sender: TObject);
    procedure SaveDataClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure ItemExitClick(Sender: TObject);
  private
    { Private declarations }
    xCentre, yCentre, Radius, CircleRadius: Integer;
    procedure CreateNodes;
    procedure DrawGraph;
    procedure DrawNodes;
    function IsPathExists: Boolean;
    function IsConnectedGraph(MyGraph: TMatrix): Boolean;
    procedure CreatePath(MyGraph: TMatrix);
  public
    { Public declarations }
  end;

const
   CellWidth = 29;
   CellHeight = 29;

var
   FindPathForm: TFindPathForm;
   MyNodes: array of TPoint;

implementation

{$R *.dfm}

procedure TFindPathForm.btClearClick(Sender: TObject);
begin
   ClearStringGrid;
   pbGraph.Canvas.Brush.Color := clSilver;
   pbGraph.Canvas.FillRect(Rect(0, 0, pbGraph.Width, pbGraph.Height));
   edtCountOfNodes.Clear;
   sgIncidenceMatrix.RowCount := 1;
   sgIncidenceMatrix.ColCount := 1;
   sgIncidenceMatrix.Width := CellWidth;
   sgIncidenceMatrix.Height := CellHeight;
   cbFirstNode.Clear;
   cbSecondNode.Clear;
   lResultPath.Caption := '';
end;

procedure TFindPathForm.btCreateMatrixClick(Sender: TObject);
var
   Count, i, j : Integer;
begin
   SaveData.Enabled := False;
   ClearStringGrid;
   pbGraph.Canvas.Brush.Color := clSilver;
   pbGraph.Canvas.FillRect(Rect(0, 0, pbGraph.Width, pbGraph.Height));
   if (edtCountOfNodes.Text <> '0') and (edtCountOfNodes.Text <> '') then
   begin
      cbFirstNode.Clear;
      cbSecondNode.Clear;
      Count := StrToInt(edtCountOfNodes.Text) + 1;
      sgIncidenceMatrix.Width := Count * CellWidth;
      sgIncidenceMatrix.Height := Count * CellHeight;
      sgIncidenceMatrix.RowCount := Count;
      sgIncidenceMatrix.ColCount := Count;
      for i := 0 to Count - 1 do
      begin
         sgIncidenceMatrix.Cells[i, 0] := IntToStr(i);
         sgIncidenceMatrix.Cells[0, i] := IntToStr(i);
      end;
      sgIncidenceMatrix.Cells[0, 0] := '';
      for i := 1 to Count - 1 do
      begin
         cbFirstNode.Items.Add(IntToStr(i));
         cbSecondNode.Items.Add(IntToStr(i));
      end;
   end
   else
      MessageBox(Handle, PChar('Допустипое количество городов от 1 до 9'),
         PChar(''), MB_ICONSTOP + MB_OK);
end;

procedure TFindPathForm.btFindPathClick(Sender: TObject);
const
   MsgNoPath = 'Эйлеров путь не может быть найден, т.к. кол-во нечетных вершин не ' +
   'соответствуе условию! (2-е - эйлеров путь, 0 - эйлеров цикл)';
   MsgNoCennected = 'Элеров путь не может быть найден, т.к. граф не является связанным';
   MsgEmptyGraph = 'Граф не построен!';
var
   Count, i, j: Integer;
   Graph: TMatrix;
begin
   if sgIncidenceMatrix.RowCount > 1 then
   begin
      Count := sgIncidenceMatrix.RowCount - 1;
      SetLength(Graph, Count + 1, Count + 1);
      for i := 1 to Count do
         for j := 1 to Count do
            Graph[i, j] := 0;
      for i := 1 to Count do
         for j := 1 to Count do
         begin
            if sgIncidenceMatrix.Cells[j, i] = '+' then
               Graph[i, j] := 1;
         end;
      if IsConnectedGraph(Graph) then
         if IsPathExists then
         begin
            CreatePath(Graph);
            SaveData.Enabled := True;
         end
         else
            MessageBox(Handle, MsgNoPath, 'Ошибка!', MB_ICONSTOP + MB_OK)
      else
         MessageBox(handle, MsgNoCennected, 'Внимание!', MB_ICONINFORMATION + MB_OK);
   end
   else
      MessageBox(Handle, MsgEmptyGraph, 'Внимание!', MB_OK);
end;

procedure TFindPathForm.InputDataClick(Sender: TObject);
var
   Input : TextFile;
   Count, i, j, First, Second: Integer;
   IsCorrect : Boolean;
begin
   btClearClick(Sender);
   if InputFile.Execute then
   begin
      AssignFile(Input, InputFile.FileName);
      Reset(Input);
      if EoF(Input) then
      begin
         MessageBox(Handle, PChar('Файл не содержит необходимые данные!'),
            PChar('Ошибка!'), MB_ICONERROR + MB_OK);
         CloseFile(Input);
         InputDataClick(Sender);
      end
      else
      begin
         Readln(Input);
         if EoF(Input) then
            MessageBox(Handle, PChar('В файле отсутвуют элементы массива!'),
               PChar('Ошибка!'), MB_ICONERROR + MB_OK)
         else
         begin
            Reset(Input);
            try
               Readln(Input, Count);
               IsCorrect := True;
               if (Count > 0) and (Count < 10) then
               begin
                  edtCountOfNodes.Text := IntToStr(Count);
                  btCreateMatrixClick(Sender);
               end
               else
                  IsCorrect := False;
               i := 1;
               while (not EoF(Input)) and IsCorrect do
               begin
                  Read(Input, First);
                  Readln(Input, Second);
                  if (First > 0) and (First < Count) and (Second > 0) and (Second < Count) then
                  begin
                     if First <> Second then
                     begin
                        sgIncidenceMatrix.Cells[First, Second] := '+';
                        sgIncidenceMatrix.Cells[Second, First] := '+'
                     end
                     else
                        IsCorrect := False;
                  end
                  else
                     IsCorrect := False;
               end;
               if IsCorrect then
                  CloseFile(Input)
               else
               begin
                  CloseFile(Input);
                  btClearClick(Sender);
                  MessageBox(Handle, PChar('Присутсвуют некорректные данные!'),
                     PChar('Ошибка!'), MB_ICONERROR + MB_OK);
               end;
            except
               btClearClick(Sender);
               MessageBox(Handle, PChar('В файле присутсвуют данные несоответствующего типа!'),
                  PChar('Ошибка!'), MB_ICONERROR + MB_OK);
               CloseFile(Input);
               InputDataClick(Sender);
            end;
         end;
      end;
   end;
end;


function TFindPathForm.IsConnectedGraph(MyGraph: TMatrix): Boolean;
var
   Visited: array of Boolean;
   Count, i, j: Integer;
   IsConnected: Boolean;
procedure DFS(v: Integer);
var
   i: Integer;
begin
   Visited[v] := True;
   for i := 1 to Count do
   begin
      if (MyGraph[v, i] = 1) and (not Visited[i]) then
         DFS(i);
   end;
end;
begin
   Count := Length(MyGraph[1]) - 1;
   SetLength(Visited, Count + 1);
   for i := 1 to Count do
      Visited[i] := False;
   DFS(1);
   IsConnected := True;
   for i := 1 to Count do
      if Visited[i] = False then
         IsConnected := False;
   Result := IsConnected;
end;

function TFindPathForm.IsPathExists: Boolean;
var
   MyArr: array of Byte;
   i, j, Count, OddCount: Integer;
begin
   Count := sgIncidenceMatrix.RowCount - 1;
   SetLength(MyArr, Count + 1);
   for i := 1 to Count do
         MyArr[i] := 0;
   for i := 1 to Count do
   begin
      for j := 1 to Count do
         if sgIncidenceMatrix.Cells[j, i] = '+' then
            Inc(MyArr[i]);
   end;
   OddCount := 0;
   for i := 1 to Count do
      if (MyArr[i] mod 2) = 1 then
         Inc(OddCount);
   Result := (OddCOunt = 2) or (OddCount = 0);
end;

procedure TFindPathForm.ItemAddNodeClick(Sender: TObject);
var
   ACol, Arow : Integer;
begin
   ARow := sgIncidenceMatrix.Selection.Top;
   ACol := sgIncidenceMatrix.Selection.Left;
   if (ACol > 0) and (ARow > 0) and (ARow <> ACol) then
      if (sgIncidenceMatrix.Cells[ACol, ARow] = '') then
      begin
         sgIncidenceMatrix.Cells[ACol, ARow] := '+';
         sgIncidenceMatrix.Cells[ARow, ACol] := '+';
      end
      else
         MessageBox(Handle, PChar('Между этими вершинами уже есть ребро'),
            PChar('Внимание!'), MB_OK + MB_ICONSTOP);
end;

procedure TFindPathForm.ItemDeleteNodeClick(Sender: TObject);
var
   ACol, Arow : Integer;
begin
   ACol := sgIncidenceMatrix.Selection.Left;
   ARow := sgIncidenceMatrix.Selection.Top;
   if (ACol > 0) and (ARow > 0) then
      if (sgIncidenceMatrix.Cells[ACol, ARow] = '+') then
      begin
         sgIncidenceMatrix.Cells[ACol, ARow] := '';
         sgIncidenceMatrix.Cells[ARow, ACol] := '';
      end
      else
         MessageBox(Handle, PChar('Выбрана пустая клетка'), PChar('Внимание!'), MB_OK + MB_ICONSTOP);
end;

procedure TFindPathForm.ItemExitClick(Sender: TObject);
begin
   Close;
end;

procedure TFindPathForm.SaveDataClick(Sender: TObject);
const
   MsgRewrite = 'Желаете перезаписать Файл?';
var
   Output: TextFile;
   Count, i, j: Integer;
begin
   if SaveFile.Execute then
   begin
      if MessageBox(Handle, MsgRewrite, 'Внимание!', MB_ICONINFORMATION + MB_YESNO) = mrYes then
      begin
         AssignFile(Output, SaveFIle.FileName);
         Rewrite(Output);
         Writeln(Output, 'Матрица смежности: '#13#10);
         Count := sgIncidenceMatrix.RowCount - 1;
         for i := 1 to Count do
         begin
            for j := 1 to Count do
            begin
               if sgIncidenceMatrix.Cells[j, i] = '+' then
                  Write(Output, 1, '  ')
               else
                  Write(Output, 0, '  ');
            end;
            Writeln(Output);
         end;
         Writeln(Output, lResultPath.Caption);
         CloseFile(Output);
      end;
   end;
end;

procedure TFindPathForm.ClearStringGrid;
var
   i, j : Integer;
begin
   for j := 1 to sgIncidenceMatrix.RowCount do
      for i := 1 to sgIncidenceMatrix.ColCount do
         sgIncidenceMatrix.Cells[i, j] := '';
end;

procedure TFindPathForm.CreateNodes;
const
   MaxAngel = 2 * Pi;
var
   Count, i: Integer;
   DeltaX, DeltaY, DeltaAngel, Angel: Real;
begin
   Count := sgIncidenceMatrix.RowCount - 1;
   if Count > 0 then
   begin
      SetLength(MyNodes, Count);
      DeltaAngel := MaxAngel / Count;
      for i := 1 to Count do
      begin
         Angel := i * DeltaAngel;
         if (Angel > Pi/2 ) or (Angel < 3*Pi/2)  then
            DeltaX := (-1) * Radius * Cos(Angel)
         else
            DeltaX := Radius * Cos(Angel);
         if (Angel > Pi) or (Angel < 2*Pi) then
            DeltaY := (-1) * Radius * Sin(Angel)
         else
            DeltaY := Radius * Sin(Angel);
         MyNodes[i - 1].X := xCentre - Round(DeltaX);
         MyNodes[i - 1].Y := yCentre - Round(DeltaY);
      end;
   end
   else
      MessageBox(Handle, 'Число вершин не задано!', 'Внимание!', MB_ICONINFORMATION + MB_OK);
end;

procedure TFindPathForm.CreatePath(MyGraph: TMatrix);
var
   Stack: array of Byte;
   Top, Count: Byte;
  i: Integer;
procedure Search(v: Byte);
var
   i: Integer;
begin
   for i := 1 to Count do
      if MyGraph[v, i] = 1 then
      begin
         MyGraph[v, i] := 0;
         MyGraph[i, v] := 0;
         Search(i);
      end;
   Inc(Top);
   SetLength(Stack, Length(Stack) + 1);
   Stack[Top] := v;
end;
begin
   Count := Length(MyGraph[1]) - 1;
   SetLength(Stack, 1);
   for i := 1 to Count do
      Stack[i] := 0;
   Top := 0;
   Search(1);
   if Stack[1] = Stack[Top] then
      lResultPath.Caption := 'Цикл : '
   else
      lResultPath.Caption := 'Путь : ';
   for i := Top downto 1 do
   begin
      lResultPath.Caption := lResultPath.Caption + IntToStr(Stack[i]);
      if i <> 1 then
         lResultPath.Caption := lResultPath.Caption + ' -> '
      else
         lResultPath.Caption := lResultPath.Caption + ';';
      with pbGraph.Canvas do
      begin
         Pen.Color := clRed;
         Pen.Width := 3;
         if i <> 1 then
         begin
            MoveTo(MyNodes[Stack[i] - 1].X, MyNodes[Stack[i] - 1].Y);
            LineTo(MyNodes[Stack[i - 1] - 1].X, MyNodes[Stack[i - 1] - 1].Y);
         end;
      end;
   end;
   DrawNodes;
end;

procedure TFindPathForm.DrawGraph;
var
   Count, i, j: Integer;
   StartX, StartY, FinishX, FinishY: Integer;
   Str: String;
begin
   pbGraph.Canvas.Brush.Color := clSilver;
   pbGraph.Canvas.FillRect(Rect(0, 0, pbGraph.Width, pbGraph.Height));
   Count := sgIncidenceMatrix.RowCount - 1;
   with pbGraph.Canvas do
   begin
      Pen.Color := clBlack;
      Pen.Width := 3;
      i := 1;
      while i < Count do
      begin
         j := i + 1;
         while j < Count + 1 do
         begin
            if sgIncidenceMatrix.Cells[j, i] = '+' then
            begin
               StartX := MyNodes[j - 1].X;
               StartY := MyNodes[j - 1].Y;
               FinishX := MyNodes[i - 1].X;
               FinishY := MyNodes[i - 1].Y;
               MoveTo(StartX, StartY);
               LineTo(FinishX, FinishY);
            end;
            Inc(j);
         end;
         Inc(i);
      end;
      Pen.Color := clBlue;
      Pen.Width := 4;
      for i := 0 to Count - 1 do
      begin
         Str := IntToStr(i + 1);
         Ellipse(MyNodes[i].X - CircleRadius, MyNodes[i].Y - CircleRadius,
            MyNodes[i].X + CircleRadius, MyNodes[i].Y + CircleRadius);
         TextOut(MyNodes[i].X - TextWidth(Str) div 2,
            MyNodes[i].Y - TextHeight(Str) div 2, Str);
      end;
   end;
end;

procedure TFindPathForm.DrawNodes;
var
   Count, i, j: Integer;
   Str: String;
begin
   Count := sgIncidenceMatrix.RowCount - 1;
   with pbGraph.Canvas do
   begin
      Pen.Color := clBlue;
      Pen.Width := 4;
      for i := 0 to Count - 1 do
      begin
         Str := IntToStr(i + 1);
         Ellipse(MyNodes[i].X - CircleRadius, MyNodes[i].Y - CircleRadius,
            MyNodes[i].X + CircleRadius, MyNodes[i].Y + CircleRadius);
         TextOut(MyNodes[i].X - TextWidth(Str) div 2,
            MyNodes[i].Y - TextHeight(Str) div 2, Str);
      end;
   end;
end;

procedure TFindPathForm.AboutAuthorClick(Sender: TObject);
begin
   MessageBox(Handle, PChar('Программу разработал Быховец Илья (гр. 851001)'),
            PChar(''), MB_ICONSTOP + MB_OK);
end;

procedure TFindPathForm.AboutProgrammClick(Sender: TObject);
const
   MsgTask = 'Найти эйлеров цикл в графе, заданном матрицей смежности. ' +
      'Эйлеровым путем в графе называется произвольный путь, проходящий ' +
      'через каждое ребро графа в точности один раз. Проверить, есть ли ' +
      'путь по теореме Эйлера. Граф визуализировать. Если есть путь, выделить цветом.';
begin
   MessageBox(Handle, PChar(MsgTask), PChar('Описание!'), MB_ICONSTOP + MB_OK);
end;

procedure TFindPathForm.btAddAdgeClick(Sender: TObject);
var
   i, j : Integer;
begin
   if (cbFirstNode.Text <> '') and (cbSecondNode.Text <> '') then
   begin
      if cbFirstNode.Text <> cbSecondNode.Text then
      begin
         i := StrToInt(cbSecondNode.Text);
         j := StrToInt(cbFirstNode.Text);
         if sgIncidenceMatrix.Cells[i, j] = '' then
         begin
            sgIncidenceMatrix.Cells[i, j] := '+';
            sgIncidenceMatrix.Cells[j, i] := '+';
         end
         else
            MessageBox(Handle, PChar('Такое ребро уже существует!'),
            PChar('Внимание!'), MB_ICONSTOP + MB_OK);
      end
      else
         MessageBox(Handle, PChar('Нельзя построить петлю!'),
            PChar('Внимание!'), MB_ICONSTOP + MB_OK);
   end
   else
      MessageBox(Handle, PChar('Есть пустые поля!'),
         PChar('Внимание!'), MB_ICONSTOP + MB_OK);
end;

procedure TFindPathForm.edtCountOfNodesKeyPress(Sender: TObject; var Key: Char);
const
   ENTER = #13;
begin
   if (Key = ENTER) and (edtCountOfNodes.Text <> '') then
      btCreateMatrix.Click;
end;

procedure TFindPathForm.btCreateGraphClick(Sender: TObject);
begin
   CreateNodes;
   DrawGraph;
end;

procedure TFindPathForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
   if MessageBox(Handle, 'Вы уверены?', 'Внимание!', MB_ICONERROR + MB_YESNO) = mrNo then
      Action := TCloseAction.caNone;
end;

procedure TFindPathForm.FormCreate(Sender: TObject);
begin
   xCentre := 215;
   yCentre := 233;
   CircleRadius := 20;
   Radius := 150;
end;

end.