(Delphi) lab 6.2 PaintUnit

unit PaintUnit;

interface

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

type
  TPaintForm = class(TForm)
    PaintBox: TPaintBox;
    procedure FormKeyPress(Sender: TObject; var Key: Char);
    procedure FormActivate(Sender: TObject);
    procedure PaintBoxPaint(Sender: TObject);

  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  PaintForm: TPaintForm;

implementation

{$R *.dfm}

uses
    MainUnit;
const
    MAX = 10000;
type
    Arr = array[1..MAX] of Integer;
    Matrix = array of array of Integer;
    Res = array of Matrix;

procedure TPaintForm.FormActivate(Sender: TObject);
var
    Splits, Vertical, Horizontal, CellWidth, CellHeight, i, j, Counter: Integer;
begin
    PaintForm.Height := Screen.Height + 5;
    PaintForm.Width := Screen.Width + 5;
    PaintBox.Height := PaintForm.Height - 45;
    PaintBox.Width := PaintForm.Width - 20;

    PaintBoxPaint(PaintBox);
end;

procedure TPaintForm.FormKeyPress(Sender: TObject; var Key: Char);
begin
    if Key = #27 then
        PaintForm.Close;
end;

function FindSplit(a,b:arr; Number,kol:integer): Matrix;
var
    i, j, k, t:integer;
    Matrx: Matrix;
begin
    SetLEngth(Matrx, Kol, Number);
    for i := 0 to Kol - 1 do
        for j := 0 to Number - 1 do
            Matrx[i][j] := 0;
    for k:=1 to Number-1 do
        for i:=1 to Number-k do
            if(b[i]>b[i+1]) then
            begin
                t := b[i];
                b[i] := b[i+1];
                b[i+1] := t;
                t := a[i];
                a[i] :=a [i+1];
                a[i+1] := t;
            end;
    t := 1;
    for i := 2 to Number do
        if b[i]<>b[i-1] then
            Inc(t);

    if(kol=t) then
    begin
        j := 0;
        k := 0;
        Matrx[j][k] := a[1];
        for i := 2 to Number do
            if b[i] <> b[i-1] then
            begin
                SetLength(Matrx[j], k + 1);
                Inc(j);
                k := 0;
                Matrx[j][k] := a[i];
            end
            else
            begin
                Inc(k);
                Matrx[j][k] := a[i];
            end;
        SetLength(Matrx[j], k + 1);
        Result := Matrx;
    end
    else
        Result :=  nil;
end;

function FindAllSplits(Number, Kol: Integer): Res;
var
    a,
    Prev, {номер предыдущего блока}
    Next, {номер следующего блока: Next[I]=0, если блок I является последним блоком разбиения}
    Blok:arr; {номер текущего блока}
    j,i, {минимальный элемент текущего блока}
    k, Counter, S:integer;
    Forw:array[1..MAX] of boolean; {направление в котором движется элемент I, =true, если движется вперёд}
    Answer: Res;
    Temp: Matrix;
begin
  SetLength(Answer, MAX, Kol, Number);
  for i := 0 to MAX - 1 do
      Answer[i] := nil;
  Counter := 0;
 {инициализация исходного множества}
 for i:=1 to Number do
  begin
   a[i]:=i;
   Blok[i]:=1;
   Forw[i]:=true;
  end;
  Next[1]:=0;
  {Записать разбиение}
  Temp := FindSplit(a,Blok,Number,kol);
  if Temp <> nil then
  begin
      Answer[Counter] := Temp;
      Inc(Counter);
  end;
  j:=Number; {j=активный элемент}
  while j>1 do
   begin
    k:=Blok[j];
    if Forw[j] then {j движется вперёд}
     begin
      if Next[k]=0 then {k есть последний блок}
       begin
        Next[k]:=j;
        Prev[j]:=k;
        Next[j]:=0;
       end;
      if Next[k]>j then {j образует новый блок}
       begin
         Prev[j]:=k;
         Next[j]:=Next[k];
         Prev[Next[j]]:=j;
         Next[k]:=j;
       end;
      Blok[j]:=Next[k];
     end
    else {j движется назад}
     begin
      Blok[j]:=Prev[k];
      if k=j then {j образует одноэлементный блок}
       if Next[k]=0 then
         Next[Prev[k]]:=0
       else
        begin
         Next[Prev[k]]:=Next[k];
         Prev[Next[k]]:=Prev[k];
        end
     end;
    {Записать разбиение}
    Temp := FindSplit(a,Blok,Number,kol);
    if Temp <> nil then
    begin
        Answer[Counter] := Temp;
        Inc(Counter);
    end;
    j:=Number;
    while (j>1) and ((Forw[j] and (Blok[j]=j)) or (not Forw[j] and (Blok[j]=1)) ) do
      begin
        Forw[j]:=not Forw[j];
        j:=j-1;
      end;
   end;
   i := 0;
   while Answer[i] <> nil do
       Inc(i);
   Setlength(Answer, i);
   Result := Answer;
end;

procedure TPaintForm.PaintBoxPaint(Sender: TObject);
var
    Number, Splits, Vertical, Horizontal, CellWidth, CellHeight, i, j, k, l, Counter, Line, XSpace, YSpace, TopCells, LeftCells, Radius: Integer;
    AllSplits: Res;
