Пользователь
Регистрация: 28.10.2018
Сообщений: 25
|
Аналитическая геометрия
Подскажите пожалуйста, как сделать, чтоб координатная сетка не исчезала при введении новых координат, а то, график чертится, а сами оси удаляются...?
Код:
public
{ Public declarations }
end;
var
Form1: TForm1;
const xn=-6;
xk=4;
yn=-6;
yk=3;
var x1,y1,x2,y2,x3,y3:double;
a1,b1,c1,a2,b2,c2,x4,y4,x5,y5,xo,yo:double;
d,h,w,k,x0,y0:integer;
m:real;
implementation
uses Unit2, Unit3, Unit4, Unit5;
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
Image1.Width:=Image1.Height;
x0:=round(Image1.Width*6/10); //начало координат
y0:=round(Image1.Height*3/9);
m:=(x0-30)/6;
with Image1.Canvas do
begin //оси
pen.Width:=2;
Pen.Color:=ColorBox1.Selected;
moveto(x0-round(6*m),y0);
lineto(x0+round(4*m),y0);
moveto(x0,y0-round(3*m));
lineto(x0,y0+round(6*m));
textout(x0+round(4*m),y0-20,'X');
textout(x0+5,y0-round(3*m)-10,'Y');
textout(x0+5,y0+10,'0');
//разметка осей
pen.Color:=clBlack;
pen.Width:=1;
for k:=1 to 6 do
begin
//ось Х влево
moveto(x0-round(k*m+1),y0-3);
lineto(x0-round(k*m+1),y0+3);
textout(x0-round(k*m+8),y0+10,inttostr(-k));
if k<5 then
begin
//ось Х вправо
moveto(x0+round(k*m+1),y0-3);
lineto(x0+round(k*m+1),y0+3);
textout(x0+round(k*m-1),y0+10,inttostr(k));
end;
//ось Y вниз
moveto(x0-3,y0+round(k*m+1));
lineto(x0+3,y0+round(k*m+1));
textout(x0-25,y0+round(k*m-1)-5,inttostr(-k));
if k<4 then
begin
//ось Y вверх
moveto(x0-3,y0-round(k*m+1));
lineto(x0+3,y0-round(k*m+1));
textout(x0-20,y0-round(k*m+1)-5,inttostr(k));
end;
end;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
Image1.Canvas.Pen.Color:=clWhite;
Image1.Canvas.Rectangle(0,0,ClientWidth,ClientHeight);//автоматически удаляет старый график
h:=Image1.Height;
w:=Image1.Width;
d:=41;
//ввод данных с проверкой
val(Edit1.Text,x1,k);
if(k<>0)or(x1<xn)or(x1>xk)then
begin
ShowMessage('Неверно введена координата Х 1 точки');
Edit1.Clear;
Edit1.SetFocus;
exit;
end;
val(Edit2.Text,y1,k);
if(k<>0)or(y1<yn)or(y1>yk) then
begin
ShowMessage('Неверно введена координата Y 1 точки');
Edit2.Clear;
Edit2.SetFocus;
exit;
end;
val(Edit3.Text,x2,k);
if(k<>0)or(x2<xn)or(x2>xk) then
begin
ShowMessage('Неверно введена координата X 2 точки');
Edit3.Clear;
Edit3.SetFocus;
exit;
end;
val(Edit4.Text,y2,k);
if(k<>0)or(y2<yn)or(y2>yk) then
begin
ShowMessage('Неверно введена координата Y второй точки');
Edit4.Clear;
Edit4.SetFocus;
exit;
end;
val(Edit5.Text,x3,k);
if(k<>0)or(x3<xn)or(x3>xk)then
begin
ShowMessage('Неверно введена координата Х 3 точки');
Edit5.Clear;
Edit5.SetFocus;
exit;
end;
val(Edit6.Text,y3,k);
if(k<>0)or(y3<yn)or(y3>yk) then
begin
ShowMessage('Неверно введена координата Y 3 точки');
Edit6.Clear;
Edit6.SetFocus;
exit;
end;
if ((x1-x3)*(y2-y3)-(x2-x3)*(y1-y3))=0 then
begin
ShowMessage('Точки лежат на на одной прямой '+#13#10+
'поправьте координаты');
exit;
end;
{искомая точка есть центр окружности, проходящей через эти 3 точки
найдем ее координаты, являющиеся пересечением срединных перпендикуляров}
//середины двух сторон
x4:=(x1+x2)/2;
y4:=(y1+y2)/2;
x5:=(x1+x3)/2;
y5:=(y1+y3)/2;
//коэффициенты уравнения 1 перпендикуляра
a1:=x2-x1;
b1:=y2-y1;
c1:=x4*(x2-x1)+y4*(y2-y1);
//2 перпендикуляра
a2:=x3-x1;
b2:=y3-y1;
c2:=x5*(x3-x1)+y5*(y3-y1);
//координаты искомой точки
xo:=round((c1*b2-c2*b1)/(a1*b2-a2*b1));
yo:=round((a1*c2-a2*c1)/(a1*b2-a2*b1));
Image1.Width:=Image1.Height;
x0:=round(Image1.Width*6/10); //начало координат
y0:=round(Image1.Height*3/9);
Edit7.Text:=FloattoStr(xo);
Edit8.Text:=FloattoStr(yo);
m:=(x0-30)/6; //масштаб
//строим чертеж
with Image1.Canvas do
begin
k:=0;
while k<w do
begin
pen.Width:=1;
Pen.Style:=psDot;
Pen.Color:=clBlack;
if CheckBox1.Checked=true then //вкл. сетку
begin
MoveTo(k-13,0); LineTo(k-13,h);
MoveTo(0,k-12); LineTo(w,k-12);
end;
k:=k+d;
end;
//рисование 3х точек
pen.Color:=clBlue;
brush.Color:=clBlue;
ellipse(x0+round(x1*m)-3,y0-round(y1*m)-3,x0+round(x1*m)+3,y0-round(y1*m)+3);
ellipse(x0+round(x2*m)-3,y0-round(y2*m)-3,x0+round(x2*m)+3,y0-round(y2*m)+3);
ellipse(x0+round(x3*m)-3,y0-round(y3*m)-3,x0+round(x3*m)+3,y0-round(y3*m)+3);
brush.Color:=clWhite;
Textout(x0+round(x1*m)-10,y0-round(y1*m)-10,'A');
Textout(x0+round(x2*m)-10,y0-round(y2*m)-10,'B');
Textout(x0+round(x3*m)-10,y0-round(y3*m)+3,'C');
//рисование искомой точки и отрезков
pen.Color:=ColorBox2.Selected;
brush.Color:=clRed;
ellipse(x0+round(xo*m)-4,y0-round(yo*m)-4,x0+round(xo*m)+4,y0-round(yo*m)+4);
moveto(x0+round(x1*m),y0-round(y1*m));
lineto(x0+round(xo*m),y0-round(yo*m));
moveto(x0+round(x2*m),y0-round(y2*m));
lineto(x0+round(xo*m),y0-round(yo*m));
moveto(x0+round(x3*m),y0-round(y3*m));
lineto(x0+round(xo*m),y0-round(yo*m));
brush.Color:=clWhite;
Textout(x0+round(xo*m)-8,y0-round(yo*m)+3,'S');
end;
end;
procedure TForm1.ColorBox1Change(Sender: TObject);
begin
Image1.Repaint;
end;
procedure TForm1.ColorBox2Change(Sender: TObject);
begin
Image1.Repaint;
end;
procedure TForm1.Edit1Change(Sender: TObject);//блокировка кнопки если не введены все данные
begin
if (Edit1.Text='') or (Edit2.Text='') or (Edit4.Text='') or (Edit5.Text='') or (Edit6.Text='') then Button1.Enabled:=False
else Button1.Enabled:=True;
end;
procedure TForm1.N9Click(Sender: TObject);
begin
Form3.ShowModal;
end;
procedure TForm1.N8Click(Sender: TObject);
begin
Form4.ShowModal;
end;
procedure TForm1.N7Click(Sender: TObject);
begin
Form5.ShowModal;
end;
procedure TForm1.N4Click(Sender: TObject);
begin
close;
end;
procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);//запрет в Edit ввода букв
begin
case Key of
'0'..'9',#8,'-':; //кроме этого
else Key:=chr(0);
end;
end;
procedure TForm1.CheckBox1Click(Sender: TObject);
begin
Image1.Repaint;
end;
end.
|