Скачиваний:
15
Добавлен:
02.05.2014
Размер:
10 Кб
Скачать
☆
unit OutPlateInRoom;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, {my} MyUnit, Buttons, Math;

type
  TfrmOutPlate = class(TForm)
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    procedure FormPaint(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);

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

var
  frmOutPlate: TfrmOutPlate;
  //alfa : real;
  OutMyPolygon:T2DPointPolygon;
  OutVectorR : T2DPointPolygon;
  OutPlate : T2DPlateSet;
  Orientir : TPoint;
  OMax,OMin:TPoint;
  WholePlate,NotWholePlate : integer;
var OLeft,OTop,PlSeam,PlSeamHeight,PlSeamWidth,PlHeight,PlWidth:integer;
    tmpPoint1,tmpPoint2: TPoint;

implementation

uses Unit1;

{$R *.dfm}

//-------------------------RotateAlfa-------------------------------------------
function RotateAlfa(const P:TPoint; Alfa:extended):TPoint;  //поворот точки P на угол альфа относительно точки Оrientir
begin
  Result.X:=Round(P.X*cos(alfa)-P.Y*sin(alfa) );
  Result.Y:=Round(P.X*sin(alfa)+P.Y*cos(alfa) );
end;

//-------------------------TfrmOutPlate.FormPaint-------------------------------
procedure TfrmOutPlate.FormPaint(Sender: TObject);
var i : integer;
begin
  frmOutPlate.Canvas.Brush.Color:=clSkyBlue;                                    // Рисование рабочей области
  frmOutPlate.Canvas.Pen.Color:=clGray;
  frmOutPlate.Canvas.Rectangle(3,3,frmOutPlate.Width-10,frmOutPlate.Height-29);
  WholePlate:=0;                                                                // вывод всех плиток
  NotWholePlate:=0;
  if Length(OutPlate)>0 then
    for i:=0 to Length(OutPlate)-1 do
    begin
      if OutPlate[i].whole=true
      then begin frmOutPlate.Canvas.Brush.Color:=frmMain.ColorGrid1.BackgroundColor; inc(WholePlate); end
      else begin frmOutPlate.Canvas.Brush.Color:=frmMain.ColorGrid1.ForegroundColor; inc(NotWholePlate); end;
      //frmMain.Canvas.Rectangle(Plate[i].MinP.X,Plate[i].MinP.Y,Plate[i].MaxP.X,Plate[i].MaxP.Y);
      frmOutPlate.Canvas.Polygon(OutPlate[i].Points);
    end; 
  if Length(OutMyPolygon)>0                                                     //Растановка точек и ребер полигона
  then begin                                                                    //СИНИМ цветом для построения прямых
    frmOutPlate.Canvas.Pen.Color:=clBlue;
    frmOutPlate.Canvas.Brush.Color:=clSkyBlue;
    frmOutPlate.Canvas.MoveTo(OutMyPolygon[0].X,OutMyPolygon[0].Y);
    for i:=0 to Length(OutMyPolygon)-1 do
    begin
      frmOutPlate.Canvas.Pen.Color:=clGray;
      frmOutPlate.Canvas.LineTo(OutMyPolygon[i].X,OutMyPolygon[i].Y);
      frmOutPlate.Canvas.Pen.Color:=clBlue;
      frmOutPlate.Canvas.Brush.Color:=clSkyBlue;
      frmOutPlate.Canvas.Rectangle(OutMyPolygon[i].X-3,OutMyPolygon[i].Y-3,OutMyPolygon[i].X+3,OutMyPolygon[i].Y+3);
    end;
    frmOutPlate.Canvas.Pen.Color:=clGray;
    frmOutPlate.Canvas.Brush.Color:=clBtnFace;
    frmOutPlate.Canvas.Pen.Style:=psDot;
    frmOutPlate.Canvas.LineTo(OutMyPolygon[0].X,OutMyPolygon[0].Y);
    frmOutPlate.Canvas.Pen.Style:=psSolid;
  end;
  if Length(OutVectorR)>0 then
  begin
    frmOutPlate.Canvas.Pen.Color:=clBLack;
    frmOutPlate.Canvas.Brush.Color:=clRed;
    frmOutPlate.Canvas.Ellipse(OutVectorR[0].X-3,OutVectorR[0].Y-3,OutVectorR[0].X+3,OutVectorR[0].Y+3);
    frmOutPlate.Canvas.Rectangle(OutVectorR[1].X-2,OutVectorR[1].Y-2,OutVectorR[1].X+2,OutVectorR[1].Y+2);
    frmOutPlate.Canvas.MoveTo(OutVectorR[0].X,OutVectorR[0].Y);
    frmOutPlate.Canvas.LineTo(OutVectorR[1].X,OutVectorR[1].Y);
  end;
end;

//-------------------------TfrmOutPlate.FormResize------------------------------
procedure TfrmOutPlate.FormResize(Sender: TObject);
begin
  frmOutPlate.Repaint;
end;

