Unit SimpleFormUnit;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Menus, System.UITypes;

type
  TMatrix = Array of array of Integer;
  TSimpleForm = class(TForm)
    Menu: TMainMenu;
    Instruction: TMenuItem;
    Developer: TMenuItem;
    procedure InstructionClick(Sender: TObject);
    procedure DeveloperClick(Sender: TObject);
    Procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure SetInstructions(); virtual;
    procedure FormCreate(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); virtual;
    Procedure FormCloseQueryNope(Sender: TObject; var CanClose: Boolean);
  private
    { Private declarations }
  protected
    Instructions: String;
  public
    { Public declarations }
  end;

var
  SimpleForm: TSimpleForm;

implementation

{$R *.dfm}

procedure TSimpleForm.DeveloperClick(Sender: TObject);
begin
    ShowMessage('Yegor Rusakovich, 151002');
end;

procedure TSimpleForm.InstructionClick(Sender: TObject);
begin
    ShowMessage(Instructions);
end;

Procedure TSimpleForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
    CanClose := False;
    if MessageDlg('Are you sure you want to quit?',mtConfirmation, mbOKCancel, 0) = mrOk then
    begin
        CanClose := True;
    end;
end;

Procedure TSimpleForm.FormCloseQueryNope(Sender: TObject; var CanClose: Boolean);
Begin
    CanClose := True;
End;

procedure TSimpleForm.SetInstructions();
begin
    Instructions := 'Press F1 to see this message.' + #13#10 + 'Press F3 to estimate the authors name.' + #13#10 + 'Press escape to close window.'+#13#10;
end;

procedure TSimpleForm.FormCreate(Sender: TObject);
begin
    SetInstructions;
end;

procedure TSimpleForm.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
    if (Key = VK_ESCAPE) then
        Self.Close;
end;


end.

unit InputUnit;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, SimpleFormUnit, Vcl.Menus, Vcl.Grids,
  Vcl.StdCtrls, Vcl.Samples.Spin, Vcl.Buttons, GraphUnit, GraphVisionUnit, System.UITypes, ShellApi;

type
  TInputForm = class(TSimpleForm)
    btnDone: TBitBtn;
    edtVCount: TSpinEdit;
    grdIncedence: TStringGrid;
    OpenDialog: TOpenDialog;
    SaveDialog: TSaveDialog;
    FileMenu: TMenuItem;
    SaveFile: TMenuItem;
    OpenFile: TMenuItem;
    procedure SaveFileClick(Sender: TObject);
    procedure OpenFileClick(Sender: TObject);
    procedure btnDoneClick(Sender: TObject);
    procedure edtVCountChange(Sender: TObject);
    procedure grdIncedenceSetEditText(Sender: TObject; ACol, ARow: Integer;
      const Value: string);
    procedure FormCreate(Sender: TObject);
    procedure CreateGraphPicture();
    procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure SetInstructions(); override;
  end;

var
  InputForm: TInputForm;
  IsProcessed: Boolean = False;

implementation

{$R *.dfm}

function TrySetOutputFile(var SF: TextFile; const Name: String): Boolean;
Begin
    Result := True;
    AssignFile(SF, Name);
    Try
        Rewrite(SF);
    Except
        Result := False;
    End;
End;

Function TrySetInputFile(var IFile: TextFile; const Name: String): Boolean;
Begin
    Result := True;
    AssignFile(IFile, Name);
    Try
        Reset(IFile);
    Except
        Result := False;
    End;
End;

procedure OpenFromFile(var IFile: TextFile; var Grid: TStringGrid; var Edt: TSpinEdit);
Var
    I, J, Width: Integer;
    Str: String;
    Buffer: Char;
Begin
    Readln(IFile, Width);
    Edt.Text := IntToStr(Width);
    for I := 1 to Grid.RowCount-1 do
    Begin
        for J := 0 to 1 do
        Begin
            Buffer := 'f';
            Str := '';
            While (Buffer <> ' ') And (J = 0) do
            Begin
                Read(IFile, Buffer);
                Str := Str + buffer;
            End;
            If (J = 1) Then
            Begin
                Read(IFile, Str);
            End;
            Grid.Cells[J, I] := Str;
        End;
        Readln(IFile);
    End;
End;

procedure SaveInFile(var SF: TextFile; const Grid: TStringGrid);
Var
    I, J: Integer;
Begin
    Writeln(SF, Grid.RowCount-1);
    for I := 1 to Grid.RowCount-1 do
    Begin
        for J := 0 to Grid.ColCount-1 do
        Begin
            Write(SF, Grid.Cells[J, I]);
            Write(SF, ' ');
        End;
        Writeln(SF);
    End;
End;

procedure SetGridSize(const Width, Height: Integer; var Grid: TStringGrid);
Var
    I: Integer;
