Бугреев ПЗ (1231492), страница 11
Текст из файла (страница 11)
end;
### Вызов формы №2 с алгоритмами рекурсии ###
procedure TForm2.Button1Click(Sender: TObject);
begin
Form1.Show;
end;
### Отрисовка кривых Безье ###
procedure TForm2.Button2Click(Sender: TObject);
var i,j,q : Integer;
begin
i:=UpDown1.Position; // Bezier number
for j := 0 to 100 do begin
if S[j].Sp=i then begin
PB[i,S[j].PtSp].x:=S[j].xx; PB[i,S[j].PtSp].y:=S[j].yy;
SH[j].Left:=S[j].xx-Shape1.Width div 2; SH[j].Top:=S[j].yy-Shape1.Width div 2; end;
BitBtn2Click(nil); end;
PaintBox1.Canvas.Brush.Color:=clNavy;PaintBox1.Canvas.Pen.Color:=clBlack;
PaintBox1.Canvas.PolyBezier(Pb[i]);
end;
procedure TForm2.Button3Click(Sender: TObject);
begin
SetSpline(UpDown1.Position);
end;
procedure TForm2.Button4Click(Sender: TObject);
begin
PaintBox1.Refresh;
end;
### Отрисовка вспомогательных линий ###
procedure TForm2.Button5Click(Sender: TObject);
var i : Integer;
begin
i:=UpDown1.Position;
with PaintBox1.Canvas do begin
Lin(PB[i,1], PB[i,2], clRed); Lin(PB[i,4], PB[i,3], clRed);
end;
end;
### Вычисление координат точки на кривой Безье от параметра t ###
procedure TForm2.Button6Click(Sender: TObject);
var i : Integer;
begin
i:=UpDown1.Position; t := StrToFloat(Edit2.Text);
x := power(1-t, 3)*PB[i,1].x+3*t*sqr(1-t)*PB[i,2].x+3*sqr(t)*(1-t)*PB[i,3].x + power(t,3)*PB[i,4].x;
y := power(1-t, 3)*PB[i,1].y+3*t*sqr(1-t)*PB[i,2].y+3*sqr(t)*(1-t)*PB[i,3].y + power(t,3)*PB[i,4].y;
Shape2.Left:=Round(x)-(Shape2.Width div 2); Shape2.Top:= Round(y)-(Shape2.Height div 2);
end;
### Сохранение отрисованных сплайнов в файл ###
procedure TForm2.Button7Click(Sender: TObject);
var Path : string; F,i : Integer;
begin
Path:=ExtractFileDir(Application.ExeName)+'\pb.dat';
F:=FileCreate(Path); i:=101; FileWrite(F,i,SizeOf(i));
for i:= 0 to 100 do
FileWrite(F,PB[i],SizeOf(PB[i])); FileClose(F); Path:=ExtractFileDir(Application.ExeName)+'\S.dat';
F:=FileCreate(Path); i:=101; FileWrite(F,i,SizeOf(i));
for i:= 0 to 100 do
FileWrite(F,S[i],SizeOf(S[i])); FileClose(F);
end;
### Загрузка отрисованных сплайнов из файла ###
procedure TForm2.Button8Click(Sender: TObject);
var Path : string; F,i,n : Integer;
begin
Path:=ExtractFileDir(Application.ExeName)+'\pb.dat';
F:=FileOpen(Path,0); n:=FileRead(F,n,SizeOf(i));
for i:= 0 to 100 do
n:=FileRead(F,PB[i],SizeOf(PB[i]));FileClose(F);
Path:=ExtractFileDir(Application.ExeName)+'\S.dat';
F:=FileOpen(Path,0); n:=FileRead(F,n,SizeOf(i));
for i:= 0 to 100 do
n:=FileRead(F,S[i],SizeOf(S[i])); FileClose(F); Button2Click(nil); Bitbtn7.Enabled:=true;
end;
type TVec = record
x,y : single;
end;
Var m0,p0,p1,m1 : TPoint; pt,p1t,at,bt,ct,dt : Tvec;
### Алгоритм Катмулл-Рома ###
procedure TForm2.Button9Click(Sender: TObject);
var i : Integer; q:real;
begin
i:=UpDown1.Position; t := 0.33;
p0.x := Round(power(1-t, 3)*PB[i,1].x+3*t*sqr(1-t)*PB[i,2].x+3*sqr(t)*(1-t)*PB[i,3].x
+ power(t,3)*PB[i,4].x);
p0.y := Round(power(1-t, 3)*PB[i,1].y+3*t*sqr(1-t)*PB[i,2].y+3*sqr(t)*(1-t)*PB[i,3].y
+ power(t,3)*PB[i,4].y);
Shape2.Left:=Round(p0.x)-(Shape2.Width div 2);
Shape2.Top:= Round(p0.y)-(Shape2.Height div 2); t := 0.66;
p1.x := Round(power(1-t, 3)*PB[i,1].x+3*t*sqr(1-t)*PB[i,2].x+3*sqr(t)*(1-t)*PB[i,3].x
+ power(t,3)*PB[i,4].x);
p1.y := Round(power(1-t, 3)*PB[i,1].y+3*t*sqr(1-t)*PB[i,2].y+3*sqr(t)*(1-t)*PB[i,3].y
+ power(t,3)*PB[i,4].y);
Shape3.Left:=Round(p1.x) -(Shape3.Width div 2);
Shape3.Top:= Round(p1.y) -(Shape3.Height div 2); m0:=PB[i,1]; m1:=PB[i,4];
at.x:= 1.5*(p0.x-p1.x)+0.5*(m1.x-m0.x); at.y:= 1.5*(p0.y-p1.y)+0.5*(m1.y-m0.y);
bt.x:= -(2.5*p0.x + (2*p1.x)) - (0.5*m1.x + m0.x); bt.y:= -(2.5*p0.y + (2*p1.y)) - (0.5*m1.y + m0.y);
ct.x:= (p1.x - m0.x)/2; ct.y:= (p1.y - m0.y)/2; dt.x:= p0.x; dt.y:= p0.y; t:=0.1;
for i:= 0 to 9 do begin
Pt.x:= ((at.x*t + bt.x)*t + ct.x)*t + dt.x; Pt.y:= ((at.y*t + bt.y)*t + ct.y)*t + dt.y;
P1t.x:= (3*at.x*t*t) + (2*bt.x*t) + ct.x; P1t.y:= (3*at.y*t*t) + (2*bt.y*t) + ct.y;
x:=t*P1t.x; y:=t*P1t.y; q:=(Sqrt(sqr(Pt.x-m0.x)+sqr(Pt.y-m0.y))); q:=3*2+5*2;
p0.x :=Trunc(((at.x*q + bt.x)*q + ct.x)*q + dt.x); p0.y :=Trunc(((at.y*q + bt.y)*q + ct.y)*q + dt.y);
form2.Sb.Panels[8].Text:=Floattostr(q); Sh[i].Left:=Round(P0.x)-(Sh[i].Width div 2);
Sh[i].Top:= Round(P0.y) -(Sh[i].Height div 2); t:=t+0.1;
end;
end;
### Процедура, выполняемая при открытии формы ###
procedure TForm2.FormCreate(Sender: TObject);
var i : Integer; fullfilename:string;
begin
for i:= 0 to 100 do begin SH[i]:=TShape.Create(Form2);
with SH[i] do begin
Left:=Left+i*5; top:=Shape1.Top; Width:=Shape1.Width;
Height:=Shape1.Height; Brush.Color:=Shape1.Brush.Color;
Shape:=Shape1.Shape; OnMouseDown:=Shape1.OnMouseDown;
OnMouseMove:=Shape1.OnMouseMove;OnMouseUp:=Shape1.OnMouseUp;
Tag:=i; Hint:=IntToStr(i); ShowHint:=Shape1.ShowHint;
end;
Form2.Panel1.InsertControl(SH[i]);
end;
Caption:=Application.ExeName; fullFileName:=Caption; DB.Connected:=False;
DB.DBName:=('localhost:'+ ExtractFileDir(fullFileName)+'\DB_OPORA.GDB');
DB.Connected:=True; DT1.Active:=True; DS1.Active:=True; DS2.Active:=True;
DS3.Active:=True; DoubleBuffered := True;
end;
### Занесение в строковую панель текущего положения мыши на форме ###
procedure TForm2.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
Sb.Panels[5].Text:=IntToStr(PaintBox1.Left+x); Sb.Panels[6].Text:=IntToStr(PaintBox1.Top+y);
end;
### Назначение опорным точкам данных о принадлежности к сплайну и их окраска ###
procedure TForm2.Shape1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var i : Integer;
begin
if ssleft in Shift then EnabledMove:=True else begin
i:= (Sender as TShape).Tag; if ssAlt in Shift then
(Sender as TShape).ShowHint:=Not (Sender as TShape).ShowHint;
if ssCtrl in Shift then S[i].PtSp:=1+((S[i].PtSp) mod 4); if ssShift in Shift then
begin
S[i].Sp:=UpDown1.Position;
(Sender as TShape).Brush.Color:=RGB(32,S[i].Sp*30,(S[i].Sp*50) mod 256);
end;
(Sender as TShape).Hint:=IntToStr(i)+'; '+CHRS[S[i].PtSp]+'; '+IntToStr(S[i].Sp);
end;
end;
### Занесение в строковую панель текущего положения центров опорных точек ###
procedure TForm2.Shape1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if EnabledMove then begin
with Sender as TShape do begin
left:=Left - (Width div 2)+x; top:=top - (height div 2)+y;
S[Tag].xx:=Left + (Width div 2); S[Tag].yy:=top + (height div 2); Sb.Panels[0].Text:=IntToStr(Left);
Sb.Panels[2].Text:=IntToStr(Top); Sb.Panels[1].Text:=IntToStr(S[Tag].xx);
Sb.Panels[3].Text:=IntToStr(S[Tag].yy);Sb.Panels[4].Text:=Hint;
end;
end;
end;
procedure TForm2.Shape1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
EnabledMove:=False;
end;
### Вычисление координат 1000 точек на кривой Безье для радиус-векторов ###
procedure TForm2.BitBtn22Click(Sender: TObject);
var t,bezX,bezY:real; Str:Integer;
begin t:=0; Str:=1;
while t<1.0001 do begin
bezX := power(1-t, 3)*PB[StrToInt(Edit1.Text),1].x+ 3*t*sqr(1-t)*PB[StrToInt(Edit1.Text),2].x
+ 3*sqr(t)*(1-t)*PB[StrToInt(Edit1.Text),3].x + power(t,3)*PB[StrToInt(Edit1.Text),4].x;
bezy := power(1-t, 3)*PB[StrToInt(Edit1.Text),1].y + 3*t*sqr(1-t)*PB[StrToInt(Edit1.Text),2].y
+ 3*sqr(t)*(1-t)*PB[StrToInt(Edit1.Text),3].y + power(t,3)*PB[StrToInt(Edit1.Text),4].y;
SG2.Cells[StrToInt(Edit1.Text)*2+1,0]:='X'+Edit1.Text;
SG2.Cells[StrToInt(Edit1.Text)*2+2,0]:='Y'+Edit1.Text;
SG2.Cells[StrToInt(Edit1.Text)*2+1,Str]:=FloatToStr (bezX);
SG2.Cells[StrToInt(Edit1.Text)*2+2,Str]:=FloatToStr (bezY);
SG2.Cells[0,Str]:=IntToStr(Str); Inc(Str); t:=t+0.0001;
end;
end;
### Алгоритм Радиус-Векторов ###
procedure TForm2.BitBtn1Click(Sender: TObject);
var x,y,ax,ay,res:real; str,n,r:integer;
begin
str:=1; n:=1; R:=0;
while R<10 do begin
while res<>100 do begin
x:=StrToFloat(SG2.Cells[StrToInt(Edit1.Text)*2+1,n]);
y:=StrToFloat(SG2.Cells[StrToInt(Edit1.Text)*2+2,n]);
ax:=StrToFloat(SG2.Cells[StrToInt(Edit1.Text)*2+1,1+Str]);
ay:=StrToFloat(SG2.Cells[StrToInt(Edit1.Text)*2+2,1+Str]);
res:=trunc((ax-x)*(ax-x)+(ay-y)*(ay-y)); Inc(str);
end; res:=0; n:=Str; Inc(R);
end;
end;
### Вычисления необходимых данных о векторах метода аппроксимации векторами ###
procedure TForm2.BitBtn2Click(Sender: TObject);
var bezX,bezY,deltX,deltY,t,L,a,b,c,d,arc:real;str:integer;
begin
t:=0; str:=(10*(StrToInt(Edit1.Text)-1)+1); //Х и У по формуле Безье
while t<1.01 do begin
bezX := power(1-t, 3)*PB[StrToInt(Edit1.Text),1].x + 3*t*sqr(1-t)*PB[StrToInt(Edit1.Text),2].x
+ 3*sqr(t)*(1-t)*PB[StrToInt(Edit1.Text),3].x + power(t,3)*PB[StrToInt(Edit1.Text),4].x;
bezy := power(1-t, 3)*PB[StrToInt(Edit1.Text),1].y + 3*t*sqr(1-t)*PB[StrToInt(Edit1.Text),2].y
+ 3*sqr(t)*(1-t)*PB[StrToInt(Edit1.Text),3].y + power(t,3)*PB[StrToInt(Edit1.Text),4].y;
PromDat[str].RealX:=bezX; PromDat[str].RealY:=bezY; PromDat[str].t:=t;
SG2.Cells[1,0]:='realX'; SG2.Cells[2,0]:='realY'; SG2.Cells[1,Str]:=Floattostr(PromDat[str].realX);
SG2.Cells[2,Str]:=Floattostr(PromDat[str].realY);
SG2.Cells[0,Str]:=FloatToStr(PromDat[str].t); Inc(Str); t:=t+0.1;
end;
str:=(10*(StrToInt(Edit1.Text)-1)+1); //разница Х и У для каждой точки
while str<(10*(StrToInt(Edit1.Text))+1) do begin
deltX:=(StrtoFloat(SG2.Cells[1,str+1])-Strtofloat(SG2.Cells[1,str]));
delty:=(Strtofloat(SG2.Cells[2,str+1])-Strtofloat(SG2.Cells[2,str]));
PromDat[str].DeltX:=deltX; PromDat[str].DeltY:=deltY; SG2.Cells[3,0]:='deltX';
SG2.Cells[4,0]:='deltY'; SG2.Cells[3,str+1]:=FloatToStr (PromDat[str].DeltX);
SG2.Cells[4,str+1]:=FloatToStr (PromDat[str].DeltY); Inc(str);
![](https://s.studizba.com/z.php?f=/templates/si/i/noavatar.png&w=100&h=100&t=1"){kind=avatar}
