Курсовой проект - Автоматизация укладки плитки / 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.