(Delphi) lab 4.2 MainForm

unit lab4_2;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.Menus,
  Vcl.Imaging.pngimage, Vcl.ExtCtrls, ClipBrd;

type
  TMainForm = class(TForm)
    AnsLabel: TLabel;
    Image1: TImage;
    MainMenu: TMainMenu;
    N1: TMenuItem;
    OpenFileMenu: TMenuItem;
    SaveToFileMenu: TMenuItem;
    N4: TMenuItem;
    NValueEdit: TEdit;
    NValueLabel: TLabel;
    outputLabel: TLabel;
    ResultButton: TButton;
    SumEdit: TEdit;
    SumLabel: TLabel;
    OpenFromFile: TOpenDialog;
    SaveToFile: TSaveDialog;
    procedure EditChange(Sender: TObject);
    procedure KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure IntEditPress(Sender: TObject; var Key: Char);
    procedure CutClick(Sender: TObject);
    procedure CopyClick(Sender: TObject);
    procedure DeleteClick(Sender: TObject);
    procedure ResultButtonClick(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure DeveloperInfoClick(Sender: TObject);
    procedure OpenFromFileMenuClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure SaveToFileMenuClick(Sender: TObject);


  private
    { Private declarations }
    id1: Integer;
  public
    { Public declarations }
  end;

var
  MainForm: TMainForm;

type
    Ind = array of Integer;
    AnswerMatrix = array of array of Integer;
    Boolmatrix = array of array of boolean;

implementation

{$R *.dfm}



procedure TMainForm.CopyClick(Sender: TObject);
begin
    if PopupMenu.PopupComponent = NValueEdit then
    begin
        ClipBoard.AsText := NValueEdit.Text;
    end;
    if PopupMenu.PopupComponent = SumEdit then
    begin
        ClipBoard.AsText := SumEdit.Text;
    end;
end;

procedure TMainForm.CutClick(Sender: TObject);
begin
    if PopupMenu.PopupComponent = NValueEdit then
    begin
        ClipBoard.AsText := NValueEdit.Text;
        NValueEdit.Text := '';
    end;
    if PopupMenu.PopupComponent = SumEdit then
    begin
        ClipBoard.AsText := SumEdit.Text;
        SumEdit.Text := '';
    end;
end;

procedure TMainForm.DeleteClick(Sender: TObject);
begin
    if PopupMenu.PopupComponent = NValueEdit then
    begin
        NValueEdit.Text := '';
    end;
    if PopupMenu.PopupComponent = SumEdit then
    begin
        SumEdit.Text := '';
    end;
end;

procedure TMainForm.DeveloperInfoClick(Sender: TObject);
begin
    Application.MessageBox('Студент группы 151002 Вакарь Егор', 'О разработчике');
end;

procedure TMainForm.EditChange(Sender: TObject);
begin
    OutputLabel.Caption := '';
    MainForm.SaveToFileMenu.Enabled := False;
end;

procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
Var
    WND: HWND;
    lpCaption, lpText: PChar;
    Tip: Integer;
Begin
    WND := MainForm.Handle;
    lpCaption := 'Выход';
    lpText := 'Вы уверены, что хотите выйти?';
    Tip := MB_YESNO + MB_ICONINFORMATION + MB_DEFBUTTON2;
    Case MessageBox(WND, lpText, lpCaption, Tip) Of
        IDYES : CanClose := True;
        IDNO : CanClose := False;
    End
End;


procedure TMainForm.FormCreate(Sender: TObject);
const
     VK_F1Ex    = $70;
begin
    id1 := GlobalAddAtom('Hotkey1');
    RegisterHotKey(Handle, id1, 0,VK_F1Ex);
end;

procedure TMainForm.IntEditPress(Sender: TObject; var Key: Char);
begin
    if (TEdit(Sender).Text = '') and (Key = '0') then
        Key := #0;
    if not(Key in ['0'..'9', #08]) then
        Key := #0;
    if (Length(TEdit(Sender).Text) = 2) and not(Key = #08) then
        Key := #0;
end;

procedure TMainForm.KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
    TEdit(Sender).ReadOnly := (((Shift=[ssShift]) and (Key = VK_INSERT)) or (Shift=[ssCtrl]) or (Shift=[ssAlt]));
end;

procedure TMainForm.OpenFromFileMenuClick(Sender: TObject);
Var
    i: Integer;
    TempString: String;
    IsCorrect: Boolean;
    InputFile: TextFile;
Begin
    isCorrect := False;
    If OpenFromFile.Execute() Then
    Begin
        try
            AssignFile(InputFile, OpenFromFile.FileName);
            Reset(InputFile);
            IsCorrect := True;
            i := 0;
            while IsCorrect and  not Eof(InputFile) do
            Begin
                Read(InputFile, TempString);
                try
                    if (i = 0) then
                    begin
                        if (StrToInt(TempString) < 1) or (StrToInt(TempString) > 15) then
                            IsCorrect := False
                        else
                            NValueEdit.Text := TempString;
                    end;
                    if (i = 1) then
                    begin
                        if (StrToInt(TempString) < 1) or (StrToInt(TempString) > 99) then
                            IsCorrect := False
                        else
                            SumEdit.Text := TempString;
                    end;
                except
                    IsCorrect := False;
                end;
                Readln(InputFile);
                Inc(i);
            end;
        except
            IsCorrect := False
        end;
    End;
    if (i <> 2) or not(IsCorrect) then
    begin
        NValueEdit.Text := '';
        SumEdit.Text := '';
        CloseFile(InputFile);
        Application.MessageBox('Данные в файле некорректны, попробуйте ещё раз.', 'Ошибка!', MB_ICONERROR);
    end
    else
        CloseFile(InputFile);
        ResultButton.Click;
end;

procedure findSubsetsRec(arr: Ind; i, sum: Integer; var indexes: Ind; isFine: Boolmatrix; var ans: AnswerMatrix; var Counter: Integer);
var
    j: Integer;
begin
        if ((i = 0) and (sum <> 0) and (isFine[0][sum])) then
        begin
            j:= 0;
            while (indexes[j]<> 0) do
            begin
                Inc(j);
            end;
            indexes[j] := arr[i];
            j:= 0;
            while (indexes[j]<> 0) do
            begin
                ans[counter][j] := indexes[j];
                Inc(j);
            end;
            Inc(Counter);
            j:= 0;
            while (indexes[j]<> 0) do
            begin
                indexes[j] := 0;
                Inc(j);
            end;
            Exit;
        end;
        if ((i = 0) and (sum = 0)) then
        begin
            j:= 0;
            while (indexes[j]<> 0) do
            begin
                ans[counter][j] := indexes[j];
                Inc(j);
            end;
            Inc(Counter);
            j:= 0;
            while (indexes[j]<> 0) do
            begin
                indexes[j] := 0;
                Inc(j);
            end;
            Exit;
        end;
        if (isFine[i - 1][sum]) then
        begin
            findSubsetsRec(arr, i - 1, sum, indexes, isFine, ans, Counter);
        end;
        if ((sum >= arr[i]) and (isFine[i - 1][sum - arr[i]])) then
        begin
            j:= 0;
            while (indexes[j]<> 0) do
            begin
                Inc(j);
            end;
            indexes[j] := arr[i];
            findSubsetsRec(arr, i - 1, sum - arr[i], indexes, isFine, ans, Counter);
        end;
end;

function FindAllSubsets(n, sum: Integer; arr: Ind; isFine: Boolmatrix; var Ans: AnswerMatrix; var counter: Integer): AnswerMatrix;
var
    i, j: Integer;
    indexes: Ind;
begin
    Counter := 0;
    Setlength(indexes, n);
    for i := 0 to n - 1 do
        indexes[i] := 0;
    for i := 0 to (n - 1) do
        isFine[i][0] := True;
    if (arr[0] <= sum) then
        isFine[0][arr[0]] := true;
    for i := 1 to n - 1 do
        for j := 0 to sum do
            if (arr[i] <= j) then
                isFine[i][j] := (isFine[i - 1][j] or isFine[i - 1][j - arr[i]])
            else
                isFine[i][j] := isFine[i - 1][j];
        if not(isFine[n - 1][sum]) then
        begin
            findAllSubsets(n, sum - 1, arr, isFine, ans, Counter);
            FindAllSubsets := ans;
        end;
        findSubsetsRec(arr, n - 1, sum, indexes, isFine, ans, Counter);
        FindAllSubsets := ans;
end;

Function allSum(n: Integer): Integer;
var
    i, sum: Integer;
begin
    sum := 0;
    for i := 1 to n do
        sum := sum + i;
    allSum := sum;
end;

procedure TMainForm.ResultButtonClick(Sender: TObject);
var
    indexes: Ind;
    i, j, n, sum, counter, chek: Integer;
    answer: AnswerMatrix;
    bool: Boolmatrix;
    Temp, TempN, TempA: String;
    isCorrect: Boolean;
begin
    try
        isCorrect := (NValueEdit.Text <> '') and (SumEdit.Text <> '') and (StrToInt(NValueEdit.Text) > 0) and (StrToInt(NValueEdit.Text) < 16) and (StrToInt(SumEdit.Text) > 0) and (StrToInt(SumEdit.Text) < 100);
    except
        isCorrect := False;
    end;
    if(isCorrect) then
    begin
        n := StrToInt(NValueEdit.text);
        sum := StrToInt(SumEdit.text);
        counter := 0;
        Setlength(bool, n, sum + 1);
        SetLength(indexes, n);
        for i := 0 to n - 1 do
            indexes[i] := i + 1;
        Setlength(answer,10000,n);
        answer[0][0] := 0;
        if allSum(n) > sum then
        begin
            answer := FindAllSubsets(n, sum, indexes, bool, answer, counter);
            i := 0;
            j := 0;
            while (answer[i][j] <> 0 ) and (i < 1) do
            begin
                if i <> 0 then
                begin
                    Temp := outputLabel.Caption;
                    chek := 0;
                end;
                outputLabel.Caption := '';
                while (answer[i][j] <> 0) do
                begin
                    chek := chek + answer[i][j];
                    OutputLabel.Caption := outputLabel.Caption + '[' + IntToStr(answer[i][j]) + '] ';
                    outputLabel.Width := outputLabel.Width + 200;
                    Inc(j);
                end;
            end;
            SaveToFileMenu.Enabled := true;
        end
        else
        begin
            Temp := '';
            outputLabel.Width := outputLabel.Width + 200;
            for i := Length(indexes) - 1 downto 0 do
                Temp := Temp + '[' + IntToStr(indexes[i]) + '] ';
            OutputLabel.Caption := Temp;
            SaveToFileMenu.Enabled := true;
        end;
    end
    else
    begin
        TempN := NValueEdit.Text;
        TempA := SumEdit.Text;
        NValueEdit.Text := '';
        SumEdit.Text := '';
        if (TempN = '') or (TempA = '') then
            Application.MessageBox('Не все ячейки заполнены.', 'Ошибка!', MB_ICONERROR)
        else
            if (StrToInt(TempN) > 15) or  (StrToInt(TempA) > 99) then
                Application.MessageBox('Введённые числа не входят в указанный диапазон'#13#10'Величина n: 1..15'#13#10'Величина А: 1..99', 'Ошибка!', MB_ICONERROR);
    end;
end;



procedure TMainForm.SaveToFileMenuClick(Sender: TObject);
Var
    OutputFile: TextFile;
Begin
    If SaveToFile.Execute() And FileExists(SaveToFile.FileName) Then
    Begin
        AssignFile(OutputFile, SaveToFile.FileName);
        Try
            Rewrite(OutputFile);
        Except
            Application.MessageBox('Отказано в доступе! Измените параметры файла! ', 'Ошибка!', MB_ICONERROR);
        End;
        Writeln(OutputFile, NValueLabel.Caption, ' ', NValueEdit.Text, #13#10, SumLabel.Caption, ' ', SumEdit.Text, #13#10, AnsLabel.Caption, ' ', outputLAbel.Caption);
        CloseFile(OutputFile);
        Application.MessageBox('Данные успешно записаны в файл!', 'Сохранение', MB_ICONINFORMATION);
    End
    Else
        Application.MessageBox('Введено некорректное имя файла', 'Ошибка!', MB_ICONERROR);

End;

end.