Скачиваний:
18
Добавлен:
01.05.2014
Размер:
26.03 Кб
Скачать
unit Main;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Menus, ComCtrls, ToolWin, ImgList, ExtCtrls, StdCtrls, List, Math;

type
TMainForm = class(TForm)
MainMenu1: TMainMenu;
N1: TMenuItem;
N2: TMenuItem;
N3: TMenuItem;
Screenshots1: TMenuItem;
N4: TMenuItem;
N5: TMenuItem;
N6: TMenuItem;
N8: TMenuItem;
N9: TMenuItem;
N10: TMenuItem;
N11: TMenuItem;
N12: TMenuItem;
About1: TMenuItem;
StatusBar1: TStatusBar;
ToolBar1: TToolBar;
ImageList1: TImageList;
ToolButton2: TToolButton;
ToolButton1: TToolButton;
ToolButton4: TToolButton;
ToolButton6: TToolButton;
GroupBox1: TGroupBox;
GroupBox2: TGroupBox;
Label1: TLabel;
LDotsNum: TLabel;
SaveDialog: TSaveDialog;
OpenDialog: TOpenDialog;
TrackBar1: TTrackBar;
Label2: TLabel;
Tochnost: TLabel;
next: TMenuItem;
start: TMenuItem;
go2begin: TMenuItem;
vis_dots: TMenuItem;
vis_polosi: TMenuItem;
vis_obolochka: TMenuItem;
ToolButton7: TToolButton;
NextButton: TToolButton;
StartButton: TToolButton;
ToBeginButton: TToolButton;
ToolButton10: TToolButton;
ToolButton11: TToolButton;
bmp1: TMenuItem;
SaveDialog1: TSaveDialog;
Edit_menu: TMenuItem;
EditButton: TToolButton;
ToolButton5: TToolButton;
MeanLabel: TLabel;
DevLabel: TLabel;
ConvexHull: TMenuItem;
SuperHull: TMenuItem;
N7: TMenuItem;
Shape1: TShape;
Shape2: TShape;
Shape3: TShape;
Shape4: TShape;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
RealHull: TMenuItem;
PaintBox1: TPaintBox;
procedure N12Click(Sender: TObject);
procedure N11Click(Sender: TObject);
procedure N9Click(Sender: TObject);
procedure ToolButton6Click(Sender: TObject);
procedure N6Click(Sender: TObject);
procedure ToolButton4Click(Sender: TObject);
procedure TrackBar1Change(Sender: TObject);
procedure About1Click(Sender: TObject);
procedure vis_dotsClick(Sender: TObject);
procedure vis_polosiClick(Sender: TObject);
procedure vis_obolochkaClick(Sender: TObject);
procedure startClick(Sender: TObject);
procedure StartButtonClick(Sender: TObject);
procedure ToolButton1Click(Sender: TObject);
procedure ToolButton11Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure N10Click(Sender: TObject);
procedure N8Click(Sender: TObject);
procedure SavePaintBox(Sender: TObject);
procedure bmp1Click(Sender: TObject);
procedure nextClick(Sender: TObject);
procedure NextButtonClick(Sender: TObject);
procedure ToBeginButtonClick(Sender: TObject);
procedure go2beginClick(Sender: TObject);
procedure DrawP(Sender: TObject);
procedure PaintBox1Paint(Sender: TObject);
procedure N5Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Edit_menuClick(Sender: TObject);
procedure EditButtonClick(Sender: TObject);
procedure FormResize(Sender: TObject);
procedure ConvexHullClick(Sender: TObject);
procedure SuperHullClick(Sender: TObject);
procedure N7Click(Sender: TObject);
procedure RealHullClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }

end;


const
MaxDots = 1000;
MaxLines = 96;
FX = 10;
FY = 50;
GenX = 1000; GenY = 1000;

type
Dot = record
X: integer;
Y: integer;
LN: integer;
color:integer;
end;

Line = record
Num: integer;
LeftX, RightX: integer;
Dotz: array[1..MaxDots] of Dot;
end;

