laba_6_3_del

unit laba_6_3_UnitMainForm;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls,
  laba_6_3_UnitGraphic, laba_6_3_UnitTypes, laba_6_3_UnitCalculateBestLine,
  Vcl.Menus;

type
  TFormMain = class(TForm)
    MemoCoordinates: TMemo;
    ButtonBuildLine: TButton;
    LabelAboveMemoCoordinates: TLabel;
    ImageCanvas: TImage;
    LabelToMeasureScreenOfUser: TLabel;
    MainMenu1: TMainMenu;
    NFile: TMenuItem;
    NOpen: TMenuItem;
    NHelp: TMenuItem;
    NTask: TMenuItem;
    NAuthor: TMenuItem;
    OpenDialog1: TOpenDialog;
    procedure FormCreate(Sender: TObject);
    procedure MemoCoordinatesChange(Sender: TObject);
    procedure ButtonBuildLineClick(Sender: TObject);
    procedure NTaskClick(Sender: TObject);
    procedure NAuthorClick(Sender: TObject);
    procedure NOpenClick(Sender: TObject);
  private
        MultPix: Single;
        ArrOfCoords: TArrCoord;
  public
        function MultPixels(PixQuant: Integer) : Integer;
  end;

procedure MyMessageBoxInfo(Form: TForm; CaptionWindow, TextMessage: String; IsWarning: Boolean = False); external 'Dll_MyMessageBox.dll';
function MyMessageBoxYesNo(Form: TForm; CaptionWindow, TextMessage: String; IsWarning: Boolean = False) : Boolean; external 'Dll_MyMessageBox.dll';

var
  FormMain: TFormMain;

function FindRegEx(SInput, StrRegEx: String; StrIfNothingFound: String = '') : TArrStr; external 'FindRegExes.dll';

implementation

{$R *.dfm}

procedure TFormMain.ButtonBuildLineClick(Sender: TObject);
var
    KAndB: TKAndB;
    LineIsVertical: Boolean;

begin
    KAndB := GetKAndB(ArrOfCoords, LineIsVertical);
    DrawGraphicWithDots(ArrOfCoords);

    if LineIsVertical then
        DrawLineVertical(KAndB.B)
    else
        DrawLineNotVertical(KAndB.K, KAndB.B);
end;

procedure TFormMain.FormCreate(Sender: TObject);
begin
    MultPix := LabelToMeasureScreenOfUser.Width / 100;

    MemoCoordinates.SelectAll();

    SetupCanvas();
end;

procedure TFormMain.MemoCoordinatesChange(Sender: TObject);
var
    OneLine: String;
    IsCorrect, IsUnique: Boolean;
    i, j, X, Y, PairsFound: Integer;

begin
    i := 0;
    IsCorrect := True;
    PairsFound := 0;
    while i < MemoCoordinates.Lines.Count do
    begin
        OneLine := MemoCoordinates.Lines[i];
        if StringReplace(OneLine, ' ', '', [rfReplaceAll]) <> '' then
        begin
            if FindRegEx(OneLine, '^\s*-?0*\d{1,2}\s+-?0*\d{1,2}\s*$')[0] = '' then
                IsCorrect := False
            else
            begin
                X := StrToInt(FindRegEx(OneLine, '-?0*\d{1,3}')[0]);
                Y := StrToInt(FindRegEx(OneLine, '-?0*\d{1,3}')[1]);

                IsUnique := True;
                j := 0;
                while (j < PairsFound) and IsUnique do
                begin
                    if (ArrOfCoords[j].X = X) and (ArrOfCoords[j].Y = Y) then
                        IsUnique := False;
                    Inc(j);
                end;

                if IsUnique then
                begin
                    Inc(PairsFound);
                    SetLength(ArrOfCoords, PairsFound);
                    ArrOfCoords[PairsFound - 1].X := X;
                    ArrOfCoords[PairsFound - 1].Y := Y;
                end;
            end;
        end;
        Inc(i);
    end;

    ButtonBuildLine.Enabled := IsCorrect and (PairsFound > 1);
end;

function TFormMain.MultPixels(PixQuant: Integer) : Integer;
begin
    Result := Round(PixQuant * MultPix);
end;

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

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

var
    FileInput : TextFile;
    PathToFile, String1: String;

begin
    if OpenDialog1.Execute then
    begin
        MemoCoordinates.Clear;
        PathToFile := OpenDialog1.FileName;
        try
            AssignFile(FileInput, PathToFile);
            Reset(FileInput);

            while not Eof(FileInput) do
            begin
                Readln(FileInput, String1);
                MemoCoordinates.Lines.Add(String1);
            end;

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

procedure TFormMain.NTaskClick(Sender: TObject);
begin
    MyMessageBoxInfo(FormMain, 'Задание', 'На плоскости заданы n точек своими координатами. ' +
    'Найти уравнение прямой, которой принадлежит наибольшее число данных точек.');
end;

end.









unit laba_6_3_UnitCalculateBestLine;

interface

uses
    Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
    Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls, Math, laba_6_3_UnitTypes;

function GetKAndB(const ArrOfCoords: TArrCoord; var LineIsVertical: Boolean) : TKAndB;

implementation

function GetKAndB(const ArrOfCoords: TArrCoord; var LineIsVertical: Boolean) : TKAndB;
var
    KAndB: TKAndB;
    Best_K, K, DY, Best_B, B, DX, X1, Y1: Single;
    CountDots, MaxCountDots, i, j, iter3: Integer;
    TempLineIsVertical: Boolean;

begin
    Best_K := 0;
    Best_B := 0;
    MaxCountDots := 0;
    K := 0;

    for i := 0 to High(ArrOfCoords) do
        for j := i + 1 to High(ArrOfCoords) do
        begin
            x1 := ArrOfCoords[i].X;
            y1 := ArrOfCoords[i].Y;
            dx := ArrOfCoords[j].X - x1;
            dy := ArrOfCoords[j].Y - y1;
            TempLineIsVertical := DX = 0;
            if not TempLineIsVertical then
            begin
                k := dy / dx;
                b := y1 - x1 * dy / dx;
            end
            else
                b := x1;

            CountDots := 2;

            for iter3 := j + 1 to High(ArrOfCoords) do
                if TempLineIsVertical then
                begin
                    if (ArrOfCoords[iter3].X = b) then
                        Inc(countDots);
                end
                else
                    if (ArrOfCoords[iter3].Y = ArrOfCoords[iter3].X * k + b) then
                        Inc(countDots);
            if CountDots > MaxCountDots then
            begin
                MaxCountDots := CountDots;

                LineIsVertical := TempLineIsVertical;
                best_b := b;
                best_k := k;
            end;
        end;

    KAndB.K := Best_K;
    KAndB.B := Best_B;
    Result := KAndB;
end;

end.








unit laba_6_3_UnitGraphic;

interface

uses Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls, Math, laba_6_3_UnitTypes;

procedure DrawGraphicWithDots(ArrCoords: TArrCoord);
procedure DrawLineVertical(const XConstant: Single);
procedure DrawLineNotVertical(const K, B: Single);
procedure SetupCanvas();

implementation

uses laba_6_3_UnitMainForm;

const
    WidthOfGraphicLine = 1;
    WidthOfLine = 2;
    WidthOfDots = 4;
    BorderOfForm = 10;
    BorderOfCanvas = 20;

    ColorOfAxis = clBlack;
    BrushOfAxis = clWhite;
    ColorOfDots = clBlue;
    ColorOfLine = clRed;

var
    PixelsPerOne: Byte;
    XCenter, YCenter, Furthest: SmallInt;

procedure DrawAxis(); forward;
function GetFurthestCoordinate(ArrCoords: TArrCoord): SmallInt; forward;
procedure DrawDots(ArrCoords: TArrCoord); forward;
procedure DrawCircle(XCentre, YCentre, Radius: SmallInt); forward;

procedure DrawGraphicWithDots(ArrCoords: TArrCoord);
begin
    with FormMain do
    with ImageCanvas do
    begin
        with Canvas do
        begin
            Pen.Color := clWhite;
            Brush.Color := clWhite;
            Pen.Width := 1;
            Rectangle(0, 0, Width, Height);
        end;

        Furthest := GetFurthestCoordinate(ArrCoords);
        PixelsPerOne := Trunc((Width - 2 * BorderOfCanvas) / (2 * Furthest + 3));

        DrawAxis();
        DrawDots(ArrCoords);
    end;
end;

procedure SetupCanvas();
begin
    with FormMain do
    with ImageCanvas do
    begin
        Left := MultPixels(BorderOfForm) + BorderWidth;
        Top := MultPixels(BorderOfForm) + BorderWidth;
        Height := FormMain.ClientHeight - 2 * (MultPixels(BorderOfForm) + BorderWidth);
        Width := Height;

        XCenter := Round(Width / 2);
        YCenter := Round(Height / 2);
    end;
end;

procedure DrawDots(ArrCoords: TArrCoord);
var
    Coord: TPairOfSmallInt;
    TempWidthOfDots: Byte;

begin
    With FormMain do
    With ImageCanvas do
    With Canvas do
    begin
        TempWidthOfDots := MultPixels(WidthOfDots);

        for Coord in ArrCoords do
        begin
            Pen.Color := ColorOfDots;
            Brush.Color := ColorOfDots;
            Pen.Width := 1;

            DrawCircle(XCenter + Coord.X * PixelsPerOne, YCenter - Coord.Y * PixelsPerOne, TempWidthOfDots)
        end;
    end;
end;

procedure DrawLineVertical(const XConstant: Single);
begin
    With FormMain do
    With ImageCanvas do
    With Canvas do
    begin
        Pen.Color := ColorOfLine;
        Pen.Width := MultPixels(WidthOfLine);

        MoveTo(Trunc(XCenter + XConstant * PixelsPerOne), 0);
        LineTo(Trunc(XCenter + XConstant * PixelsPerOne), Height);
    end;
end;

procedure DrawLineNotVertical(const K, B: Single);
var
    XTemp: Single;

begin
    With FormMain do
    With ImageCanvas do
    With Canvas do
    begin
        Pen.Color := ColorOfLine;
        Pen.Width := MultPixels(WidthOfLine);

        XTemp := XCenter - (Furthest + 5) * PixelsPerOne;
        MoveTo(Trunc(XTemp), Trunc(YCenter - (-(Furthest + 5) * K + B) * PixelsPerOne));
        XTemp := XCenter + (Furthest + 5) * PixelsPerOne;
        LineTo(Trunc(XTemp), Trunc(YCenter - ((Furthest + 5) * K + B) * PixelsPerOne));
    end;
end;

procedure DrawCircle(XCentre, YCentre, Radius: SmallInt);
begin
    With FormMain.ImageCanvas.Canvas do
        Ellipse(XCentre - Radius, YCentre - Radius, XCentre + Radius, YCentre + Radius);
end;

procedure DrawAxis();
var
    i: ShortInt;
    ScaleOfGraphic, TempWidthOfGraphicLine: Byte;
    XTemp, YTemp, ArrowSize: SmallInt;

begin
    With FormMain do
    With ImageCanvas do
    With Canvas do
        begin
            TempWidthOfGraphicLine := MultPixels(WidthOfGraphicLine);

            Pen.Color := ColorOfAxis;
            Brush.Color := BrushOfAxis;
            Pen.Width := TempWidthOfGraphicLine;

            // Arrows
                ArrowSize := 5 * TempWidthOfGraphicLine;
                // Y axis
                MoveTo(XCenter, Height - MultPixels(BorderOfCanvas));
                YTemp := MultPixels(BorderOfCanvas);
                LineTo(XCenter, YTemp);
                LineTo(XCenter - ArrowSize, YTemp + ArrowSize);
                MoveTo(XCenter, YTemp);
                LineTo(XCenter + ArrowSize, YTemp + ArrowSize);
                // X axis
                MoveTo(MultPixels(BorderOfCanvas), YCenter);
                XTemp := Width - MultPixels(BorderOfCanvas);
                LineTo(XTemp, YCenter);
                LineTo(XTemp - ArrowSize, YCenter + ArrowSize);
                MoveTo(XTemp, YCenter);
                LineTo(XTemp - ArrowSize, YCenter - ArrowSize);

            if Furthest > 12 then
                if Furthest > 40 then
                    if Furthest > 70 then
                        ScaleOfGraphic := 20
                    else
                        ScaleOfGraphic := 10
                else
                    ScaleOfGraphic := 5
            else
                ScaleOfGraphic := 1;

            // Zero
            TextOut(XCenter + TempWidthOfGraphicLine,
                        YCenter + TempWidthOfGraphicLine, '0');

            for i := -Furthest to Furthest do
                if (i <> 0) and (i mod ScaleOfGraphic = 0) then
                begin
                    // Y axis
                    XTemp := XCenter + TempWidthOfGraphicLine;
                    YTemp := YCenter - i * PixelsPerOne;
                    TextOut(XTemp, YTemp, IntToStr(i));
                    MoveTo(XCenter - 2 * TempWidthOfGraphicLine, YTemp);
                    LineTo(XCenter + 2 * TempWidthOfGraphicLine, YTemp);

                    // X axis
                    XTemp := XCenter + i * PixelsPerOne;
                    YTemp := YCenter + TempWidthOfGraphicLine;
                    TextOut(XTemp, YTemp, IntToStr(i));
                    MoveTo(XTemp, YCenter - 2 * TempWidthOfGraphicLine);
                    LineTo(XTemp, YCenter + 2 * TempWidthOfGraphicLine);
                end;
        end;
end;

function GetFurthestCoordinate(ArrCoords: TArrCoord): SmallInt;
var
    FurthestLocal: SmallInt;
    Coord: TPairOfSmallInt;

begin
    FurthestLocal := 0;
    for Coord in ArrCoords do
    begin
        FurthestLocal := Max(FurthestLocal, Abs(Coord.X));
        FurthestLocal := Max(FurthestLocal, Abs(Coord.Y));
    end;
    Result := FurthestLocal;
end;

end.








unit laba_6_3_UnitTypes;

interface

type
    TArrStr = Array of String;

    TPairOfSmallInt = Record
        X, Y: SmallInt;
    End;

    TKAndB = Record
        K: Single;
        B: Single;
    End;

    TArrCoord = Array of TPairOfSmallInt;

implementation

end.