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;
- type
- TForm1 = class(TForm)
- StringGridPoints: TStringGrid;
- EditAmount: TEdit;
- ButtonPoints: TButton;
- Memo1: TMemo;
- ButtonFind: TButton;
- MainMenu1: TMainMenu;
- N1: TMenuItem;
- N2: TMenuItem;
- N3: TMenuItem;
- N4: TMenuItem;
- N5: TMenuItem;
- N6: TMenuItem;
- N7: TMenuItem;
- OpenDialog1: TOpenDialog;
- SaveDialog1: TSaveDialog;
- procedure ButtonFindClick(Sender: TObject);
- procedure FormCreate(Sender: TObject);
- procedure ButtonPointsClick(Sender: TObject);
- procedure EditAmountKeyPress(Sender: TObject; var Key: Char);
- procedure EditAmountChange(Sender: TObject);
- procedure StringGridPointsKeyPress(Sender: TObject; var Key: Char);
- procedure StringGridPointsSetEditText(Sender: TObject; ACol, ARow: Integer;
- const Value: string);
- procedure N3Click(Sender: TObject);
- procedure N7Click(Sender: TObject);
- procedure N4Click(Sender: TObject);
- procedure N5Click(Sender: TObject);
- procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
- procedure N2Click(Sender: TObject);
- private
- { Private declarations }
- public
- { Public declarations }
- end;
- type
- TPoint = record
- X, Y: Double;
- end;
- TLineEquation = class
- private
- FK, FB: Double;
- public
- property K: Double read FK;
- property B: Double read FB;
- function DistanceToLineSquared(X, Y: Double): Double;
- class function FromPoints(X1, Y1, X2, Y2: Double): TLineEquation;
- end;
- var
- Form1: TForm1;
- Path: String;
- IsFileOpen: Boolean;
- implementation
- {$R *.dfm}
- function TLineEquation.DistanceToLineSquared(X, Y: Double): Double;
- var
- Distance: Double;
- begin
- Distance := (FK * X - Y + FB) / Sqrt(FK * FK + 1);
- Result := Distance * Distance;
- end;
- class function TLineEquation.FromPoints(X1, Y1, X2, Y2: Double): TLineEquation;
- var
- Line: TLineEquation;
- begin
- Line := TLineEquation.Create;
- If (X2 - X1) <> 0 Then
- Begin
- Line.FK := (Y2 - Y1) / (X2 - X1);
- Line.FB := Y1 - Line.FK * X1;
- End;
- Result := Line;
- end;
- function FindDividingLine(const Points: TArray<TPoint>): TLineEquation;
- var
- Size, I, J, K: Integer;
- BestError, Error: Double;
- BestLine, CurrentLine: TLineEquation;
- begin
- Size := Length(Points);
- if Size mod 2 <> 0 then
- raise Exception.Create('Количество точек должно быть четным.');
- BestError := Double.MaxValue;
- BestLine := TLineEquation.Create;
- for I := 0 to Size - 1 do
- begin
- for J := I + 1 to Size - 1 do
- begin
- CurrentLine := TLineEquation.FromPoints(Points[I].X, Points[I].Y,
- Points[J].X, Points[J].Y);
- Error := 0;
- for K := 0 to Size - 1 do
- Error := Error + CurrentLine.DistanceToLineSquared(Points[K].X, Points[K].Y);
- if Error < BestError then
- begin
- BestError := Error;
- BestLine := CurrentLine;
- end;
- end;
- end;
- Result := BestLine;
- end;
- procedure TForm1.ButtonFindClick(Sender: TObject);
- var
- Points: TArray<TPoint>;
- Line: TLineEquation;
- I, Size: Integer;
- begin
- Size := StrToInt(EditAmount.Text);
- SetLength(Points, Size);
- For I := 0 to Size - 1 do
- Begin
- Points[I].X := StrToFloat(StringGridPoints.Cells[I + 1, 1]);
- Points[I].Y := StrToFloat(StringGridPoints.Cells[I + 1, 2])
- End;
- Line := FindDividingLine(Points);
- N5.Enabled := True;
- Memo1.Text := 'Уравнение прямой: y = ' + FormatFloat('0.00', Line.K) + 'x + ' + FormatFloat('0.00', Line.B);
- end;
- procedure TForm1.ButtonPointsClick(Sender: TObject);
- var
- Size, I: Integer;
- begin
- StringGridPoints.Enabled := True;
- StringGridPoints.Rows[1].Clear;
- StringGridPoints.Rows[2].Clear;
- StringGridPoints.Cells[0,1] := 'X';
- StringGridPoints.Cells[0,2] := 'Y';
- Size := StrToInt(EditAmount.Text);
- StringGridPoints.ColCount := Size + 1;
- For I := 1 to Size do
- Begin
- StringGridPoints.Cells[I, 0] := IntToStr(I);
- End;
- Memo1.Clear;
- ButtonFind.Enabled := False;
- N5.Enabled := False
- end;
- procedure TForm1.EditAmountChange(Sender: TObject);
- var
- num: Integer;
- IsCorrect: Boolean;
- begin
- IsCorrect := True;
- try
- num := StrToInt(EditAmount.Text)
- except
- IsCorrect := False;
- end;
- If IsCorrect And (num > 0) And (Num < 100) And (Num mod 2 = 0) Then
- Begin
- ButtonPoints.Enabled := True;
- End
- Else
- ButtonPoints.Enabled := False;
- StringGridPoints.Enabled := False;
- ButtonFind.Enabled := False;
- Memo1.Clear;
- N5.Enabled := False
- end;
- procedure TForm1.EditAmountKeyPress(Sender: TObject; var Key: Char);
- begin
- if not (Key in ['0'..'9', #13, #8]) then
- Key := #0;
- if (Key = #13) And (ButtonPoints.Enabled) then
- ButtonPoints.Click;
- end;
- procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
- begin
- CanClose := Application.MessageBox('Вы действительно хотите выйти?', 'Выход', MB_ICONQUESTION + MB_YESNO) = ID_YES
- end;
- procedure TForm1.FormCreate(Sender: TObject);
- var
- I: Integer;
- begin
- StringGridPoints.Cells[0,0] := '№/№';
- StringGridPoints.Cells[0,1] := 'X';
- StringGridPoints.Cells[0,2] := 'Y';
- end;
- procedure TForm1.N2Click(Sender: TObject);
- const
- Info1 = 'На плоскости заданы 2n точек своими координатами. Найти уравнение'#13#10;
- Info2 = 'какой-либо прямой, делящей данное множество на два подмножества по n точек.'#13#10;
- Info3 = '1. Минимальное количество точек - 2, максимальная - 20.'#13#10;
- Info4 = '2. Количество точек должно быть кратно двум.'#13#10;
- Info5 = '3. Диапазон ввода координат от 0 до 99.'#13#10;
- begin
- Application.MessageBox(Info1 + Info2 + Info3 + Info4 + Info5, 'Справка', 0);
- end;
- procedure TForm1.N3Click(Sender: TObject);
- begin
- Application.MessageBox('Сымоник Вадим, гр. 251004', 'Разработчик', 0)
- end;
- Function GetSize(var FileInput: TextFile): String;
- Const
- MIN_NUM = 1;
- MAX_NUM = 100;
- Var
- Size, Num: Integer;
- Str: String;
- IsCorrect: Boolean;
- Begin
- Size := 0;
- Str := '';
- If Not Eof(FileInput) Then
- Begin
- IsCorrect := True;
- Try
- Read(FileInput, Size);
- Except
- MessageBox(Form1.Handle, PChar('Недопустимый размер массива!'),
- 'Ошибка', MB_ICONSTOP);
- IsCorrect := False;
- Size := 0;
- End;
- End
- Else
- MessageBox(Form1.Handle, PChar('Недостаточно данных в файле!'),
- 'Ошибка', MB_ICONSTOP);
- If (Size > 0) And (Size <= MAX_NUM) Then
- If Size mod 2 = 0 Then
- Str := IntToStr(Size)
- Else
- Application.MessageBox('Нечетное количество данных', 'Ошибка', 0)
- Else
- Application.MessageBox('Проверьте корректность данных в файле', 'Ошибка', 0);
- GetSize := Str;
- End;
- Function TakeInformationIntoCell(Var FileInput: TextFile;
- Var IsCorrect: Boolean): String;
- Var
- Temp: Integer;
- Str: String;
- StrTemp: String;
- Begin
- If Not Eof(FileInput) Then
- Begin
- Try
- Read(FileInput, Temp);
- Str := IntToStr(Temp);
- StrTemp := IntToStr(Abs(Temp));
- Except
- MessageBox(Form1.Handle, PChar('Неверные данные!'), 'Ошибка',
- MB_ICONSTOP);
- IsCorrect := False;
- End;
- If Length(StrTemp) > 2 Then
- Begin
- IsCorrect := False;
- MessageBox(Form1.Handle,
- PChar('Недопустимый диапазон входных данных!'), 'Ошибка',
- MB_ICONSTOP);
- Str := '';
- End;
- End
- Else
- Begin
- IsCorrect := False;
- MessageBox(Form1.Handle, PChar('Недостаточно значений в файле!'),
- 'Ошибка', MB_ICONSTOP);
- Str := '';
- End;
- TakeInformationIntoCell := Str;
- End;
- Procedure InputPointsInMatrix(var FileInput: TextFile);
- Var
- I, J: Integer;
- IsCorrect: Boolean;
- Begin
- IsCorrect := True;
- With Form1 do
- Begin
- For I := 1 to StringGridPoints.ColCount - 1 do
- Begin
- For J := 1 to StringGridPoints.RowCount - 1 do
- Begin
- StringGridPoints.Cells[I, J] :=
- TakeInformationIntoCell(FileInput, IsCorrect);
- End;
- End;
- ButtonFind.Enabled := IsCorrect;
- End;
- End;
- procedure TForm1.N4Click(Sender: TObject);
- var
- FileInput: TextFile;
- begin
- If OpenDialog1.Execute Then
- Begin
- AssignFile(FileInput, OpenDialog1.FileName);
- Try
- Try
- Reset(FileInput);
- EditAmount.Text := GetSize(FileInput);
- if EditAmount.Text <> '' then
- Begin
- ButtonPoints.Click;
- InputPointsInMatrix(FileInput);
- End;
- Finally
- CloseFile(FileInput);
- End;
- Except
- End;
- End;
- end;
- Function Open(): String;
- begin
- with Form1 Do
- begin
- If SaveDialog1.Execute Then
- begin
- Path := SaveDialog1.FileName;
- IsFileOpen := True;
- end
- Else
- IsFileOpen := False;
- end;
- Open := Path;
- end;
- procedure TForm1.N5Click(Sender: TObject);
- var
- F: TextFile;
- begin
- Path := Open;
- If IsFileOpen Then
- Begin
- AssignFile(F, Path);
- Rewrite(F);
- Writeln(F, Memo1.Text);
- Application.MessageBox('Данные успешно сохранены в файл',
- 'Результат', 0);
- CloseFile(F);
- End;
- end;
- procedure TForm1.N7Click(Sender: TObject);
- begin
- Form1.Close
- end;
- procedure TForm1.StringGridPointsKeyPress(Sender: TObject; var Key: Char);
- begin
- If not (Key in ['0'..'9', #8, #13]) Then
- Key := #0;
- if (Key = #13) And (ButtonFind.Enabled = True) then
- ButtonFind.Click
- end;
- procedure TForm1.StringGridPointsSetEditText(Sender: TObject; ACol,
- ARow: Integer; const Value: string);
- var
- I, J: Integer;
- N: Integer;
- IsCorrect: Boolean;
- begin
- IsCorrect := True;
- For I := 1 to StringGridPoints.RowCount - 1 do
- Begin
- for J := 1 to StringGridPoints.ColCount - 1 do
- Begin
- If StringGridPoints.Cells[I, J] <> '' Then
- Try
- N := StrToInt(StringGridPoints.Cells[I, J]);
- Except
- StringGridPoints.Cells[I, J] := '';
- Application.MessageBox('Проверьте корректность введенных данных', 'Ошибка', 0);
- End;
- If Length(StringGridPoints.Cells[I, J]) > 2 Then
- Begin
- StringGridPoints.Cells[I, J] := '';
- Application.MessageBox('Диапазон ввода [0; 99]', 'Ошибка', 0);
- End;
- End;
- End;
- For J := 1 to StringGridPoints.RowCount - 1 do
- for I := 1 to StringGridPoints.ColCount - 1 do
- If Length(StringGridPoints.Cells[I, J]) = 0 Then
- IsCorrect := False;
- ButtonFind.Enabled := IsCorrect;
- Memo1.Clear;
- N5.Enabled := False
- end;
- end.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement