ReSQL.ru
     
powered by simpleCommunicator - 2.0.61     © 2026 Programmizd 02
Мобильная версия    Контакт    Правила    FAQ    Помощь
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Доб. в избранное | Игнор. тему | Прикреп. тему | Пометить прочит. / непрочит. | Фильтр
Форумы / Delphi [игнор отключен] [закрыт для гостей] / Поэтапная отрисовка треугольника
4 сообщений из 4, страница 1 из 1
Поэтапная отрисовка треугольника
    #39693319
не_шарю_59
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
не_шарю_59
Гость
Как описать окружность около треугольника с помощью TTimer, чтобы координаты вершин треугольника вводились с клавиатуры и каждая линия , а затем окружность выводились поочередно

 
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
91.
92.
93.
94.
95.
96.
97.
98.
99.
100.
101.
102.
103.
104.
105.
106.
107.
108.
109.
110.
111.
112.
113.
114.
115.
116.
117.
118.
119.
120.
121.
122.
123.
124.
125.
126.
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, TeeProcs, TeEngine, Chart;

type
  TForm1 = class(TForm)
    lbl1: TLabel;
    lbl2: TLabel;
    lbl3: TLabel;
    lbl4: TLabel;
    lbl5: TLabel;
    lbl6: TLabel;
    lbl8: TLabel;
    lbl9: TLabel;
    lbl10: TLabel;
    lbl7: TLabel;
    lbl11: TLabel;
    lbl12: TLabel;
    lbl13: TLabel;
    lbl14: TLabel;
    btn1: TButton;
    btn3: TButton;
    lbl15: TLabel;
    edt1: TEdit;
    edt2: TEdit;
    edt3: TEdit;
    edt4: TEdit;
    edt5: TEdit;
    edt6: TEdit;
    btn2: TButton;
    btn4: TButton;
    img1: TImage;
    tmr1: TTimer;
    procedure btn1Click(Sender: TObject);
    procedure btn3Click(Sender: TObject);
    procedure edt1KeyPress(Sender: TObject; var Key: Char);
    procedure edt2KeyPress(Sender: TObject; var Key: Char);
    procedure edt3KeyPress(Sender: TObject; var Key: Char);
    procedure edt5KeyPress(Sender: TObject; var Key: Char);
    procedure edt4KeyPress(Sender: TObject; var Key: Char);
    procedure edt6KeyPress(Sender: TObject; var Key: Char);
    procedure btn2Click(Sender: TObject);

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

var
  Form1: TForm1;
  Xa, Ya, Xb, Yb, Xc, Yc, : Integer;
  R, X0, Y0: Real;
  P1x, P1y, Dx, Dy, A1, B1, C1, P2x, P2y, A2, B2, C2: double;

implementation

{$R *.dfm}

procedure TForm1.btn1Click(Sender: TObject);

begin
  Xa:=StrToInt(Edt1.Text);
  Ya:=StrToInt(Edt2.Text);
  Xb:=StrToInt(Edt3.Text);
  Yb:=StrToInt(Edt4.Text);
  Xc:=StrToInt(Edt5.Text);
  Yc:=StrToInt(Edt6.Text);
  R:=abs(Xa*(Yb-Yc)-Ya*(Xb-Xc)+(Xb*Yc-Xc*Yb));
  lbl13.Caption:='R= '+FloatToStrF(R,ffFixed,4,2);
  X0:=-(1/2)*(Ya*(Xb*Xb+Yb*Yb-Xc*Xc-Yc*Yc)+Yb*(Xc*Xc+Yc*Yc-Xa*Xa-Ya*Ya)+Yc*(Xa*Xa+Ya*Ya-Xb*Xb-Yb*Yb))/(Xa*(Yb-Yc)+Xb*(Yc-Ya)+Xc*(Ya-Yb));
  Y0:=(1/2)*(Xa*(Xb*Xb+Yb*Yb-Xc*Xc-Yc*Yc)+Xb*(Xc*Xc+Yc*Yc-Xa*Xa-Ya*Ya)+Xc*(Xa*Xa+Ya*Ya-Xb*Xb-Yb*Yb))/(Xa*(Yb-Yc)+Xb*(Yc-Ya)+Xc*(Ya-Yb));
  lbl14.Caption:='X0= '+FloatToStrF(X0,ffFixed,4,2) +'     Y0= '+FloatToStrF(Y0,ffFixed,4,2);

end;