var
MainForm: TMainForm;
DotsNum: integer; {количество точек}
Dots: array[1..MaxDots] of Dot;
CHDots: array[1..2*MaxDots] of Dot;
CHDotsNum: integer;
SCHDots: array[1..2*MaxDots] of Dot;
SCHDotsNum: integer;
RealDots: array[1..2*MaxDots] of Dot;
RealDotsNum: integer;
Lines: array[1..MaxLines] of Line;
apr: integer; {точность аппроксимации}
BitMap:TBitMap;
BitMap2:TBitMap;
count,count2, count22, count3: integer;
a,Tp:array [0..3*MaxDots] of AList;
a2,Tp2:array [0..3*MaxDots] of AList;
c,g:boolean;
c2,g2:boolean;
PDotsFlag, LinesFlag, CHFlag, DotsFlag, EditFlag, SDotsFlag, Fake, Auto:boolean;
astep:integer;
PDots: array[1..MaxDots] of Dot;
PDotsNum:integer;
SDots: array[1..3*MaxDots] of Dot;
SDotsNum:integer;
Mean, Dev: Extended;
GaussFlag: boolean;



procedure Sort_X();
procedure Calc_Lines();
procedure Take_Dots();
procedure Take_Super_Dots();
procedure Add_Dot(d: Dot);
procedure Add_Super_Dot(d: Dot);

procedure CreateConvex();
procedure CreateSConvex();
procedure CreateRealConvex();
procedure ClearAll();
procedure InitAll();
procedure Init4CH();

procedure DrawPoints();
procedure DrawPoint(x,y:integer; color:integer);
procedure DrawPDots();
procedure DrawSDots();
procedure DrawLines();

procedure DrawCHDots();
procedure DrawSCHDots();
procedure DrawRealDots();

implementation

uses gen, about, convex, convex2;



{$R *.DFM}

procedure TMainForm.N12Click(Sender: TObject);
begin
MainForm.Close();
end;

procedure TMainForm.DrawP(Sender: TObject);
begin
DrawPoints();
end;



procedure TMainForm.N11Click(Sender: TObject);
begin
GenForm.ShowModal();
end;


procedure TMainForm.N9Click(Sender: TObject);
var
FileOut: TextFile;
i:integer;
begin
If SaveDialog.Execute then
begin
AssignFile(FileOut, SaveDialog.FileName);
Rewrite(FileOut);
writeln(FileOut, DotsNum);
for i:=1 to DotsNum do
begin
writeln(FileOut, Dots[i].X);
writeln(FileOut, Dots[i].Y);
end;
CloseFile(FileOut);
end;
MainForm.StatusBar1.SimpleText:='Множество точек сохранено в файле';
end;

procedure TMainForm.ToolButton6Click(Sender: TObject);
begin
N9Click(MainForm);
end;

procedure TMainForm.N6Click(Sender: TObject);
var
FileIn: TextFile;
i:integer;
s:string;
begin
If OpenDialog.Execute then
begin
ClearAll();
AssignFile(FileIn, OpenDialog.FileName);
Reset(FileIn);
readln(FileIn, s);
DotsNum:=StrToInt(s);
for i:=1 to DotsNum do
begin
readln(FileIn, s);
Dots[i].X:=StrToInt(s);
readln(FileIn, s);
Dots[i].Y:=StrToInt(s);
Dots[i].color:=clBlue;
end;
CloseFile(FileIn);
LDotsNum.Caption:=IntToStr(DotsNum);
end;
DotsFlag:=true;
DrawPoints();
MainForm.StatusBar1.SimpleText:='Множество точек загружено из файла';
end;

procedure TMainForm.ToolButton4Click(Sender: TObject);
begin
N6Click(MainForm);
end;


procedure DrawPoint(x,y:integer; color:integer);
var
l_x, l_y, c_x, c_y, dx,dy: real;
begin
if MainForm.vis_dots.Checked then
begin
l_x:=MainForm.PaintBox1.Width/1000;
l_y:=MainForm.PaintBox1.Height/1000;
x:=round(x*l_x); y:=round(y*l_y);
with MainForm.PaintBox1.Canvas do
begin
Pixels[x, y] := color;
Pixels[x-1, y] := color;
Pixels[x+1, y] := color;
Pixels[x, y+1] := color;
Pixels[x, y-1] := color;
Pixels[x+1, y+1] := color;
Pixels[x+1, y-1] := color;
Pixels[x-1, y+1] := color;
Pixels[x-1, y-1] := color;
end;
end;
end;

