Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- 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, System.Math;
- type
- TForm1 = class(TForm)
- Edit1: TEdit;
- Edit2: TEdit;
- StringGrid1: TStringGrid;
- Label1: TLabel;
- Label2: TLabel;
- Label3: TLabel;
- Label4: TLabel;
- Button1: TButton;
- OpenDialog1: TOpenDialog;
- SaveDialog1: TSaveDialog;
- MainMenu1: TMainMenu;
- PopupMenu1: TPopupMenu;
- N1: TMenuItem;
- N2: TMenuItem;
- N3: TMenuItem;
- N5: TMenuItem;
- procedure Edit1Change(Sender: TObject);
- procedure Edit1KeyPress(Sender: TObject; var Key: Char);
- procedure Button1Click(Sender: TObject);
- procedure Edit2KeyPress(Sender: TObject; var Key: Char);
- procedure Edit2Change(Sender: TObject);
- procedure N5Click(Sender: TObject);
- procedure N2Click(Sender: TObject);
- procedure N3Click(Sender: TObject);
- procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
- private
- { Private declarations }
- public
- { Public declarations }
- end;
- type
- TArr = Array of Integer;
- var
- Form1: TForm1;
- N : Integer;
- Arr : TArr;
- IsCorrect, IsFileOpen : Boolean;
- Path, Result : String;
- implementation
- {$R *.dfm}
- function DeleteRepetitions (Arr : TArr) : TArr;
- var
- I, J, Counter : Integer;
- IsRepetitionExist : Boolean;
- ArrWithoutRepeats : TArr;
- begin
- SetLength(ArrWithoutRepeats, Length(Arr));
- Counter := 0;
- For I := Low(Arr) To High(Arr) Do
- begin
- IsRepetitionExist := False;
- For J := Low(ArrWithoutRepeats) to High(ArrWithoutRepeats) Do
- Begin
- If Arr[I] = ArrWithoutRepeats[J] then
- IsRepetitionExist := True;
- End;
- If Not(IsRepetitionExist) then
- Begin
- ArrWithoutRepeats[Counter] := Arr[I];
- Inc(Counter);
- End;
- end;
- SetLength(ArrWithoutRepeats, Counter);
- DeleteRepetitions := ArrWithoutRepeats;
- end;
- procedure TForm1.Button1Click(Sender: TObject);
- Const
- WIDE = 82;
- HEIGHT = 35;
- SCROLLBAR = 17;
- Var
- I, J, Number, K, Index, Max, LastI: Integer;
- Str, Element: String;
- IsSmthWrong, WillAdd: Boolean;
- begin
- If IsCorrect then
- begin
- IsSmthWrong := True;
- SetLength(Arr, N);
- StringGrid1.ColCount := N + 1;
- StringGrid1.Width := WIDE * 6 + + SCROLLBAR;
- StringGrid1.ScrollBars := ssBoth;
- If N < 6 then
- Begin
- StringGrid1.ScrollBars := ssVertical;
- case N of
- 1: StringGrid1.Width := WIDE * 1;
- 2: StringGrid1.Width := WIDE * 2 + 1;
- 3: StringGrid1.Width := WIDE * 3;
- 4: StringGrid1.Width := WIDE * 4 + SCROLLBAR;
- 5: StringGrid1.Width := WIDE * 5 - 10;
- end;
- End;
- For I := 0 to StringGrid1.RowCount - 1 do
- For J := 0 to StringGrid1.ColCount - 1 do
- StringGrid1.Cells[J, I] := '';
- Str := Trim(Edit2.Text);
- Str := Str + ' ';
- I := 1;
- K := 0;
- try
- While (I <> (Length(Str) + 1)) and (IsSmthWrong) Do
- Begin
- If (Str[I] <> ' ') then
- Element := Element + Str[I]
- else
- Begin
- Number := StrToInt(Element);
- try
- Arr[K] := Number;
- except
- IsSmthWrong := False;
- end;
- Inc(K);
- Element := '';
- End;
- Inc(I);
- If ((K) > N) then
- begin
- MessageBox(Form1.Handle, Pchar('Вы ввели больше ' + Edit1.Text + ' элементов.'), 'Ошибка', MB_ICONSTOP);
- IsSmthWrong := False;
- Edit2.Text := '';
- StringGrid1.Visible := False;
- end;
- End;
- except
- Edit2.Text := '';
- IsSmthWrong := False;
- StringGrid1.Visible := False;
- MessageBox(Form1.Handle, Pchar('Проверьте последовательность, там должны быть только положительные цифры.'), 'Ошибка', MB_ICONSTOP);
- end;
- If ((K) < N) and IsSmthWrong then
- begin
- MessageBox(Form1.Handle, Pchar('Вы ввели меньше ' + Edit1.Text + ' элементов.'), 'Ошибка', MB_ICONSTOP);
- IsSmthWrong := False;
- Edit2.Text := '';
- StringGrid1.Visible := False;
- end;
- If IsSmthWrong then
- Begin
- LastI := 0;
- Arr := DeleteRepetitions(Arr);
- Max := Trunc(Power(2, Length(Arr)));
- For I := 0 To (Max - 1) Do
- Begin
- WillAdd := False;
- K := I;
- J := 0;
- Index := 0;
- While (K > 0) Do
- begin
- If (K and 1) = 1 then
- Begin
- StringGrid1.Cells[J, I - 1] := IntToStr(Arr[Index]);
- Inc(J);
- WillAdd := True;
- End;
- K := K div 2;
- Inc(Index);
- end;
- If WillAdd then
- StringGrid1.RowCount := StringGrid1.RowCount + 1;
- LastI := I;
- End;
- StringGrid1.Cells[0, LastI] := '{ }';
- StringGrid1.Visible := True;
- N3.Enabled := True;
- End;
- end;
- end;
- procedure TForm1.Edit1Change(Sender: TObject);
- begin
- IsCorrect := True;
- StringGrid1.Visible := False;
- N3.Enabled := False;
- StringGrid1.RowCount := 1;
- try
- N := StrToInt(Edit1.Text);
- except
- IsCorrect := False;
- end;
- If (Edit1.Text <> '') and (Edit2.Text <> '') then
- Button1.Enabled := True
- else
- Button1.Enabled := False;
- end;
- procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
- begin
- If (Key = #13) and (Button1.Enabled) then
- Button1.Click;
- If (Not(Key In ['1'..'9', #08, #46])) Then
- Key := #0;
- end;
- procedure TForm1.Edit2Change(Sender: TObject);
- begin
- If (Edit1.Text <> '') and (Edit2.Text <> '') then
- Button1.Enabled := True
- else
- Button1.Enabled := False;
- StringGrid1.RowCount := 1;
- N3.Enabled := False;
- end;
- procedure TForm1.Edit2KeyPress(Sender: TObject; var Key: Char);
- begin
- If (Key = #13) and (Button1.Enabled) then
- Button1.Click;
- If (Not(Key In ['0'..'9', #08, #46, #32])) Then
- Key := #0;
- end;
- procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
- begin
- CanClose := Application.MessageBox('Вы действительно хотите выйти?', 'Выход', MB_YESNO + MB_ICONQUESTION) = ID_YES;
- end;
- procedure TForm1.N5Click(Sender: TObject);
- begin
- Application.MessageBox('Арефин Владислав гр.251004', 'Разрабочик', 0);
- end;
- Function CheckFileData(Num: String): Boolean;
- Const
- MAX_LIM = 9;
- MIN_LIM = 1;
- Var
- NewNum: Integer;
- IsCorrect: Boolean;
- Begin
- NewNum := 0;
- IsCorrect := True;
- Try
- NewNum := StrToInt(Num);
- Except
- MessageBox(Form1.Handle, Pchar('Проверьте корректность данных.'), 'Ошибка', MB_ICONSTOP);
- IsCorrect := False;
- End;
- If(IsCorrect And ((NewNum > MAX_LIM) Or (NewNum < MIN_LIM))) Then
- Begin
- Num := IntToStr(NewNum);
- MessageBox(Form1.Handle, Pchar('Недопустимое значение!'), 'Ошибка', MB_ICONSTOP);
- IsCorrect := False;
- End;
- CheckFileData := 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 TakeDataFromFile( Var FileOutput: TextFile): String;
- Var
- IsRight : Boolean;
- Str : String;
- Begin
- IsRight := True;
- Try
- Readln(FileOutput, Str);
- IsRight := CheckFileData(Str);
- Except
- End;
- If(Not(IsRight)) Then
- TakeDataFromFile := ''
- Else
- TakeDataFromFile := Str;
- End;
- Function Take2FromFile(Var FileOutput: TextFile): String;
- Var
- IsRight : Boolean;
- Str : String;
- Begin
- IsRight := True;
- Try
- Readln(FileOutput, Str);
- Except
- IsRight := False;
- End;
- If(Not(IsRight)) Then
- Take2FromFile := ''
- Else
- Take2FromFile := Str;
- End;
- procedure TForm1.N2Click(Sender: TObject);
- Var
- FileInput: TextFile;
- Str1, Str2: String;
- begin
- Path := Open;
- AssignFile(FileInput, Path);
- AssignFile(FileInput, Path);
- If ExtractFileExt(Path) <> '.txt' then
- raise Exception.Create('Файл должен быть текстовым. Проверьте исходные данные.');
- Reset(FileInput);
- If(IsFileOpen) Then
- Begin
- Str1 := TakeDataFromFile(FileInput);
- Str2 := Take2FromFile(FileInput);
- End;
- if (Length(Str1) > 0) then
- Begin
- Edit1.Text := Str1;
- End
- Else
- Edit1.Text := #0;
- if (Length(Str2) > 0) and ((Length(Str1) > 0))then
- Begin
- Edit2.Text := Str2;
- End
- Else
- Edit2.Text := #0;
- CloseFile(FileInput);
- end;
- procedure TForm1.N3Click(Sender: TObject);
- Var
- FileOutput: TextFile;
- begin
- Path := Open;
- If (IsFileOpen) Then
- Begin
- AssignFile(FileOutput, Path);
- Rewrite(FileOutput);
- Write(FileOutput, Result);
- Application.MessageBox('Запись файла выполнена успешно.', 'Результат', 0);
- CloseFile(FileOutput);
- End;
- end;
- end.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement