2.4

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    StringGrid1: TStringGrid;
    StringGrid2: TStringGrid;
    Label7: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    Edit1: TEdit;
    Button1: TButton;
    SaveDialog1: TSaveDialog;
    OpenDialog1: TOpenDialog;
    MainMenu1: TMainMenu;
    PopupMenu1: TPopupMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    Button2: TButton;
    procedure Button2Click(Sender: TObject);
    procedure Edit1Change(Sender: TObject);
    procedure Edit1KeyPress(Sender: TObject; var Key: Char);
    procedure StringGrid1SetEditText(Sender: TObject; ACol, ARow: Integer;
      const Value: string);
    procedure StringGrid1KeyPress(Sender: TObject; var Key: Char);
    procedure Button1Click(Sender: TObject);
    procedure N5Click(Sender: TObject);
    procedure N4Click(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure N2Click(Sender: TObject);
    procedure N3Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

Type
    TMatrix = Array of Array of Integer;
    TVector = Array of Integer;
    TStr = Array of String[5];

var
  Form1: TForm1;
  Path, Result : String;
  IsFileOpen : Boolean;

Const
    BAD = 100000;

implementation

{$R *.dfm}

Function TransferMatrixVector (N, StartI, StartJ: Integer; Arr : TMatrix): TVector;
Var
    I, K, J, HalfN: ShortInt;
    Quarter : TVector;
Const
    Min = 4;
Begin
    K := 0;
    SetLength(Quarter,(N * N div Min));
    HalfN := N div 2;
    For I := StartI To StartI + HalfN - 1 Do
        For J := StartJ To StartJ + HalfN - 1 Do
            Begin
                Quarter[K] := Arr[I][J];
                Inc (K);
            End;

    TransferMatrixVector := Quarter;
End;



procedure TForm1.Button2Click(Sender: TObject);
Var
    N, J, I: Integer;
    IsCorrect : Boolean;
begin
    IsCorrect := True;
    try
        N := StrToInt(Edit1.Text);
    except
        IsCorrect := False;
    end;
    If N mod 2 <> 0 then
    begin
        IsCorrect := False;
        Edit1.Text := '';
        MessageBox(Form1.Handle, Pchar('Размер матрицы должен быть четным числом!'), 'Ошибка', MB_ICONSTOP);
    end;
    If Iscorrect then
    begin
        StringGrid1.Visible := True;
        Label7.Visible := True;
        StringGrid1.ColCount := N;
        StringGrid1.RowCount := N;
    end;
end;


procedure TForm1.Edit1Change(Sender: TObject);
Var
    I, J : Integer;
begin
     StringGrid1.Visible := False;
     StringGrid2.Visible := False;
     Label7.Visible := False;
     N3.Enabled := False;
     If Length (Edit1.Text) = 0 then
        Button2.Enabled := False
     else
     begin
        Button2.Enabled := True;
     end;
     For I := 0 to StringGrid1.ColCount - 1 do
        For J := 0 to StringGrid1.RowCount - 1 do
            StringGrid1.Cells[J, I] := '';
     For I := 0 to StringGrid2.ColCount - 1 do
        For J := 0 to StringGrid2.RowCount - 1 do
            StringGrid2.Cells[J, I] := '';
end;

procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
    If (Key = #13) and (Button2.Enabled) then
        Button2.Click;
    If (Not(Key In ['2'..'9', #08, #46])) Then
        Key := #0;
end;

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
    CanClose := MessageBox(Form1.Handle, 'Вы уверены, что хотите выйти?', 'Выход', MB_YESNO + MB_ICONQUESTION)=ID_YES;
end;

procedure TForm1.N4Click(Sender: TObject);
begin
    Application.MessageBox('Возможные размеры матрицы: 2, 4, 6, 8.'#13#10'Диапазон элементов матрицы: -9999 .. 99999.', 'Инструкция', 0);
end;

procedure TForm1.N5Click(Sender: TObject);
begin
    Application.MessageBox('Арефин Владислав гр.251004', 'Разрабочик', 0);
end;

procedure TForm1.StringGrid1KeyPress(Sender: TObject; var Key: Char);
Const
    LIM = 4; // значит 5 - реальный лимит символов
begin
    If (Not(Key In ['0'..'9', #08, #46, '-'])) Then
        Key := #0;
    With Sender As TStringGrid Do
    Begin
        If (Length(StringGrid1.Cells[Col, Row]) > LIM) then
            If (Not(Key In [#08, #46])) Then
                Key := #0;
        If (Length(StringGrid1.Cells[Col, Row]) <> 0) and (Key = '-')  then
            Key := #0;
    End;
end;

procedure TForm1.StringGrid1SetEditText(Sender: TObject; ACol, ARow: Integer;
  const Value: string);
var
    I, J : Integer;
    IsCorrect : Boolean;
    Temp : String;
begin
    IsCorrect := True;

    For I := 0 to StringGrid1.ColCount - 1 do
        For J := 0 to StringGrid1.RowCount - 1 do
            If (Length(StringGrid1.Cells[I, J]) = 0) Then
            begin
                Button1.Visible := False;
                IsCorrect := False;
            end;

    If IsCorrect then
    begin
         Button1.Visible := True;
    end;
    N3.Enabled := False;
    StringGrid2.Visible := False;
end;



procedure TForm1.Button1Click(Sender: TObject);
Var
    Arr : TMatrix;
    BufferFor1, BufferFor2, BufferFor3, BufferFor4 : TVector;
    StartI, StartJ, Chose, I, J, N, K1, K2, K3, K4: Integer;
    IsCorrect : Boolean;
    q, w, e, r : String;
begin
    IsCorrect := True;
    N := StringGrid1.ColCount;
    StringGrid2.ColCount := N;
    StringGrid2.RowCount := N;
    SetLength(Arr, N, N);
    Result := 'Исходная матрица:' + #13#10;
    For I := 0 to StringGrid1.ColCount - 1 do
    Begin
        For J := 0 to StringGrid1.RowCount - 1 do
            Try
                Arr[I, J] := StrToInt(StringGrid1.Cells[J, I]); //!
                Result := Result + StringGrid1.Cells[J, I] + ' ';
            Except
                StringGrid1.Cells[J, I] := '';
                IsCorrect := False;
                MessageBox(Form1.Handle, Pchar('Элементами матрицы могут быть только числа!'), 'Ошибка', MB_ICONSTOP);
            End;
        Result := Result + #13#10;
    End;
    Result := Result + #13#10;
    Result := Result + 'Преобразованная матрица:' + #13#10;

    If IsCorrect then
    Begin
        StartI := 0;
        StartJ := StartI;
        BufferFor1 := TransferMatrixVector (N, StartI, StartJ, Arr);
        StartI := 0;
        StartJ := N div 2;
        BufferFor2 := TransferMatrixVector (N, StartI, StartJ, Arr);
        StartI := N div 2;
        StartJ := 0;
        BufferFor3 := TransferMatrixVector (N, StartI, StartJ, Arr);
        StartI := N div 2;
        StartJ := StartI;
        BufferFor4 := TransferMatrixVector (N, StartI, StartJ, Arr);
        K1 := 0;
        K2 := 0;
        K3 := 0;
        K4 := 0;
        N := N * 2;
        For I := Low(Arr) To High(Arr)  do
            For J :=  Low(Arr) To High(Arr) Do
                Arr[I, J] := 0;
        N := N div 2;
        For I := 0 To N - 1  do
        Begin
            For J := 0 To N - 1 Do
                Begin
                    If ((I < N div 2) and (J < N div 2)) then
                    Begin
                        Arr[I,J] := BufferFor4[K1];
                        q := q + IntToStr(Arr[I,J]) + ' ';
                        Inc (K1);
                    End;
                    If ((I < N div 2) and (J > N div 2 - 1)) then
                    Begin
                        Arr[I,J] := BufferFor3[K2];
                        w := w + IntToStr(Arr[I,J]) + ' ';
                        Inc (K2);
                    End;
                    If ((I > N div 2 - 1) and (J < N div 2)) then
                    Begin
                        Arr[I,J] := BufferFor1[K3];  //
                        e := e + IntToStr(Arr[I,J]) + ' ';
                        Inc (K3);
                    End;
                    If ((I > N div 2 - 1) and (J > N div 2 - 1)) then
                    Begin
                        Arr[I,J] := BufferFor2[K4];
                        r  := r + IntToStr(Arr[I,J]) + ' ';
                        Inc (K4);
                    End;

                End;
        End;
        For I := 0 to StringGrid2.ColCount - 1 do
        Begin
            For J := 0 to StringGrid2.RowCount - 1 do
            Begin
                StringGrid2.Cells[J, I] := IntToStr(Arr[I, J]);//!
                Result := Result + StringGrid2.Cells[J, I] + ' ';
            End;
            Result := Result + #13#10;
        End;
        StringGrid2.Visible := True;
    End;
    N3.Enabled := True;
end;



Function CheckFileDataForN(Num: String): Boolean;
Const
    MAX_LIM = 99999;
    MIN_LIM = 2;
Var
    NewNum: Integer;
    IsCorrect: Boolean;
Begin
    NewNum := 0;
    IsCorrect := True;
    Num := Trim (Num);
    Try
        NewNum := StrToInt(Num);
    Except
        MessageBox(Form1.Handle, Pchar('Не получилось преобразовать N к целочисленному типу данных. Проверьте корректность данных.'), 'Ошибка', MB_ICONSTOP);
        IsCorrect := False;
    End;
    If(IsCorrect And ((NewNum > MAX_LIM) Or (NewNum < MIN_LIM))) Then
    Begin
        Num := IntToStr(NewNum);
        MessageBox(Form1.Handle, Pchar('N вне разрешенного диапазона! Проверьте исходные данные.'), 'Ошибка', MB_ICONSTOP);
        IsCorrect := False;
    End;
    CheckFileDataForN := IsCorrect;
End;


Function Open (): String;
Begin
    With Form1 Do
    Begin
        If OpenDialog1.Execute Then
        Begin
            Path := OpenDialog1.FileName;
            IsFileOpen := True;
        End
        Else
            IsFileOpen := False;
    End;
    Open := Path;
End;

Function TakeDataFromFile2(Number2: String; Var FileOutput: TextFile): String;
Var               //N
    IsRight : Boolean;
Begin
    IsRight := True;
    Try
        Readln(FileOutput, Number2);
        Number2 := Trim (Number2);
        IsRight := CheckFileDataForN(Number2);
    Except
    End;
    If(Not(IsRight)) Then
        TakeDataFromFile2 := ''
    Else
        TakeDataFromFile2 := Number2;
End;


function SeparateString (Str : String) : TStr;
Var
    StrArr : TStr;
    I, K : Integer;
    Flag : Boolean;
Begin
    K := 0;
    SetLength(StrArr, (Str.Length div 2) + 1);
    For I := 0 To Str.Length div 2 do
        StrArr[i] := '';
    I := 1;
    While I <= Str.Length Do
    begin
        Flag := true;
        While (Str[I] <> ' ') and (I <= Str.Length) Do
        Begin
            StrArr[K] := StrArr[K] + Str[I];
            Inc(I);
            Flag := False;
        End;
        If Not(Flag) then
            Inc(K);
        If Flag then
            Inc(I);
    end;
    I := 1;
    K := 0;
    While Str[I] <> '' Do
    Begin
        If Str[I] = ' ' then
            Inc(K);
        Inc(I);
    End;
    SetLength(StrArr, K + 1);
    Result := StrArr;
End;

function ConvertStringToArray (StringGridColCount : Integer; Var FileOutput: TextFile) : TVector;
Var
    I: Integer;
    Arr : TVector;
    Str : String;
    StrArr : TStr;
Const
    MIN = -9999;
    MAX = 99999;
Begin
    Readln(FileOutput, Str);
    SetLength(Arr, StringGridColCount);
    for I := Low(Arr) to High(Arr) do
        Arr[I] := 0;
    Str := Trim(Str);
    StrArr := SeparateString (Str);
    If (High(StrArr) + 1 <> StringGridColCount) then
    begin
        SetLength (Arr, 1);
        Arr[0] := BAD;
        MessageBox(Form1.Handle, Pchar('Количество элементов массива не совпадает с заявленным. Проверьте исходные данные.'), 'Ошибка', MB_ICONSTOP);
        ConvertStringToArray := Arr;
        Exit
    end;
    try
        For I := Low(Arr) to High(Arr) do
            Arr[I] := StrToInt (StrArr[I]);
    except
        SetLength (Arr, 1);
        Arr[0] := BAD;
        MessageBox(Form1.Handle, Pchar('Не удалось преобразовать исходные данные в целочисленный тип. Проверьте исходные данные.'), 'Ошибка', MB_ICONSTOP);
        ConvertStringToArray := Arr;
        Exit
    end;
    For I := Low(Arr) to High(Arr) do
        If (Arr[I] > MAX) or (Arr[I] < MIN) then
        begin
            SetLength (Arr, 1);
            Arr[0] := BAD;
            MessageBox(Form1.Handle, Pchar('Исходные данные выходят за границы допустимых. Проверьте исходные данные.'), 'Ошибка', MB_ICONSTOP);
            ConvertStringToArray := Arr;
        end;
    ConvertStringToArray := Arr;
End;


procedure TForm1.N2Click(Sender: TObject);
Var
    FileInput: TextFile;
    Num, I, J: Integer;
    Str1 : String;
    //Str1 : Array Of String;
    Arr : TVector;
    Counter : Integer;
begin
    Num := 0;
    Path := Open;
    AssignFile(FileInput, Path);
    Reset(FileInput);
    If(IsFileOpen) Then
    Begin
        Str1 := TakeDataFromFile2(IntToStr(Num), FileInput);
    End;
    if Not(Str1 = '') then
    Begin
        Edit1.Text := Str1;
        Button2.Click;
    End
    Else
    Begin
        Edit1.Text := #0;
    End;
    Counter := 0;
    if (Str1 <> '') then
        Begin
            For J := 0 To StrToInt(Str1) - 1 Do
            Begin
                Arr := ConvertStringToArray(StrToInt(Str1), FileInput);
                if (Arr[0] <> BAD) then
                Begin
                    for I := Low(Arr) to High(Arr) do
                    Begin
                        StringGrid1.Cells[I, J] := IntToStr(Arr[I]);
                        Inc (Counter);
                    End;
                End
                else
                Begin
                    for I := Low(Arr) to StrToInt(Str1) - 1 do
                    Begin
                        StringGrid1.Cells[J, I] := '';
                    End;
                    Edit1.Text := '';
                    Exit
                End;
            End;
            If Counter = StrToInt(Str1) * StrToInt(Str1)  then
                Button1.Visible := True
            else
            begin
                Button1.Visible := False;
            end;
            StringGrid2.Visible := False;
        End;
    CloseFile(FileInput);
end;




procedure TForm1.N3Click(Sender: TObject);
Var
    FileOutput: TextFile;
    IsCorrect : Boolean;
begin
    IsCorrect := True;
    Path := Open;
    If (IsFileOpen) Then
    Begin
        try
            AssignFile(FileOutput, Path);
            Rewrite(FileOutput);
            Write(FileOutput, Result);
        except
            IsCorrect := False;
            Application.MessageBox('Запись в файл не удалась.', 'Ошибка', MB_ICONSTOP);
        end;
        if IsCorrect then
        Begin
            Application.MessageBox('Запись файла выполнена успешно.', 'Результат', 0);
            CloseFile(FileOutput);
        End;
    End;
end;
end.