procedure DrawPoints();
var
i: integer;
begin
for i:=1 to DotsNum do
begin
DrawPoint(Dots[i].x, Dots[i].y, Dots[i].color);
end;
end;


procedure TMainForm.TrackBar1Change(Sender: TObject);
begin
MainForm.Tochnost.Caption:=IntToStr(TrackBar1.Position);
apr:=TrackBar1.Position;
end;

procedure TMainForm.About1Click(Sender: TObject);
begin
AboutForm.ShowModal();
end;

procedure TMainForm.vis_dotsClick(Sender: TObject);
begin
if (MainForm.vis_dots.Checked=false) then
MainForm.vis_dots.Checked:=true
else
MainForm.vis_dots.Checked:=false;
MainForm.PaintBox1Paint(MainForm);
end;

procedure TMainForm.vis_polosiClick(Sender: TObject);
begin
if (MainForm.vis_polosi.Checked=false) then
MainForm.vis_polosi.Checked:=true
else
MainForm.vis_polosi.Checked:=false;
MainForm.PaintBox1Paint(MainForm);
end;

procedure TMainForm.vis_obolochkaClick(Sender: TObject);
begin
if (MainForm.vis_obolochka.Checked=false) then MainForm.vis_obolochka.Checked:=true
else MainForm.vis_obolochka.Checked:=false;
MainForm.PaintBox1Paint(MainForm);
end;

procedure Sort_X();
var
i, j: integer;
D: Dot;
begin
for j:=2 to DotsNum do
begin
for i:=2 to DotsNum do
begin
if Dots[i-1].X>Dots[i].X then
begin
D:=Dots[i-1];
Dots[i-1]:=Dots[i];
Dots[i]:=D;
end;
end;
end;
Dots[1].color:=clRed;
Dots[DotsNum].color:=clRed;
DrawPoint(Dots[1].x, Dots[1].y, clRed);
DrawPoint(Dots[DotsNum].x, Dots[DotsNum].y, clRed);
end;

procedure Calc_Lines();
var
i, j, k, CX, t: integer;
dlina, TC: real;
begin
LinesFlag:=true;
MainForm.PaintBox1Paint(MainForm);
dlina:=(Dots[DotsNum].X-Dots[1].X) / apr;
TC:=Dots[1].X+dlina;
CX:=round(TC);

for j:=1 to apr do
begin
for k:=1 to DotsNum do
begin
if ((Dots[k].X<=TC) and (Dots[k].X>=TC-dlina))
then Dots[k].LN:=j;
Lines[j].LeftX:=round(TC-dlina);
Lines[j].RightX:=round(TC);
if Dots[k].X=Dots[1].X then Dots[k].LN:=111;
if Dots[k].X=Dots[DotsNum].X then Dots[k].LN:=999;
end;
TC:=TC+dlina;
CX:=round(TC);
end;

Dots[1].LN:=111;
Dots[DotsNum].LN:=999;

k:=1;
for i:=1 to DotsNum do
begin
if (Dots[i].LN<>111) and (Dots[i].LN<>999) then
begin
if Dots[i].LN=k then
begin
Lines[k].Num:=Lines[k].Num+1;
t:=Lines[k].Num;
Lines[k].Dotz[t]:=Dots[i];
end
else
begin
k:=Dots[i].LN;
Lines[k].Num:=Lines[k].Num+1;
t:=Lines[k].Num;
Lines[k].Dotz[t]:=Dots[i];
end;
end;
end;

end;


procedure Take_Dots();
var
j,k: integer;
MaxD1, MinD1, MaxD9, MinD9, MaxD, MinD: Dot;
begin

MaxD1:=Dots[1]; MinD1:=Dots[1];
MaxD9:=Dots[DotsNum]; MinD9:=Dots[DotsNum];
for j:=1 to DotsNum do
begin
if Dots[j].LN=111 then
begin
if Dots[j].Y>MaxD1.Y then MaxD1:=Dots[j];
if Dots[j].Y<MinD1.Y then MinD1:=Dots[j];
end;
if Dots[j].LN=999 then
begin
if Dots[j].Y>MaxD9.Y then MaxD9:=Dots[j];
if Dots[j].Y<MinD9.Y then MinD9:=Dots[j];
end;
end;