begin
    PaintBox.Canvas.Pen.Width := 2;
    PaintBox.Canvas.Brush.Color := clWhite;
    PaintBox.Canvas.Rectangle(0,0,PaintBox.Width,PaintBox.Height);

    Number := MainForm.SpinEdit.Value;
    Splits := StrToInt(MainForm.SplittingNumberLabel.Caption);
    Horizontal := Trunc(sqrt(Splits));
    if Splits <> 1 then
        Inc(Horizontal);
    if Horizontal * (Horizontal - 1) >= Splits  then
        Vertical := Horizontal - 1
    else
        Vertical := Horizontal;
    CellWidth := Round(PaintBox.Width / Horizontal);
    CellHeight := Round(PaintBox.Height / Vertical);

    PaintBox.Canvas.Pen.Width := 0;
    PaintBox.Canvas.Brush.Color := clBlack;
    for i := 1 to Vertical - 1 do
        PaintBox.Canvas.Rectangle(0,i * CellHeight - 1, PaintBox.Width,i * CellHeight + 1);
    for i := 1 to Horizontal - 1 do
        PaintBox.Canvas.Rectangle(i * CellWidth - 1,0,i * CellWidth + 1, PaintBox.Height);
    Line := CellHeight div 3; //расстояние от центра ячейки до точки

    if Number < 7 then
        PaintBox.Canvas.Pen.Width := 2
    else
        PaintBox.Canvas.Pen.Width := 1;
    if Splits <> 1 then
    begin
        Counter := 2;
        for i := Number - 1 downto 1 do
        begin
            AllSplits := FindAllSplits(Number, i);
            for j := 0 to Length(AllSplits) - 1 do
            begin
                if Counter mod Horizontal = 0 then
                begin
                    LeftCells := Horizontal - 1;
                    TopCells := Counter div Horizontal - 1;
                end
                else
                begin
                    LeftCells := Counter mod Horizontal - 1;
                    TopCells := Counter div Horizontal;
                end;
                for k := 0 to Length(AllSplits[j]) - 1 do
                begin
                    if Length(AllSplits[j][k]) <> 1 then
                    begin
                        if Length(AllSplits[j][k]) = 2 then
                        begin
                            PaintBox.Canvas.MoveTo(CellWidth * LeftCells + CellWidth div 2 + Round(Line * sin(2* pi * AllSplits[j][k][0] / Number)), CellHeight * TopCells + CellHeight div 2 + Round(Line * cos(2* pi * AllSplits[j][k][0] / Number)));
                            PaintBox.Canvas.LineTo(CellWidth * LeftCells + CellWidth div 2 + Round(Line * sin(2* pi * AllSplits[j][k][1] / Number)), CellHeight * TopCells + CellHeight div 2 + Round(Line * cos(2* pi * AllSplits[j][k][1] / Number)));
                        end
                        else
                        begin
                            PaintBox.Canvas.MoveTo(CellWidth * LeftCells + CellWidth div 2 + Round(Line * sin(2* pi * AllSplits[j][k][0] / Number)), CellHeight * TopCells + CellHeight div 2 + Round(Line * cos(2* pi * AllSplits[j][k][0] / Number)));
                            for l := 1 to Length(AllSplits[j][k]) - 1 do
                                PaintBox.Canvas.LineTo(CellWidth * LeftCells + CellWidth div 2 + Round(Line * sin(2* pi * AllSplits[j][k][l] / Number)), CellHeight * TopCells + CellHeight div 2 + Round(Line * cos(2* pi * AllSplits[j][k][l] / Number)));
                            PaintBox.Canvas.LineTo(CellWidth * LeftCells + CellWidth div 2 + Round(Line * sin(2* pi * AllSplits[j][k][0] / Number)), CellHeight * TopCells + CellHeight div 2 + Round(Line * cos(2* pi * AllSplits[j][k][0] / Number)));
                        end;

                    end;
                end;
                Inc(Counter);
            end;
        end;
    end;


    PaintBox.Canvas.Brush.Color := clRed;
    Counter := 0;
    if Number = 1 then
        Radius := 20
    else
        if Number < 7 then
            Radius := 5
        else
            if Number < 10 then
                Radius := 2
            else
                Radius := 1;
    for i := 0 to Vertical - 1 do
        for j :=  0 to Horizontal - 1 do
            if Counter < Splits  then
            begin
                if Number = 1 then
                    PaintBox.Canvas.Ellipse(j * CellWidth + CellWidth div 2 - Radius, i * CellHeight + CellHeight div 2 - Radius, j * CellWidth + CellWidth div 2 + Radius, i * CellHeight + CellHeight div 2 + Radius)
                else
                begin
                    PaintBox.Canvas.Ellipse(j * CellWidth + CellWidth div 2 - Radius, i * CellHeight + CellHeight div 2 - Radius + Line, j * CellWidth + CellWidth div 2 + Radius, i * CellHeight + CellHeight div 2 + Radius + Line);
                end;
                for k := 1 to Number - 1 do
                begin
                    XSpace := Round(Line * sin(2* pi * k / Number));
                    YSpace := Round(Line * cos(2* pi * k / Number));
                    PaintBox.Canvas.Ellipse(j * CellWidth + CellWidth div 2 - Radius + XSpace, i * CellHeight + CellHeight div 2 - Radius + YSpace, j * CellWidth + CellWidth div 2 + Radius + XSpace, i * CellHeight + CellHeight div 2 + Radius + YSpace);
                end;

                Inc(Counter);
            end;

end;

end.