Курсовой проект - Автоматизация укладки плитки / Unit1

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ToolWin, ComCtrls, ImgList, StdCtrls, ExtCtrls, Math, MyUnit,
  ColorGrd, Spin;

type
  TfrmMain = class(TForm)
    statbarMain: TStatusBar;
    toolbarMain: TToolBar;
    tlbtnAuthor: TToolButton;
    tlbtnClear: TToolButton;
    ImageList1: TImageList;
    tlbtnSeparate1: TToolButton;
    tlbtnExit: TToolButton;
    tlbtnLine: TToolButton;
    tlbtnSeparate2: TToolButton;
    tlbtnSeparate3: TToolButton;
    edSeam: TEdit;
    lblHeight: TLabel;
    edHeight: TEdit;
    lblSeam: TLabel;
    lblWidth: TLabel;
    edWidth: TEdit;
    ColorGrid1: TColorGrid;
    chboxShift: TCheckBox;
    ToolButton1: TToolButton;
    ToolButton2: TToolButton;
    toolbtnVectorR: TToolButton;
    Panel1: TPanel;
    ToolButton3: TToolButton;
    procedure tlbtnExitClick(Sender: TObject);
    procedure tlbtnAuthorClick(Sender: TObject);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormPaint(Sender: TObject);
    procedure tlbtnClearClick(Sender: TObject);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure FormResize(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure toolbtnVectorRClick(Sender: TObject);
    procedure tlbtnPlateClick(Sender: TObject);
    procedure tlbtnLineClick(Sender: TObject);
    procedure ToolButton3Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmMain: TfrmMain;
  MinP, MaxP:TPoint;           //Область прямоугольника
  index :integer;
  Plate : T2DPlateSet;
  MyPolygon:T2DPointPolygon;
  alfa : real;
  VectorR : T2DPointPolygon;//Array of TPoint;
  strbool : string;
implementation

uses OutPlateInRoom;

{$R *.dfm}


//-------------------------TfrmMain.FormResize----------------------------------
procedure TfrmMain.FormResize(Sender: TObject);
begin
  frmMain.Repaint;
end;

//-------------------------TfrmMain.FormCreate----------------------------------
procedure TfrmMain.FormCreate(Sender: TObject);
begin
 MinP.X:=0;
 MinP.Y:=0;
 MaxP.X:=0;
 MaxP.Y:=0;
 strbool:='';
end;

//-------------------------TfrmMain.tlbtnExitClick------------------------------
procedure TfrmMain.tlbtnExitClick(Sender: TObject);
begin
  SetLength(MyPolygon,0);
  frmMain.Close;
end;

//-------------------------TfrmMain.tlbtnAuthorClick----------------------------
procedure TfrmMain.tlbtnAuthorClick(Sender: TObject);
begin
MessageDlg('Курсовая работа по дисциплине ВГ на тему: "УКЛАДКА ПЛИТКИ"'#13#10+
           ''#13#10+
           'Выполнили студенты Кирамов Радик и Корепонова Ольга группа 6-15-3'#13#10+
           '   Ввод новой точки и перемещение точки с помощью ЛЕВОЙ КНОПКИ МЫШИ.'#13#10+
           'Удаление точки с помощью ПРАВОЙ КНОПКИ МЫШИ'#13#10+
           ''#13#10+
           'Если в области комнаты появляются пустоты или за пределами комнаты появляются плиты'#13#10+
           'необходимо сместить точку многоугольника с которым верхняя вершина плитки сливается по горизонтали'#13#10+
           ''#13#10+
           ''#13#10+
           'radikkiramov@mail.ru'#13#10
  , mtInformation,[mbOk], 0);
end;


//-------------------------TfrmMain.tlbtnClearClick-----------------------------
procedure TfrmMain.tlbtnClearClick(Sender: TObject);
begin
  SetLength(MyPolygon,0);
  SetLength(Plate,0);
  SetLength(VectorR,0);
  MinP.X:=0;
  MinP.Y:=0;
  MaxP.X:=0;
  MaxP.Y:=0;
  frmMain.Repaint;
end;

//-------------------------TfrmMain.FormMouseDown-------------------------------
procedure TfrmMain.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var i:integer;
begin
  index:=-1;                                                                    //добавить точку если под ней нет точки
  if (button=mbLeft) and (toolbtnVectorR.Down=false)and (tlbtnLine.Down=true)                                                             //и сохранить его, предварительно увеличив массив на 1,
  then begin                                                                    //в конце последней ячейки массива его координаты Х и Y
    index:=-1;                                                                  //
    for i:=0 to Length(MyPolygon)-1 do
      if (abs(MyPolygon[i].X-X)<=2) and (abs(MyPolygon[i].Y-Y)<=2)
        then begin index:=i; strbool:='Line'; exit; end;
    if (tlbtnLine.Down) then
    begin
      SetLength(MyPolygon,Length(MyPolygon)+1);
      MyPolygon[Length(MyPolygon)-1].X:=X;
      MyPolygon[Length(MyPolygon)-1].Y:=Y;
      index:=Length(MyPolygon)-1;
      strbool:='Line';
    end;
  end;
  if (button=mbRight) and (Length(MyPolygon)>0)                                 //если нажата правая кнопка и размер полигона больше 0,
  then begin                                                                    //то если под курсором находится точка,
    index:=-1;                                                                  //то сначала переместить все точки, с текущей позиции до конца массива, на 1 назад
    for i:=0 to Length(MyPolygon)-1 do                                          //и сократить массив на 1
      if (abs(MyPolygon[i].X-X)<3) and (abs(MyPolygon[i].Y-Y)<3) then index:=i;
    if index>-1
    then begin
      for i:=index to Length(MyPolygon)-1 do MyPolygon[i]:=MyPolygon[i+1];
      SetLength(MyPolygon,Length(MyPolygon)-1);
    end;
    index:=-1;
  end;
  if (button=mbLeft)and (tlbtnLine.Down=false)and(toolbtnVectorR.Down=true) then
  begin
    for i:=0 to Length(VectorR)-1 do
      if (abs(VectorR[i].X-X)<=2) and (abs(VectorR[i].Y-Y)<=2)
      then begin index:=i; strbool:='vector'; exit; end;
    if (toolbtnVectorR.Down=true) then
    begin
      SetLength(VectorR,Length(VectorR)+1);
      VectorR[Length(VectorR)-1].X:=X;
      VectorR[Length(VectorR)-1].Y:=Y;
      index:=Length(VectorR)-1;
      strbool:='vector';
    end;
    if Length(VectorR)=2
      then begin
        alfa:=arctan2( (VectorR[1].Y-VectorR[0].Y),(VectorR[1].X-VectorR[0].X) );
        toolbtnVectorR.Down:=false;
      end;
  end;
  if (button=mbLeft) and (toolbtnVectorR.Down=false)and (tlbtnLine.Down=false) then
  for i:=0 to Length(MyPolygon)-1 do
      if (abs(MyPolygon[i].X-X)<=2) and (abs(MyPolygon[i].Y-Y)<=2)
        then begin index:=i; strbool:='Line';  end;
  for i:=0 to Length(VectorR)-1 do
      if (abs(VectorR[i].X-X)<=2) and (abs(VectorR[i].Y-Y)<=2)
      then begin index:=i; strbool:='vector';  end;
  frmMain.Repaint;
end;

//-------------------------TfrmMain.FormPaint-----------------------------------
procedure TfrmMain.FormPaint(Sender: TObject);
var i,WholePlate,NotWholePlate:integer;
begin
  frmMain.Canvas.Brush.Color:=clSkyBlue;                                        // Рисование рабочей области
  frmMain.Canvas.Pen.Color:=clGray;
  frmMain.Canvas.Rectangle(30,30,frmMain.Width-10,frmMain.Height-48);
  WholePlate:=0;                                                                // вывод всех плиток
  NotWholePlate:=0;
  if Length(Plate)>0 then
    for i:=0 to Length(Plate)-1 do
    begin
      if Plate[i].whole=true
      then begin frmMain.Canvas.Brush.Color:=ColorGrid1.BackgroundColor; inc(WholePlate); end
      else begin frmMain.Canvas.Brush.Color:=ColorGrid1.ForegroundColor; inc(NotWholePlate); end;
      //frmMain.Canvas.Rectangle(Plate[i].MinP.X,Plate[i].MinP.Y,Plate[i].MaxP.X,Plate[i].MaxP.Y);
      frmMain.Canvas.Polygon(Plate[i].Points);
    end;
  frmMain.Canvas.Pen.Color:=clGreen;                                            //Выделения в общую прямоуг-ю область массива стен
  frmMain.Canvas.Pen.Style:=psDot;
  frmMain.Canvas.Brush.Style:=bsClear;
  frmMain.Canvas.Rectangle(MinP.X,MinP.Y,MaxP.X,MaxP.Y);
  frmMain.Canvas.Pen.Style:=psSolid;
  if Length(MyPolygon)>0                                                        //Растановка точек и ребер полигона
  then begin                                                                    //СИНИМ цветом для построения прямых
    frmMain.Canvas.Pen.Color:=clBlue;
    frmMain.Canvas.Brush.Color:=clSkyBlue;
    frmMain.Canvas.MoveTo(MyPolygon[0].X,MyPolygon[0].Y);
    for i:=0 to Length(MyPolygon)-1 do
    begin
      frmMain.Canvas.Pen.Color:=clGray;
      frmMain.Canvas.LineTo(MyPolygon[i].X,MyPolygon[i].Y);
      frmMain.Canvas.Pen.Color:=clBlue; frmMain.Canvas.Brush.Color:=clSkyBlue;
      frmMain.Canvas.Rectangle(MyPolygon[i].X-3,MyPolygon[i].Y-3,MyPolygon[i].X+3,MyPolygon[i].Y+3);
    end;
    frmMain.Canvas.Pen.Color:=clGray;
    frmMain.Canvas.Brush.Color:=clBtnFace;
    frmMain.Canvas.Pen.Style:=psDot;
    frmMain.Canvas.LineTo(MyPolygon[0].X,MyPolygon[0].Y);
    frmMain.Canvas.Pen.Style:=psSolid;
  end;
  if Length(VectorR)>0 then
  begin
    frmMain.Canvas.Pen.Color:=clBlack;
    frmMain.Canvas.Brush.Color:=clRed;
    frmMain.Canvas.Ellipse(VectorR[0].X-3,VectorR[0].Y-3,VectorR[0].X+3,VectorR[0].Y+3);
    frmMain.Canvas.Rectangle(VectorR[1].X-2,VectorR[1].Y-2,VectorR[1].X+2,VectorR[1].Y+2);
    frmMain.Canvas.MoveTo(VectorR[0].X,VectorR[0].Y);
    frmMain.Canvas.LineTo(VectorR[1].X,VectorR[1].Y);
  end;
  statbarMain.Panels.Items[0].Text:='Кол-во точек '+inttostr(Length(MyPolygon));
  statbarMain.Panels.Items[1].Text:='Кол-во плиток '+inttostr(Length(Plate))+' | целых '+inttostr(WholePlate)+' | битых '+inttostr(NotWholePlate);
  if Length(VectorR)=0 then  statbarMain.Panels.Items[2].Text:='Вектор '+inttostr(Length(VectorR))+' : Т1 - незадана, Т2 - незадана';
  if Length(VectorR)=1 then  statbarMain.Panels.Items[2].Text:='Вектор '+inttostr(Length(VectorR))+' : Т1 - '+inttostr(VectorR[0].X)+'x'+inttostr(VectorR[0].Y)+', Т2 - незадана';
  if Length(VectorR)=2 then  statbarMain.Panels.Items[2].Text:='Вектор '+inttostr(Length(VectorR))+' : Т1 - '+inttostr(VectorR[0].X)+'x'+inttostr(VectorR[0].Y)+', Т2 - '+inttostr(VectorR[1].X)+'x'+inttostr(VectorR[1].Y);
  if Length(VectorR)=2 then  statbarMain.Panels.Items[3].Text:='угол '+floattostr(RadToDeg(alfa));
end;

//-------------------------TfrmMain.FormMouseMove-------------------------------
procedure TfrmMain.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if (ssLeft in Shift) and (index>-1) and (strbool='Line') and (X>30) and (Y>30) and (X<frmMain.Width-10) and (Y<frmMain.Height-48)
    then begin
      MyPolygon[index].X:=X;
      MyPolygon[index].Y:=Y;
      frmMain.Repaint;
    end;      
  if (ssLeft in Shift) and (index>-1) and (strbool='vector') and (X>30) and (Y>30) and (X<frmMain.Width-10) and (Y<frmMain.Height-48)
    then begin
      VectorR[index].X:=X;
      VectorR[index].Y:=Y;
      if Length(VectorR)=2 then alfa:=arctan2( (VectorR[1].Y-VectorR[0].Y),(VectorR[1].X-VectorR[0].X) );
      frmMain.Repaint;
    end;      
end;

procedure TfrmMain.toolbtnVectorRClick(Sender: TObject);
begin
  if toolbtnVectorR.Down=true then SetLength(VectorR,0);
  tlbtnLine.Down:=false;
end;

//-------------------------TfrmMain.tlbtnPlitaClick-----------------------------
procedure TfrmMain.tlbtnPlateClick(Sender: TObject);
var alfa:real;
begin
  SetLength(Plate,0);
  GetPlateArray(MyPolygon,strtoint(edWidth.Text)-1,strtoint(edHeight.Text)-1,strtoint(edSeam.Text)+1,chboxShift.Checked,MinP,MaxP,Plate);
  frmMain.Repaint;
end;

procedure TfrmMain.tlbtnLineClick(Sender: TObject);
begin
  toolbtnVectorR.Down:=false;
end;

procedure TfrmMain.ToolButton3Click(Sender: TObject);
begin
  frmOutPlate.Hide;
  if (Length(MyPolygon)>=3) and (Length(VectorR)=2) then frmOutPlate.ShowModal
  else MessageDlg('Не задан Вектор или стена', mtInformation,[mbOk], 0); exit;
end;

end.