if (MaxD9.X=MinD9.X) and (MaxD9.Y=MinD9.Y) then Add_Dot(Dots[DotsNum])
else
begin
Add_Dot(MaxD9);
Add_Dot(MinD9);
end;


if (MaxD1.X=MinD1.X) and (MaxD1.Y=MinD1.Y) then Add_Dot(Dots[1])
else
begin
Add_Dot(MaxD1);
Add_Dot(MinD1);
end;

for j:=1 to apr do
begin
if Lines[j].Num=1 then Add_Dot(Lines[j].Dotz[1]);

If Lines[j].Num=2 then
begin
Add_Dot(Lines[j].Dotz[1]);
Add_Dot(Lines[j].Dotz[2]);
end;

If Lines[j].Num>2 then
begin
MaxD:=Lines[j].Dotz[1]; MinD:=Lines[j].Dotz[1];
for k:=1 to Lines[j].Num do
begin
if (Lines[j].Dotz[k].Y>MaxD.Y) then MaxD:=Lines[j].Dotz[k];
if (Lines[j].Dotz[k].Y<MinD.Y) then MinD:=Lines[j].Dotz[k];
end;
Add_Dot(MaxD);
Add_Dot(MinD);
end;

end;

end;

procedure Add_Dot(d: Dot);
begin
PDotsFlag:=true;
PDotsNum:=PDotsNum+1;
PDots[PDotsNum].X:=d.X;
PDots[PDotsNum].Y:=d.Y;
PDots[PDotsNum].color:=clFuchsia;
a[count].x:=d.X;
a[count].y:=d.Y;
a[count].number:=count+1;
inc(count);
if PDotsFlag and MainForm.vis_dots.checked then DrawPDots();
end;


procedure Take_Super_Dots();
var
j,k: integer;
MaxD1, MinD1, MaxD9, MinD9, MaxD, MinD, TempD: Dot;
begin

MaxD1:=Dots[1]; MinD1:=Dots[1];
MaxD9:=Dots[DotsNum]; MinD9:=Dots[DotsNum];

for j:=1 to DotsNum do
begin
if Dots[j].LN=111 then
begin
if Dots[j].Y>MaxD1.Y then MaxD1:=Dots[j];
if Dots[j].Y<MinD1.Y then MinD1:=Dots[j];
end;
if Dots[j].LN=999 then
begin
if Dots[j].Y>MaxD9.Y then MaxD9:=Dots[j];
if Dots[j].Y<MinD9.Y then MinD9:=Dots[j];
end;
end;


if (MaxD9.X=MinD9.X) and (MaxD9.Y=MinD9.Y) then Add_Super_Dot(Dots[DotsNum])
else
begin
Add_Super_Dot(MaxD9);
Add_Super_Dot(MinD9);
end;


if (MaxD1.X=MinD1.X) and (MaxD1.Y=MinD1.Y) then Add_Super_Dot(Dots[1])
else
begin
Add_Super_Dot(MaxD1);
Add_Super_Dot(MinD1);
end;

for j:=1 to apr do
begin
if Lines[j].Num=1 then
begin
TempD:=Lines[j].Dotz[1];
TempD.X:=Lines[j].LeftX;
Add_Super_Dot(TempD);
TempD.X:=Lines[j].RightX;
Add_Super_Dot(TempD);
end;

If Lines[j].Num=2 then
begin
TempD:=Lines[j].Dotz[1];
TempD.X:=Lines[j].LeftX;
Add_Super_Dot(TempD);
TempD.X:=Lines[j].RightX;
Add_Super_Dot(TempD);

TempD:=Lines[j].Dotz[2];
TempD.X:=Lines[j].LeftX;
Add_Super_Dot(TempD);
TempD.X:=Lines[j].RightX;
Add_Super_Dot(TempD);
end;