begin
    Grid.ColCount := Width+1;
    Grid.RowCount := Height+1;
    for I := 1 to Height do
    Begin
        Grid.Cells[I, 0] := IntToStr(I);
        Grid.Cells[0, I] := IntToStr(I);
    End;
    Grid.Width := (width+1)*Grid.DefaultColWidth + 15;
    Grid.Height := (height+1)*Grid.DefaultRowHeight + 15;
end;

procedure TInputForm.SetInstructions;
Const
    NEW_LINE = #13#10;
Begin
    inherited;
    Instructions := Instructions+'This program takes your input in incident list,'+NEW_LINE
        +'makes depth-first search and output graph and DFS-information.'+NEW_LINE
            +'1. Fullfill grid.'+NEW_LINE+'2. Press enter to process.'
                +NEW_LINE+'3. Press Show result button to see result.';
End;

procedure TInputForm.btnDoneClick(Sender: TObject);
begin
    if IsProcessed then
    Begin
        if not Assigned(GraphForm) then
            GraphForm := TGraphForm.Create(Self);
        GraphForm.Show;
        IsProcessed := False;
    End
    Else
        MessageDlg('Your data was not processed. Press enter, please', mtError, [mbOk], 0);
end;

procedure TInputForm.edtVCountChange(Sender: TObject);
Const
    WINDOW_DEFAULT_HEIGHT = 150;
begin
    SetGridSize(1, StrToint(edtVCount.Text), grdIncedence);
    if grdIncedence.height > ClientHeight-WINDOW_DEFAULT_HEIGHT then
        ClientHeight := grdIncedence.height+WINDOW_DEFAULT_HEIGHT;
end;

procedure TInputForm.FormCreate(Sender: TObject);
begin
  inherited;
    grdIncedence.Cells[0,0] := 'V';
    grdIncedence.Cells[1,0] := '1';
    grdIncedence.Cells[0,1] := '1';

end;

procedure TInputForm.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
Const
    ENTER = 13;
    INFO = 'Your information is processed, thanks.';
    EXCEPTION = 'Input iformation in your incident list.';
begin
  inherited;
    if Key = ENTER then
    Begin
        AnalyseList(grdIncedence, IncList, grdIncedence.RowCount-1);
        if IncList <> Nil then
        Begin
            InitDFSGraph(grdIncedence.RowCount-1, DS);
            DFS(DS);
            SaveGraph(ConvertGraphInString(IncList));
            CreateGraphPicture();
            IsProcessed := True;
            MessageDlg(INFO, mtInformation, [mbOk], 0)
        End
        Else
            MessageDlg(EXCEPTION, mtError, [mbOk], 0);
    End;
end;

procedure TInputForm.grdIncedenceSetEditText(Sender: TObject; ACol,
  ARow: Integer; const Value: string);
begin
    if not IsItValidStr(Value, (Sender as TStringGrid).RowCount-1) then
    Begin
        MessageDlg('Wrong content!', mtError, [mbOk], 0);
        (Sender as TStringGrid).Cells[ACol, ARow] := '';
    End;
end;

procedure TInputForm.OpenFileClick(Sender: TObject);
Var
    OFile: TextFile;
begin
    if OpenDialog.Execute then
    Begin
        If FileExists(OpenDialog.FileName) then
        Begin
            if TrySetInputFile(OFile, OpenDialog.FileName) then
            Begin
                OpenFromFile(OFile, Self.grdIncedence, edtVCount);
                CloseFile(OFile);
            End
            Else
                MessageDlg('Something was wrong', mtError, [mbOk], 0);
        End;
    End;
end;

procedure TInputForm.SaveFileClick(Sender: TObject);
Var
    SFile: TextFile;
begin
    if SaveDialog.Execute then
    Begin
        If FileExists(SaveDialog.FileName) then
        Begin
            if TrySetOutputFile(SFile, SaveDialog.FileName) then
            Begin
                SaveInFile(SFile, Self.grdIncedence);
                CloseFile(SFile);
                MessageDlg('Successfully saved', mtInformation, [mbOk], 0);
            End
            Else
                MessageDlg('Something was wrong', mtError, [mbOk], 0);
        End;
    End;
end;

procedure TInputForm.CreateGraphPicture();
Begin
    ShellExecute(Handle, nil, 'cmd.exe', PChar(CREATE_GRAPH_PICTURE_COMMAND), nil, SW_HIDE)
End;

end.

unit GraphVisionUnit;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, SimpleFormUnit, Vcl.Menus, Vcl.ExtCtrls, GraphUnit, Vcl.Imaging.PNGImage;

type
  TGraphForm = class(TSimpleForm)
    GraphPicture: TImage;
    procedure FormShow(Sender: TObject);
    procedure SetInstructions(); override;
  end;

var
  GraphForm: TGraphForm;

implementation

