laba_5_3_del

unit laba_5_3_f1_v2;

interface

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

type
    TArrStr = Array of String;
    TArrInt = Array of Integer;

    TFormMain = class(TForm)
    MainMenu1: TMainMenu;
    NHelp: TMenuItem;
    NAuthor: TMenuItem;
    OpenDialog1: TOpenDialog;
    NFile: TMenuItem;
    NOpen: TMenuItem;
    NSaveAs: TMenuItem;
    SaveDialog1: TSaveDialog;
    NSave: TMenuItem;
    NTask: TMenuItem;
    MemoOutput: TMemo;
    ButtonAccept: TButton;
    LabelAnswer: TLabel;
    BalloonHint1: TBalloonHint;
    TrackBar1: TTrackBar;
    Label3: TLabel;
    Label5: TLabel;
    Label7: TLabel;
    procedure NAuthorClick(Sender: TObject);
    procedure NOpenClick(Sender: TObject);
    procedure NSaveAsClick(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure FormCreate(Sender: TObject);
    procedure NSaveClick(Sender: TObject);
    procedure NTaskClick(Sender: TObject);
    procedure ButtonAcceptClick(Sender: TObject);
    procedure OutputAnswer(SizeOfArr: Byte);
    procedure TrackBar1Change(Sender: TObject);

    private
        StrFile: String;
        IsSaved: Boolean;
    public

    end;

const
    RegExForNumber = '[1-9]\d{0,2}';
    CaptionHereWillBeAnswer = 'Здесь будет ответ';

var
    FormMain: TFormMain;

implementation
{$R *.dfm}

function FindRegEx(SInput, StrRegEx: String; StrIfNothingFound: String = '') : TArrStr; forward;

//******************************************************************************
// Ввод данных

procedure TFormMain.ButtonAcceptClick(Sender: TObject);
var
    SizeOfArr: Byte;

begin
    SizeOfArr := 3 + TrackBar1.Position * 2;

    OutputAnswer(SizeOfArr);
    NSave.Enabled := StrFile <> '';
end;

procedure TFormMain.OutputAnswer(SizeOfArr: Byte);
var
    Arr: Array Of TArrInt;
    i, j, NCount, Num, WhenToStop: Integer;
    Nums: TArrInt;
    Str1: String;

begin
    MemoOutput.Clear();

    SetLength(Arr, SizeOfArr, SizeOfArr);
    for i := 0 to SizeOfArr - 1 do
        for j := 0 to SizeOfArr - 1 do
            Arr[i][j] := 0;

    NCount := 1;
    i := 0;
    j := SizeOfArr div 2;
    WhenToStop := SizeOfArr * SizeOfArr;

    repeat
        Arr[i][j] := NCount;

        Dec(i);
        Inc(j);

        if (i < 0) then i := SizeOfArr - 1;
        if (j > SizeOfArr - 1) then j := 0;

        if (Arr[i][j] <> 0) then
        begin
            i := i + 2;
            Dec(j);;
        end;

        if (i > SizeOfArr - 1) then i := i - SizeOfArr;
        if (j < 0) then j := SizeOfArr - 1;

        MemoOutput.Lines.Add('Шаг ' + IntToStr(NCount) + ':');
        for Nums in Arr do
        begin
            Str1 := '';
            for Num in Nums do
                Str1 := Str1 + format('%-3d', [Num]);

            MemoOutput.Lines.Add(Str1);
        end;
        MemoOutput.Lines.Add('');

        Inc(NCount);
    until (NCount > WhenToStop);

    NSaveAs.Enabled := True;
    if StrFile <> '' then
        NSave.Enabled := True;
end;


procedure TFormMain.TrackBar1Change(Sender: TObject);
begin
    MemoOutput.Clear();
    NSaveAs.Enabled := False;
    NSave.Enabled := False;
end;

//******************************************************************************
// Работа с файлами

procedure TFormMain.NOpenClick(Sender: TObject);
const
    ErrorDuringInputOccured = 'Возникла ошибка при открытии файла.' + #10#13 +
                'Пожалуйста, выберите файл нужного формата(.datgrad) с ' +
                'корректными данными.';

var
    FileInput : TextFile;
    PathToFile, String1, Input: String;

begin
    if not IsSaved and (MessageDlg('Вы хотите сохранить текущие данные?' +
        #10#13 + 'Иначе после открытия файла текущие записи будут удалены.',
        mtConfirmation, [mbYes, mbNo], 0) = mrYes) then
        NSaveClick(Self);

    if (IsSaved or (MessageDlg('Вы уверены, что хотите открыть другой файл?' + #10#13 +
        'Все текущие записи будут удалены.', mtConfirmation, [mbYes, mbCancel], 0) = mrYes))
        and OpenDialog1.Execute then
    begin
        PathToFile := OpenDialog1.FileName;
        try
            AssignFile(FileInput, PathToFile);
            Reset(FileInput);

            Readln(FileInput, String1);

            Input := FindRegEx(String1, '^\s*[357]\s*$')[0];
            if Input <> '' then
                OutputAnswer(StrToInt(Input))
            else
                ShowMessage('Ошибка. В первой строке файла должно быть нечётное число от 3 до 7.');

            CloseFile(FileInput);
        except
            ShowMessage(ErrorDuringInputOccured);
        end;
    end;
end;

procedure TFormMain.NSaveAsClick(Sender: TObject);
var
    FileOutput : TextFile;
    StrFilePath: String;
    ShouldNotRepeat: Boolean;
    Point: TPoint;

begin
    try
        repeat
            ShouldNotRepeat := True;
            if SaveDialog1.Execute then
            begin
                StrFilePath := SaveDialog1.FileName;
                StrFilePath := FindRegEx(StrFilePath, '.+\.txt', StrFilePath + '.txt')[0];

                if FileExists(StrFilePath) then
                    if MessageDlg('Такой файл уже существует.' +
                        #10#13 + 'Вы хотите перезаписать файл? Это действие невозможно отменить.',
                        mtConfirmation, [mbYes, mbNo], 0) = mrYes then
                        ShouldNotRepeat := True
                    else
                        ShouldNotRepeat := False
                else
                    ShouldNotRepeat := True;

                if ShouldNotRepeat then
                begin
                    AssignFile(FileOutput, StrFilePath);
                    Rewrite(FileOutput);

                    Write(FileOutput, MemoOutput.Text + #10#13);

                    CloseFile(FileOutput);
                    IsSaved := True;
                    BalloonHint1.Title := 'Готово';
                    BalloonHint1.Description := 'Ответ успешно записан в файл.';
                    Point.X := Round(MemoOutput.Left + MemoOutput.Width * 2 / 3);
                    Point.Y := MemoOutput.Top + MemoOutput.Height;
                    Balloonhint1.ShowHint(ClientToScreen(Point));

                    NSave.Enabled := True;
                    StrFile := StrFilePath;
                end;
            end;
        until ShouldNotRepeat;
    except
       ShowMessage('Не удается открыть файл для вывода данных или записать в него данные.');
    end;
end;

procedure TFormMain.NSaveClick(Sender: TObject);
var
    FileOutput : TextFile;

begin
    if MessageDlg('Вы хотите перезаписать файл "' + StrFile + '"?' + #10#13 +
        'Это действие невозможно отменить.', mtConfirmation, [mbYes, mbNo], 0) = mrYes then
        if FileExists(StrFile) then
        begin
            AssignFile(FileOutput, StrFile);
            Rewrite(FileOutput);

            Write(FileOutput, MemoOutput.Text + #10#13);

            CloseFile(FileOutput);
            IsSaved := True;
        end
        else
        begin
            ShowMessage('Этого файла уже не существует.');
            StrFile := '';
            NSave.Enabled := False;
            NSaveAsClick(Self);
        end;
end;


//******************************************************************************
// Form Create

procedure TFormMain.FormCreate(Sender: TObject);
begin
    StrFile := '';
    IsSaved := True;
    MemoOutput.Text := CaptionHereWillBeAnswer;
end;

//******************************************************************************
// Прочее

procedure TFormMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
    CanClose := IsSaved or (MessageDlg('Вы уверены, что хотите выйти из программы?' +
        #10#13 + 'Все несохранённые данные будут утеряны.',
        mtConfirmation, [mbYes, mbNo], 0) = mrYes);
end;

procedure TFormMain.NAuthorClick(Sender: TObject);
begin
    ShowMessage('Панев Александр, гр. 051007' + #10#13 + 'Минск, 2021');
end;

procedure TFormMain.NTaskClick(Sender: TObject);
begin
    ShowMessage('Построить квадрат нечётного порядка и визувлизировать построение.');
end;

function FindRegEx(SInput, StrRegEx: String; StrIfNothingFound: String = '') : TArrStr;
var
    ArrStr: TArrStr;
    RegEx: TRegEx;
    MatchCollection: TMatchCollection;
    i: Integer;
begin
    RegEx := TRegEx.Create(StrRegEx);
    MatchCollection := RegEx.Matches(SInput);
    SetLength(ArrStr, MatchCollection.Count);
    for i := 0 to MatchCollection.Count - 1 do
        ArrStr[i] := MatchCollection.Item[i].Value;

    if (Length(ArrStr) < 1) then
        ArrStr := [StrIfNothingFound];
    Result := ArrStr;
end;

end.