If Lines[j].Num>2 then
begin
MaxD:=Lines[j].Dotz[1]; MinD:=Lines[j].Dotz[1];
for k:=1 to Lines[j].Num do
begin
if (Lines[j].Dotz[k].Y>MaxD.Y) then MaxD:=Lines[j].Dotz[k];
if (Lines[j].Dotz[k].Y<MinD.Y) then MinD:=Lines[j].Dotz[k];
end;
TempD:=MaxD;
TempD.X:=Lines[j].LeftX;
Add_Super_Dot(TempD);
TempD.X:=Lines[j].RightX;
Add_Super_Dot(TempD);

TempD:=MinD;
TempD.X:=Lines[j].LeftX;
Add_Super_Dot(TempD);
TempD.X:=Lines[j].RightX;
Add_Super_Dot(TempD);
end;

end;

end;



procedure Add_Super_Dot(d: Dot);
begin
if Fake=false then
begin
a[count].x:=d.X;
a[count].y:=d.Y;
a[count].number:=count+1;
inc(count);
end;

if Fake=true then
begin
SDotsFlag:=true;
SDotsNum:=SDotsNum+1;
SDots[SDotsNum].X:=d.X;
SDots[SDotsNum].Y:=d.Y;
SDots[SDotsNum].color:=clFuchsia;
if SDotsFlag and MainForm.vis_dots.checked then DrawSDots();
end;

end;




procedure TMainForm.startClick(Sender: TObject);
begin
if (DotsNum>2) and (CHFlag=false) then
begin

If RealHull.Checked then
begin
CreateRealConvex();
Init4CH();
end;
EditFlag:=false;
Sort_X();
Calc_Lines();
If ConvexHull.Checked then
begin
Take_Dots();
CreateConvex();
Init4CH();
end;
If SuperHull.Checked then
begin
Auto:=true;
Take_Super_Dots();
Auto:=false;
CreateSConvex();
Init4CH();
end;
end;
end;


procedure CreateConvex();
var
h:integer;
begin
CHFlag:=true;
FromWaht;
sort;
for h:=0 to MyList.Count-1 do ARecord := MyList.Items[h];
CHConstr(MyList);
c:=true;
CHPaint(Tp[1],MyList);
MainForm.PaintBox1.Canvas.Pen.color:=clBlue;
DrawCHDots();

MainForm.StatusBar1.SimpleText:='Аппроксимация выпуклой оболочки построена';
end;


procedure CreateSConvex();
var
h:integer;
begin
CHFlag:=true;
FromWaht;
sort;
for h:=0 to MyList.Count-1 do ARecord := MyList.Items[h];
CHConstr(MyList);
c2:=true;
SCHPaint(Tp[1],MyList);
MainForm.PaintBox1.Canvas.Pen.color:=clGreen;
DrawSCHDots();
end;


procedure CreateRealConvex();
var
h,i:integer;
begin
for i:=1 to DotsNum do
begin
a[count].x:=Dots[i].X;
a[count].y:=Dots[i].Y;
a[count].number:=count+1;
inc(count);
end;
CHFlag:=true;
FromWaht;
sort;
for h:=0 to MyList.Count-1 do ARecord := MyList.Items[h];
CHConstr(MyList);
c:=true;
RealPaint(Tp[1],MyList);
MainForm.PaintBox1.Canvas.Pen.color:=clRed;
DrawRealDots();
end;


procedure TMainForm.StartButtonClick(Sender: TObject);
begin
MainForm.startClick(MainForm);
end;

procedure TMainForm.ToolButton1Click(Sender: TObject);
begin
ClearAll();
end;

procedure TMainForm.ToolButton11Click(Sender: TObject);
begin
MainForm.N7Click(MainForm);
end;


procedure TMainForm.FormCreate(Sender: TObject);
begin
InitAll();

end;

procedure TMainForm.N10Click(Sender: TObject);
begin
MainForm.N9Click(MainForm);
end;

procedure TMainForm.N8Click(Sender: TObject);
begin
ClearAll();
end;

procedure TMainForm.SavePaintBox(Sender: TObject);
var MyRect: TRect;
begin
MyRect := Rect(0,0,PaintBox1.Width,PaintBox1.Height);
Bitmap.Canvas.CopyRect(MyRect,MainForm.PaintBox1.Canvas,MyRect);
end;