procedure PlateGen;
var i:integer;
begin
  //поворот комнаты и ветора на угол альфа
  for i:=0 to Length(OutMyPolygon)-1 do OutMyPolygon[i]:=RotateAlfa(OutMyPolygon[i],alfa);
  for i:=0 to Length(OutVectorR)-1 do OutVectorR[i]:=RotateAlfa(OutVectorR[i],alfa);
  //нахождение минимальной и максимальной координаты стены и вектора
  OMin:=OutMyPolygon[0];
  OMax:=OutMyPolygon[0];
  for i:=1 to Length(OutMyPolygon)-1 do
    begin
      if OMin.X>OutMyPolygon[i].X then OMin.X:=OutMyPolygon[i].X;
      if OMin.Y>OutMyPolygon[i].Y then OMin.Y:=OutMyPolygon[i].Y;
      if OMax.X<OutMyPolygon[i].X then OMax.X:=OutMyPolygon[i].X;
      if OMax.Y<OutMyPolygon[i].Y then OMax.Y:=OutMyPolygon[i].Y;
    end;
  for i:=1 to Length(OutVectorR)-1 do
   begin
      if OMin.X>OutVectorR[i].X then OMin.X:=OutVectorR[i].X;
      if OMin.Y>OutVectorR[i].Y then OMin.Y:=OutVectorR[i].Y;
      if OMax.X<OutVectorR[i].X then OMax.X:=OutVectorR[i].X;
      if OMax.Y<OutVectorR[i].Y then OMax.Y:=OutVectorR[i].Y;
    end;
  // проверка на случай если после поворота вектор и массив вышли за рабочую область
  // и исправление ошибки. Также корректировка миним. и максимальной координаты
  //if (OMin.X<5) or (OMin.Y<5) then
    begin
      OLeft:=PlSeamWidth-OMin.X;
      OTop:=PlSeamHeight-OMin.Y;
      for i:=0 to Length(OutMyPolygon)-1 do
      begin
        OutMyPolygon[i].X:=OutMyPolygon[i].X+OLeft;
        OutMyPolygon[i].Y:=OutMyPolygon[i].Y+OTop;
      end;
    for i:=0 to Length(OutVectorR)-1 do
      begin
        OutVectorR[i].X:=OutVectorR[i].X+OLeft;
        OutVectorR[i].Y:=OutVectorR[i].Y+OTop;
      end;
      OMin.X:=OMin.X+OLeft;
      OMin.Y:=OMin.Y+OTop;
      OMax.X:=OMax.X+OLeft;
      OMax.Y:=OMax.Y+OTop;
    end;
  //нахождение плит
  SetLength(OutPlate,0);
  //заполнение вниз-влево от нуевой точки вектора
  tmpPoint1:=OutVectorR[0];
  tmpPoint2:=OMax;
  tmpPoint2.X:=tmpPoint2.X+PlSeamWidth;
  GetPlateArray(OutMyPolygon,strtoint(frmMain.edWidth.Text)-1,strtoint(frmMain.edHeight.Text)-1,strtoint(frmMain.edSeam.Text)+1,frmMain.chboxShift.Checked,tmpPoint1,tmpPoint2,OutPlate);
  //заполнение вверх-влево от нуевой точки вектора
  tmpPoint1.Y:=OutVectorR[0].Y-((((OutVectorR[0].Y-OMin.Y) div PlSeamHeight)+1)*PlSeamHeight);
  if (((OutVectorR[0].Y-tmpPoint1.Y) div PlSeamHeight) and 1)=1 then tmpPoint1.Y:=tmpPoint1.Y-PlSeamHeight;
  tmpPoint2.Y:=OutVectorR[0].Y-PlSeamHeight;
  GetPlateArray(OutMyPolygon,strtoint(frmMain.edWidth.Text)-1,strtoint(frmMain.edHeight.Text)-1,strtoint(frmMain.edSeam.Text)+1,frmMain.chboxShift.Checked,tmpPoint1,tmpPoint2,OutPlate);
  //заполнение вверх-вправо от нуевой точки вектора
  tmpPoint1.X:=OutVectorR[0].X-((((OutVectorR[0].X-OMin.X) div PlSeamWidth)+1)*PlSeamWidth);
  tmpPoint2.X:=OutVectorR[0].X-PlSeamWidth;
  GetPlateArray(OutMyPolygon,strtoint(frmMain.edWidth.Text)-1,strtoint(frmMain.edHeight.Text)-1,strtoint(frmMain.edSeam.Text)+1,frmMain.chboxShift.Checked,tmpPoint1,tmpPoint2,OutPlate);
  //заполнение вниз-вправо от нуевой точки вектора
  tmpPoint1.Y:=OutVectorR[0].Y;
  tmpPoint2.Y:=OMax.Y;
  GetPlateArray(OutMyPolygon,strtoint(frmMain.edWidth.Text)-1,strtoint(frmMain.edHeight.Text)-1,strtoint(frmMain.edSeam.Text)+1,frmMain.chboxShift.Checked,tmpPoint1,tmpPoint2,OutPlate);
end;