procedure TForm1.btn2Click(Sender: TObject);
begin
  Xa:=StrToInt(Edt1.Text);
  Ya:=StrToInt(Edt2.Text);
  Xb:=StrToInt(Edt3.Text);
  Yb:=StrToInt(Edt4.Text);
  Xc:=StrToInt(Edt5.Text);
  Yc:=StrToInt(Edt6.Text);

  // Середина отрезка AB
   P1x := (Xa + Xb) / 2;
   P1y := (Ya + Yb) / 2;
   // Прямая, перпендикулярная AB через точку P1
   // x(Xa-Xb) +y(Ya-Yb) + C = 0
   A1 := Xa-Xb;
   B1 := Ya-Yb;
   C1 := -(P1x*A1 + P1y*B1);

   // То-же самое для BC
   P2x := (Xb + Xc) / 2;
   P2y := (Yb + Yc) / 2;
   A2 := Xb-Xc;
   B2 := Yb-Yc;
   C2 := -(P2x*A2 + P2y*B2);

   // Точка пересечения прямых
   if A1 <> 0 then
     begin
        Dy := ((A2 * C1)/A1 - C2) * A1 / (B2 * A1 - B1 * A2);
        Dx := (-C1 - B1 * Dy ) / A1;
     end
   else
     begin
        Dx := ((B2 * C1)/B1 - C2) * B1 / (A2 * B1 - A1 * B2);
        Dy := (-C1 - A1 * Dx ) / B1;
     end;

   R:= sqrt(sqr(Xa-Dx)+sqr(Ya-Dy));

   img1.canvas.Ellipse(trunc(Dx-R)+200, trunc(Dy-R)+200, trunc(Dx+R)+200, trunc(Dy+R)+200);

   img1.canvas.PolyLine([Point(Xa+200, Ya+200), Point(Xb+200, Yb+200), Point(Xc+200, Yc+200), Point(Xa+200, Ya+200)]);
end;


end.


расчет радиуса и координат центра получилось сделать, рисунок появляется сразу, а надо чтобы поэтапно

Модератор: Пользуйтесь тегом (кнопкой) SRC для оформления кода, пожалуйста.
...
Рейтинг: 0 / 0
25.08.2018, 21:50
| Ответить | Цитировать | Написать  
Поэтапная отрисовка треугольника
    #39693328
DimaBr
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
DimaBr
Участник
Чтобы "поэтапно", нужно рисовать окружность не методом img1.canvas.Ellipse(), а по точкам
...
Рейтинг: 0 / 0
26.08.2018, 00:12
| Ответить | Цитировать | Написать  
Поэтапная отрисовка треугольника
    #39693335
x1ca4064
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
x1ca4064
Участник
не_шарю_59Как описать окружность около треугольника с помощью TTimer,
Как мне лопатой осмыслить мысль?

Код: sql
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
procedure TForm1.Timerxxx(...)
begin
  case State of
  0:
    begin
      Line(point1,point2)
     State:=1
  end
  1:
  begin
     line(point2,point3)
    state:=2;
  end;
  2:
  begin
     line(point3,point1)
    state:=3;
  end;
  3:
    begin
     Ellipse(..)
   Timer1.Enabled:=false;
  State:=0;
  end;
end
end


Как-то не очень ровно получилось...
...
Рейтинг: 0 / 0
26.08.2018, 04:16
| Ответить | Цитировать | Написать  
Поэтапная отрисовка треугольника
    #39693390
DimaBr
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
DimaBr
Участник
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
uses Math;
procedure TForm1.Button1Click(Sender: TObject);
begin
  x := Image1.Width div 2;
  y := Image1.Height div 2;
  r := min(X,Y);
  dn := 2/r;
  n := 0;
  Timer1.Interval := 1;
  Timer1.Enabled := true;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  Image1.Canvas.Pixels[Round(x + r*cos(n)), Round(y + r*sin(n))] := clRed;
  n := n + dn;
  Timer1.Enabled := n < 2*pi;
end;



...
Рейтинг: 0 / 0
26.08.2018, 12:52
| Ответить | Цитировать | Написать  
4 сообщений из 4, страница 1 из 1
Форумы / Delphi [игнор отключен] [закрыт для гостей] / Поэтапная отрисовка треугольника
Найденые пользователи ...
Разблокировать пользователей ...
Читали тему (0):
Читали форум (0):
Пользователи онлайн (0):
Польз. соглашение   Полит. конфиден.  
NoSQL.ru       Кролег: Проекты, Новости, Чат       РЕД ФОРУМ       Фотоальбом: Участники, Встречи
Закрыть
start [/forum/topic.php?fid=58&msg=39693335&tid=2040487]:
 0ms
get settings:
 9ms
get forum list:
 18ms
check forum access:
 4ms
check topic access:
 4ms
track hit:
 190ms
get topic data:
 11ms
get forum data:
 3ms
get page messages:
 61ms
get tp. blocked users:
 2ms
others: 212ms
total:  514ms
созд. / загр.: 514ms
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]