procedure TMainForm.bmp1Click(Sender: TObject);
var
str,ext,s:string;
begin
MainForm.SavePaintBox(MainForm);
if SaveDialog1.Execute
then
begin
str:=SaveDialog1.FileName;
ext:='.bmp';
s:=ChangeFileExt(str,ext);
BitMap.SaveToFile(s);
end;
end;

procedure TMainForm.nextClick(Sender: TObject);
var
j,k: integer;
MaxD1, MinD1, MaxD9, MinD9, MaxD, MinD, TempD: Dot;
begin
if (DotsNum>2) and (CHFlag=false) then
begin
astep:=astep+1;
EditFlag:=false;

if astep=1 then
begin
Sort_X();
Calc_Lines();
end;

if astep=2 then
begin
If ConvexHull.Checked then Take_Dots();
If SuperHull.Checked then
begin
Fake:=true;
Take_Super_Dots();
Fake:=false;
end;
end;

if astep=3 then
begin
If ConvexHull.Checked then
begin
CreateConvex();
Init4CH();
end;

If SuperHull.Checked then
begin
Take_Super_Dots();
CreateSConvex();
Init4CH();
end;

If RealHull.Checked then CreateRealConvex();
MainForm.PaintBox1Paint(MainForm);
end;

end;
end;

procedure TMainForm.NextButtonClick(Sender: TObject);
begin
MainForm.nextClick(MainForm);
end;


procedure TMainForm.go2beginClick(Sender: TObject);
begin
MainForm.ToBeginButtonClick(MainForm);
end;

procedure DrawPDots();
var
i:integer;
begin
for i:=1 to PDotsNum do DrawPoint(PDots[i].X, PDots[i].Y, PDots[i].color);
end;

procedure DrawSDots();
var
i:integer;
begin
for i:=1 to SDotsNum do DrawPoint(SDots[i].X, SDots[i].Y, SDots[i].color);
end;

procedure DrawLines();
var
i,CX:integer;
TC,dlina,l_x,l_y:real;
mx1,mx2: integer;
begin
l_x:=MainForm.PaintBox1.Width/GenX;
l_y:=MainForm.PaintBox1.Height/GenY;
mx1:=round(Dots[1].X*l_x);
mx2:=round(Dots[DotsNum].X*l_x);
dlina:=(mx2-mx1) / apr;
TC:=mx1+dlina;
CX:=round(TC);
if MainForm.vis_polosi.Checked then
begin
for i:=2 to (MainForm.PaintBox1.Height-4) do MainForm.PaintBox1.Canvas.Pixels[mx1, i] := clGray;
for i:=2 to (MainForm.PaintBox1.Height-4) do MainForm.PaintBox1.Canvas.Pixels[mx2, i] := clGray;
end;
repeat
if MainForm.vis_polosi.Checked then
for i:=2 to (MainForm.PaintBox1.Height-4) do MainForm.PaintBox1.Canvas.Pixels[CX, i] := clGray;
TC:=TC+dlina;
CX:=round(TC);
until (TC>mx2);
end;

procedure DrawCHDots();
var i:integer;
l_x, l_y: real;
mx, my: integer;
begin
l_x:=MainForm.PaintBox1.Width/1000;
l_y:=MainForm.PaintBox1.Height/1000;
i:=0;
MainForm.PaintBox1.canvas.pen.color:= clBlue;
while (i<CHDotsNum) do
begin
i:=i+1;
mx:=round(CHDots[i].X*l_x); my:=round(CHDots[i].Y*l_y);
If MainForm.vis_obolochka.Checked then MainForm.PaintBox1.Canvas.MoveTo(mx,my);
mx:=round(CHDots[i+1].X*l_x); my:=round(CHDots[i+1].Y*l_y);
If MainForm.vis_obolochka.Checked then MainForm.PaintBox1.Canvas.LineTo(mx,my);
i:=i+1;
end;
end;