//-------------------------TfrmOutPlate.FormShow--------------------------------
procedure TfrmOutPlate.FormShow(Sender: TObject);
var i:integer;
begin
  //нахождение угла поворота и копирование Массива стен и вектора заполнения плитками
  PlSeam:=strtoint(frmMain.edSeam.Text);
  PlSeamHeight:=strtoint(frmMain.edHeight.Text)+strtoint(frmMain.edSeam.Text);
  PlSeamWidth:=strtoint(frmMain.edWidth.Text)+strtoint(frmMain.edSeam.Text);
  SetLength(OutMyPolygon,Length(MyPolygon));
  SetLength(OutVectorR,Length(VectorR));
  for i:=0 to Length(MyPolygon)-1 do
    OutMyPolygon[i]:=MyPolygon[i];
  for i:=0 to Length(VectorR)-1 do
    OutVectorR[i]:=VectorR[i];
  alfa:=arctan2( (OutVectorR[1].Y-OutVectorR[0].Y),(OutVectorR[1].X-OutVectorR[0].X) );
  alfa:=0-alfa;
  PlateGen;
  frmOutPlate.Repaint;
end;

procedure TfrmOutPlate.SpeedButton1Click(Sender: TObject);
begin
  MessageDlg('Кол-во целых плит:'+IntToStr(WholePlate)+#13#10+
             'Кол-во битых плит:'+IntToStr(NotWholePlate)+#13#10
  , mtInformation,[mbOk], 0);
end;

procedure TfrmOutPlate.SpeedButton2Click(Sender: TObject);
var i,j,l,t1_1,t1_2,t2_1,t2_2,Count1,Count2:integer;
begin
  Count1:=Length(OutPlate)+1;
  Count2:=Length(OutPlate)+1;
  t1_1:=0;
  t1_2:=1;
  t2_1:=0;
  t2_2:=1;
  for j:=0 to Length(MyPolygon)-1 do
  begin
    //нахождение угла поворота и копирование Массива стен и вектора заполнения плитками
    SetLength(OutMyPolygon,Length(MyPolygon));
    for i:=0 to Length(MyPolygon)-1 do
      OutMyPolygon[i]:=MyPolygon[i];
    if j<Length(MyPolygon)-1 then l:=j+1
                             else l:=0;
    OutVectorR[0]:=MyPolygon[j];
    OutVectorR[1]:=MyPolygon[l];
    alfa:=arctan2( (OutVectorR[1].Y-OutVectorR[0].Y),(OutVectorR[1].X-OutVectorR[0].X) );
    alfa:=0-alfa;
    PlateGen;
    if Count1>Length(OutPlate) then begin t1_1:=j; t1_2:=l; Count1:=Length(OutPlate); end;
  end;
  for j:=Length(MyPolygon)-1 downto 0 do
  begin 
    //нахождение угла поворота и копирование Массива стен и вектора заполнения плитками
    SetLength(OutMyPolygon,Length(MyPolygon));
    for i:=0 to Length(MyPolygon)-1 do
      OutMyPolygon[i]:=MyPolygon[i];
    if j>0 then l:=j-1
           else l:=Length(MyPolygon)-1;
    OutVectorR[0]:=MyPolygon[j];
    OutVectorR[1]:=MyPolygon[l];
    alfa:=arctan2( (OutVectorR[1].Y-OutVectorR[0].Y),(OutVectorR[1].X-OutVectorR[0].X) );
    alfa:=0-alfa;
    PlateGen;
    if Count2>Length(OutPlate) then begin t2_1:=j; t2_2:=l; Count2:=Length(OutPlate); end;
  end;
  if Count1<Count2 then
    begin
      OutVectorR[0]:=MyPolygon[t1_1];
      OutVectorR[1]:=MyPolygon[t1_2];
    end
    else
    begin
      OutVectorR[0]:=MyPolygon[t2_1];
      OutVectorR[1]:=MyPolygon[t2_2];
    end;
  SetLength(OutMyPolygon,Length(MyPolygon));
  for i:=0 to Length(MyPolygon)-1 do
    OutMyPolygon[i]:=MyPolygon[i];
  alfa:=arctan2( (OutVectorR[1].Y-OutVectorR[0].Y),(OutVectorR[1].X-OutVectorR[0].X) );
  alfa:=0-alfa;
  PlateGen;
  frmOutPlate.Repaint;
end;

end.
Соседние файлы в папке Курсовой проект - Автоматизация укладки плитки
  • #
    02.05.20145 Кб15OutPlateInRoom.~dfm
  • #
    02.05.201410 Кб15OutPlateInRoom.~pas
  • #
    02.05.201412 Кб17OutPlateInRoom.dcu
  • #
    02.05.201451 б15OutPlateInRoom.ddp
  • #
    02.05.20145 Кб15OutPlateInRoom.dfm
  • #
    02.05.201410 Кб15OutPlateInRoom.pas
  • #
    02.05.2014287 б15Project1.~dpr
  • #
    02.05.2014434 б16Project1.cfg
  • #
    02.05.20142 Кб15Project1.dof
  • #
    02.05.2014305 б15Project1.dpr
  • #
    02.05.2014876 б16Project1.res