{$R *.dfm}

procedure TGraphForm.SetInstructions;
Const
    NEW_LINE = #13#10;
Begin
    inherited;
    Instructions := Instructions + 'Number that is out of node is virtex number.'+NEW_LINE
        +'In the node spase first number is the order of discovering the node by DFS'+NEW_LINE
            +'Second number after ''/'' is the order of finished DFS in this node.';
End;

procedure TGraphForm.FormShow(Sender: TObject);
begin
  inherited;
    GraphPicture.Picture.LoadFromFile(GRAPH_PICTURE_FILE);
    Self.ClientHeight := GraphPicture.Picture.Height;
    Self.ClientWidth := GraphPicture.Picture.Width;
end;

end.

unit GraphUnit;

interface

uses  Vcl.GRids, System.SysUtils;

Type

    PVirtex = ^TVirtex;
    TVirtex = record
        El: Integer;
        Next: PVirtex;
    end;
    PList = ^TList;
    TList = Record
        Virtex: Integer;
        Incedent: PVirtex;
        Next: PList;
    End;
    TColor = (WHITE, GRAY, BLACK);
    TDFSEl = record
        Value: Integer;
        Color: TColor;
        Prev: Integer;
        DTime: Integer;
        FTime: Integer;
    end;
    TDFSGraph = array of TDFSEl;

    procedure AnalyseList(const Grid: TStringGrid; var IncList: PList; MaxV: Integer);
    function IsItValidStr(const Value:String; MaxV: Integer): Boolean;
    function ConvertGraphInString(IncList: PList): String;
    procedure SaveGraph(const Graph: String);
    procedure DFS(var DFSGr: TDFSGraph);
    procedure DFS_Visit(var DFSGr: TDFSGraph; Cell: Integer);
    procedure InitDFSGraph(VAmount: Integer; var Graph: TDFSGraph);
Var
    IncList: Plist;
    DS: TDFSgraph;

Const
    GRAPH_FILE = '../../GraphsFiles/text_graph.gv';
    GRAPH_PICTURE_FILE = '../../GraphsFiles/picture.png';
    CREATE_GRAPH_PICTURE_COMMAND = '/C "C:\Program Files\Graphviz\bin\dot.exe" -Tpng C:\Users\yegorrusakovich\Documents\Embarcadero\Studio\Projects\7_block\7.1\GraphsFiles\text_graph.gv -o C:\Users\yegorrusakovich\Documents\Embarcadero\Studio\Projects\7_block\7.1\GraphsFiles\picture.png';

implementation
Var
    Time: Integer;

Procedure ClearList(var List: PList);
Var
    DelV: PVirtex;
    Del : PList;
Begin
    While(List <> Nil) do
    Begin
        while List^.Incedent <> Nil do
        Begin
            DelV := List^.Incedent;
            List^.Incedent := List^.Incedent^.Next;
            Dispose(DelV);
        End;
        Del := List;
        List := List^.Next;
        Dispose(Del);
    End;
End;


procedure AddtoList(var List: PList; V: Integer; N: Integer);
Var
    Find: Boolean;
    Save, Temp: PList;
    InTemp: PVirtex;
Begin
    Find := False;
    if List = Nil then
    Begin
        New(List);
        List^.Virtex := V;
        New(List^.Incedent);
        List^.Incedent^.El := N;
        List^.Next := Nil;
        List^.Incedent^.Next := Nil;
        Find := True;
    End;
    Temp := List;
    while (not Find) And (Temp <> Nil) do
    Begin
        if Temp^.Virtex = V then
        Begin
            InTemp := Temp^.Incedent;
            While(InTemp^.Next  <> Nil) do
                InTemp := InTemp^.Next;
            Find := True;
            New(InTemp^.Next);
            InTemp := InTemp^.Next;
            InTemp^.El := N;
            InTemp^.Next := Nil;
        End
        Else
        Begin
            if Temp^.Next = Nil then
                Save := Temp;
            Temp := Temp^.Next;
        End;
    End;
    if not Find then
    Begin
        New(Save^.Next);
        Save := Save^.Next;
        Save^.Virtex := V;
        New(Save^.Incedent);
        Save^.Incedent^.El := N;
        Save.Next := Nil;
        Save^.Incedent^.Next := Nil;
    End;
End;

function IsItValidStr(const Value:String; MaxV: Integer): Boolean;
Const
    VALID_ARRAY: array [1..11] of String[1] = ('0','1', '2', '3', '4', '5', '6', '7', '8', '9', ' ');
    MIN_V = 1;
function IsNumbCorrect(const Buff: String): Boolean;
Var
    N: Integer;
Begin
    Result := True;
    N := StrToInt(Buff);
    if (N > MaxV) Or (N < MIN_V) then
        Result := False;
End;
Var
    I, J: Integer;
    Find: Boolean;
    Buffer: String[2];