procedure DrawSCHDots();
var i:integer;
l_x, l_y: real;
mx, my: integer;
begin
MainForm.PaintBox1.canvas.pen.color:= clGreen;
l_x:=MainForm.PaintBox1.Width/1000;
l_y:=MainForm.PaintBox1.Height/1000;
i:=0;
while (i<SCHDotsNum) do
begin
i:=i+1;
mx:=round(SCHDots[i].X*l_x); my:=round(SCHDots[i].Y*l_y);
If MainForm.vis_obolochka.Checked then MainForm.PaintBox1.Canvas.MoveTo(mx,my);
mx:=round(SCHDots[i+1].X*l_x); my:=round(SCHDots[i+1].Y*l_y);
If MainForm.vis_obolochka.Checked then MainForm.PaintBox1.Canvas.LineTo(mx,my);
i:=i+1;
end;
end;


procedure DrawRealDots();
var i:integer;
l_x, l_y: real;
mx, my: integer;
begin
MainForm.PaintBox1.canvas.pen.color:= clRed;
l_x:=MainForm.PaintBox1.Width/1000;
l_y:=MainForm.PaintBox1.Height/1000;
i:=0;
while (i<RealDotsNum) do
begin
i:=i+1;
mx:=round(RealDots[i].X*l_x); my:=round(RealDots[i].Y*l_y);
If MainForm.vis_obolochka.Checked then MainForm.PaintBox1.Canvas.MoveTo(mx,my);
mx:=round(RealDots[i+1].X*l_x); my:=round(RealDots[i+1].Y*l_y);
If MainForm.vis_obolochka.Checked then MainForm.PaintBox1.Canvas.LineTo(mx,my);
i:=i+1;
end;
end;


procedure TMainForm.PaintBox1Paint(Sender: TObject);
begin
with MainForm.PaintBox1 do
begin
Canvas.Brush.Color:= clWhite;
Canvas.Pen.Color:= clBlack;
Canvas.RoundRect(0,0,Width,Height,10,10);
end;
if DotsFlag and vis_dots.checked then DrawPoints();
if PDotsFlag and vis_dots.checked then DrawPDots();
if SDotsFlag and vis_dots.checked then DrawSDots();
if LinesFlag and vis_polosi.checked then DrawLines();
if CHFlag and vis_obolochka.checked then DrawRealDots();
if CHFlag and vis_obolochka.checked and SuperHull.Checked then DrawSCHDots();
if CHFlag and vis_obolochka.checked and ConvexHull.Checked then DrawCHDots();
end;


procedure TMainForm.N5Click(Sender: TObject);
begin
ClearAll();
end;

procedure InitAll();
var
i:integer;
begin
apr:=MainForm.TrackBar1.Position;
MainForm.Tochnost.Caption:=IntToStr(apr);
MainForm.LDotsNum.Caption:='';
count:=0;
count2:=0;
count22:=0;
for i:=1 to MaxLines do Lines[i].Num:=0;
c:=false; g:=false;
BitMap:= TBitmap.Create;
BitMap.Width:=MainForm.PaintBox1.Width;
BitMap.Height:=MainForm.PaintBox1.Height;
astep:=0;
DotsNum:=0;
PDotsNum:=0;
SDotsNum:=0;
SDotsFlag:=false;
PDotsFlag:=false;
LinesFlag:=false;
CHFlag:=false;
DotsFlag:=false;
EditFlag:=false;
MainForm.StatusBar1.SimplePanel:=true;
MainForm.StatusBar1.SimpleText:='Ready';
MainForm.PaintBox1Paint(MainForm);
Mean:=500; Dev:=100;
MainForm.MeanLabel.Caption:='';
MainForm.DevLabel.Caption:='';
CHDotsNum:=0;
SCHDotsNum:=0;
RealDotsNum:=0;
Fake:=false;
Auto:=false;
end;



procedure Init4CH();
var
i:integer;
begin
count:=0;
count2:=0;
c:=false; g:=false;
MainForm.PaintBox1Paint(MainForm);
if (MyList<>nil) then MyList.Clear;
if (AndrList<>nil) then AndrList.Clear;
if (AndrDownList<>nil) then AndrDownList.Clear;
if (AndrUpList<>nil) then AndrUpList.Clear;
MyList:=nil;
end;