Begin
    Result := True;
    I := 1;
    Buffer := '';
    While (I <= Length(Value)) And (Result) do
    Begin
        Find := False;
        J := 1;
        While(J <= Length(VALID_ARRAY)) And (not Find) Do
        Begin
            if Value[I] = VALID_ARRAY[J] then
                Find := True;
            Inc(J);
        End;
        if Value[I] <> ' ' then
            Buffer := Buffer + Value[I]
        Else
        Begin
            Find := IsNumbCorrect(Buffer);
            Buffer := '';
        End;
        if not Find then
            Result := Find;
        Inc(I);
    End;
    if buffer <> '' then
        Result := IsNumbCorrect(Buffer);
End;

procedure AnalyseStr(const Value: String; Row: INteger; var IncList: PList);
Var
    Reader: String[2];
    I, N, ErrorCode: Integer;
procedure AddNumberToList();
Begin
    Val(Reader, N, ErrorCode);
    if ErrorCode = 0 then
        AddToList(IncList, Row, N);
End;
begin
    Reader := '';
    For I := 1 to Length(Value) do
    Begin
        If Value[I] <> ' ' then
            Reader := Reader+Value[I]
        Else
        Begin
            AddNumberToList;
            Reader := '';
        End;
    End;
    AddNumberToList;
end;

procedure AnalyseList(const Grid: TStringGrid; var IncList: PList; MaxV: Integer);
Var
    I: Integer;
begin
    if IncList <> Nil then
        ClearList(IncList);
    for I := 1 to Grid.RowCount-1 do
    Begin
        if IsItValidStr(Grid.Cells[1, I], MaxV) then
            AnalyseStr(Grid.Cells[1, I], I, IncList);
    End;
end;

function ConvertGraphInString(IncList: PList): String;
Const
    GRAPH_DEFAULT_STILE = 'digraph G { graph [ dpi = 300];';
Var
    Virtex, Numb, DiscoveredTime, FinishedTime: String;
    I: Integer;
Begin
    Result := GRAPH_DEFAULT_STILE;
    Result := Result+' forcelabels = true layout = neato ';
    for I := 0 to Length(DS) - 1 do
    Begin
        Numb := IntToStr(I+1);
        DiscoveredTime := IntToStr(DS[I].DTime);
        FinishedTime := IntToStr(DS[I].FTime);
        Result := Concat(Result, Numb, ' [xlabel = "', Numb,'", ', ' label = "', DiscoveredTime, '/', FinishedTime,'"] ');
    End;
    while IncList <> Nil do
    Begin
        Virtex := IntToStr(IncList^.Virtex);
        while IncList^.Incedent <> Nil do
        Begin
            Result := Result + Virtex + '->' + IntToStr(IncList^.Incedent^.El) + ' ';
            IncList^.Incedent := IncList^.Incedent^.Next;
        End;
        Inclist := IncList^.Next;
    End;
    Result := Result + ' }';
End;

procedure SaveGraph(const Graph: String);
Var
    GraphFile: TextFile;
Begin
    AssignFile(GraphFile, GRAPH_FILE);
    Rewrite(GraphFile);
    Write(GraphFile, Graph);
    CloseFile(GraphFile);
End;

procedure DFS(var DFSGr: TDFSGraph);
Var
    I: Integer;
Begin
    Time := 0;
    for I := 0 to Length(DFSGr)-1 do
    Begin
        if DFSGr[I].Color = WHITE then
            DFS_Visit(DFSgr, I)
    End;
End;

procedure DFS_Visit(var DFSGr: TDFSGraph; Cell: Integer);
Var
    IncidentV: PVirtex;
    Temp: PList;
Begin
    Inc(Time);
    DFSgr[Cell].DTime := Time;
    DFSGr[Cell].Color := GRAY;
    Temp := IncList;
    While(DFSGr[Cell].Value <> Temp^.Virtex) Do
        Temp := Temp^.Next;
    IncidentV := Temp^.Incedent;
    while IncidentV <> Nil do
    Begin
        if DFSgr[IncidentV^.El-1].Color = WHITE then
        Begin
            DFSgr[IncidentV^.El-1].Prev := Cell+1;
            DFS_Visit(DFSGr, IncidentV^.El-1);
        End;
        IncidentV := IncidentV^.Next;
    End;
    DFSGr[Cell].Color := BLACK;
    Inc(Time);
    DFSGr[Cell].FTime := Time;
End;

procedure InitDFSGraph(VAmount: Integer; var Graph: TDFSGraph);
Var
    I: Integer;
Begin
    SetLength(Graph, VAmount);
    for I := 0 to VAmount-1 do
    Begin
        Graph[I].Value := I+1;
        Graph[I].Color := WHITE;
        Graph[I].Prev := 0;
    End;
End;

end.