procedure ClearAll();
begin
InitAll();
if (MyList<>nil) then MyList.Clear;
if (AndrList<>nil) then AndrList.Clear;
if (AndrDownList<>nil) then AndrDownList.Clear;
if (AndrUpList<>nil) then AndrUpList.Clear;
MyList:=nil;
end;


procedure TMainForm.ToBeginButtonClick(Sender: TObject);
var
i:integer;
begin
if DotsNum>2 then
begin

for i:=1 to MaxLines do Lines[i].Num:=0;
astep:=0;
DotsFlag:=true;
PDotsFlag:=false;
SDotsFlag:=false;
LinesFlag:=false;
CHFlag:=false;
Dots[1].color:=clBlue;
Dots[DotsNum].color:=clBlue;
if (MyList<>nil) then MyList.Clear;
if (AndrList<>nil) then AndrList.Clear;
if (AndrDownList<>nil) then AndrDownList.Clear;
if (AndrUpList<>nil) then AndrUpList.Clear;
count:=0;
count2:=0;
SDotsNum:=0; PDotsNum:=0;

MyList:=nil;
MainForm.StatusBar1.SimpleText:='Ready';
MainForm.PaintBox1Paint(MainForm);

CHDotsNum:=0;
SCHDotsNum:=0;
RealDotsNum:=0;

Fake:=false;
Auto:=false;
end;
end;

procedure TMainForm.Button1Click(Sender: TObject);
begin
EditFlag:=true;
end;


procedure TMainForm.EditButtonClick(Sender: TObject);
begin
MainForm.Edit_menuClick(MainForm);
end;

procedure TMainForm.Edit_menuClick(Sender: TObject);
begin
If (PDotsFlag=false) and (LinesFlag=false) and (CHFlag=false) then
begin
EditFlag:=true;
MainForm.StatusBar1.SimpleText:='Режим редактирования';
end;
end;

procedure TMainForm.PaintBox1MouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
l_x, l_y: real;
begin
if EditFlag then
begin
DotsFlag:=true;
l_x:=MainForm.PaintBox1.Width/1000;
l_y:=MainForm.PaintBox1.Height/1000;
DotsNum:=DotsNum+1;
Dots[DotsNum].X:=round(X/l_x);
Dots[DotsNum].Y:=round(Y/l_y);
Dots[DotsNum].color:=clBlue;
MainForm.PaintBox1Paint(MainForm);
end;
end;



procedure TMainForm.FormResize(Sender: TObject);
begin
PaintBox1.Width:=MainForm.Width-275;
PaintBox1.Height:=MainForm.Height-120;

{
with MainForm do
begin
framePictureOwner1.Width:=MainForm.Width-275;
framePictureOwner1.Height:=MainForm.Height-120;
end;
}
end;

procedure TMainForm.ConvexHullClick(Sender: TObject);
begin
If ConvexHull.Checked=false then ConvexHull.Checked:=true
else ConvexHull.Checked:=false;
end;

procedure TMainForm.SuperHullClick(Sender: TObject);
begin
If SuperHull.Checked=false then SuperHull.Checked:=true
else SuperHull.Checked:=false;
end;

procedure TMainForm.N7Click(Sender: TObject);
begin
Application.HelpFile := 'nonscrol.hlp';
Application.HelpJump('1');
end;

procedure TMainForm.RealHullClick(Sender: TObject);
begin
If RealHull.Checked=false then RealHull.Checked:=true
else RealHull.Checked:=false;
end;

end.
Соседние файлы в папке SOURCE
  • #
    01.05.2014979 б17List.pas
  • #
    01.05.2014961 б17List.~pas
  • #
    01.05.201427.4 Кб18Main.dcu
  • #
    01.05.201451 б17Main.ddp
  • #
    01.05.201442.18 Кб17Main.dfm
  • #
    01.05.201426.03 Кб18Main.pas
  • #
    01.05.201451 б18Main.~ddp
  • #
    01.05.201442.62 Кб18Main.~dfm
  • #
    01.05.201426.13 Кб17Main.~pas
  • #
    01.05.2014485 б17MYDET.DCU
  • #
    01.05.2014220 б17MYDET.PAS