Приложение для построения кривых второго порядка

@блахблахблах · Регистрация: 23.05.2017

Студворк — интернет-сервис помощи студентам

здравствуйте, у меня такая проблема: нашла готовый код для Delphi 7 по построению кривых второго порядка, там он работает как нужно, перенесла в Lazarus и там пошла несостыковочка. скажите, как исправить?
вот код и как работает на D и на L:

Delphi
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
127
unit Unit3;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls;
 
type
  TForm1 = class(TForm)
    Image1: TImage;
    RadioGroup1: TRadioGroup;
    Button1: TButton;
    Label1: TLabel;
    Edit1: TEdit;
    Label2: TLabel;
    Edit2: TEdit;
    Label4: TLabel;
    Edit4: TEdit;
    Edit7: TEdit;
    Label7: TLabel;
    Edit8: TEdit;
    Label8: TLabel;
    Label5: TLabel;
    Label3: TLabel;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
procedure Circle(Canvas:TCanvas; r: integer);{x = x0 + R cosa, y = y0 + R sina,}
var
  l: integer;
begin
  {r - радиус окружности }
  for l:= 0 to 360 do { угол измерятся в градусах }
    begin
      Canvas.Pixels[round(150 + cos(l*pi/360)*r), round(150 + sin(l*pi/360)*r)]:=clBlack;
      Canvas.Pixels[round(150 - cos(l*pi/360)*r ), round(150 - sin(l*pi/360)*r)]:=clBlack;
    end;
end;
 
procedure Giperbol(Canvas:TCanvas; A: integer);{y=a/x}
var
  n, xi: real;
  x, y: integer;
  function Giperbola(X: integer): integer;
  begin
    result:= round(A / X);
  end;
begin
  Canvas.MoveTo(0, 150);
  For X := -150 to 150  do
    if x <> 0 then
      Canvas.LineTo(X + 150, Giperbola(X) + 150);
end;
 
procedure Parabol(Canvas: TCanvas; A: integer); {sqr(x)=ay}
var
  x: integer;
  function Parabola(X: integer): integer;
  begin
    result:= Round(Sqr(X) / A);
  end;
begin
  Canvas.MoveTo(0, 0);
  For X := -150 to 150 do
    Canvas.LineTo(X + 150, Parabola(X) + 150);
end;
 
procedure Elips(Canvas: TCanvas; A, B: integer); {sqr(x)/sqr(a) + sqr(y)/sqr(b) = 1}
var
  I, H2, K1, K2, R: single;
  X1, X2, X3, X4, YY, X, Y: integer;
begin
  X:= 150;
  Y:= 150;
  I:=(180) * PI / 180;
  H2:= Sqr(A * Sin(I))+Sqr(B * Cos(I));
  K1:= Sin(I) * Cos(I) * (Sqr(A) - Sqr(B)) / H2; 
  K2:= A * B / H2;
  YY:= 0;
  while Sqr(YY) <= H2 do
    begin
      R:= K2 * Sqrt(H2 - Sqr(YY));
      X1:=Round(K1 * YY + R);
      X2:=Round(K1 * YY - R);
      Canvas.MoveTo(X + X1, Y + YY);
      Canvas.LineTo(X + X3, Y + YY - 1);
      Canvas.MoveTo(X + X2, Y + YY);
      Canvas.LineTo(X + X4, Y + YY - 1);
      Canvas.MoveTo(X - X1, Y - YY);
      Canvas.LineTo(X - X3, Y - YY + 1); 
      Canvas.MoveTo(X - X2, Y - YY);
      Canvas.LineTo(X - X4, Y - YY + 1);
      X3:=X1;
      X4:=X2;
      Inc(YY);
    end;
end;
 
procedure TForm1.Button1Click(Sender: TObject);
begin
  image1.Canvas.FillRect(image1.Canvas.ClipRect);
  //  Строим координатную сетку
  image1.Canvas.MoveTo(image1.Width div 2, 0);
  image1.Canvas.LineTo(image1.Width div 2, image1.Height);
  image1.Canvas.MoveTo(0, image1.Height div 2);
  image1.Canvas.LineTo(image1.Width, image1.Height div 2);
  case RadioGroup1.ItemIndex of  //  Выбираем фигуру
    0: Circle(image1.Canvas, StrToInt(Edit1.Text));
    1: Giperbol(image1.Canvas, StrToInt(Edit2.Text));
    2: Parabol(image1.Canvas, StrToInt(Edit4.Text));
    3: Elips(image1.Canvas, StrToInt(Edit8.Text), StrToInt(Edit7.Text));
  end;
end;
 
end.

@Puporev · 13.06.2017, 14:34

А в примере b=0 c=0

@Педагогиня · 14.06.2017, 07:52

простите. ка кдлину окружности в коде написать? вот так? у меня так не работает

Delphi
1
2
3
4
5
6
procedure TForm1.Button2Click(Sender: TObject);
begin
L:=2*pi*r;
Edit3.Text:='Длина окружности='+formatfloat('0.00',L);
end;
end.

Добавлено через 9 минут
объясните, пожалуйста, как это в коде будет реализовано. длину окружности. и так, и сяк пробую, не понимаю куда вставить

[

@Puporev · 14.06.2017, 08:03

Можно по разному, например вставить в процедуру.

Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
procedure Circle(Canvas: TCanvas; R: integer; Edit:TEdit);
var  U,L: single;
     X, Y, XX, YY: integer;
begin
  X:= 150;//центр эллипса
  Y:= 150;
  U:=0;//угол поворота
  while U<=2*pi do//делаем оборот
   begin
    XX:=X+round(R*cos(U));//вычисляем координаты точки
    YY:=Y-round(R*sin(U));//по параметрическому уравнению эллипса
    if U=0 then Canvas.MoveTo(XX,YY)//первая точка
    else Canvas.LineTo(XX,YY);//остальные
    U:=U+0.01;//наращиваем угол
   end;
  L:=2*pi*r;
  Edit.Text:='Длина окружности='+formatfloat('0.00',L);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
Circle(Image1.Canvas,StrToInt(Edit1.Text),Edit3);
end;

Добавлено через 4 минуты
Вы зачем-то содрали чужую неудачную программу и все равно ничего в ней не понимаете. Уж лучше бы просто написали точное и подробное условие задачи и Вам помогли бы написать нормальную программу, а не тот бред.

@Педагогиня · 14.06.2017, 09:00

спасибо большое. еще один вопрос. я высчитываю периметр и площадь эллипса. но как их объединить в коде. отдельно каждый из них получается высчитать, но вместе нет.

Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
procedure Elips(Canvas: TCanvas; A, B: integer; Edit: TEdit); {sqr(x)/sqr(a) + sqr(y)/sqr(b) = 1}
var
  U,S,P: single;
  X, Y, XX, YY: integer;
begin
  X:= 150;//центр эллипса
  Y:= 150;
  U:=0;//угол поворота
  while U<=2*pi do//делаем оборот
   begin
    XX:=X+round(A*cos(U));//вычисляем координаты точки
    YY:=Y-round(B*sin(U));//по параметрическому уравнению эллипса
    if U=0 then Canvas.MoveTo(XX,YY)//первая точка
    else Canvas.LineTo(XX,YY);//остальные
    U:=U+0.01;//наращиваем угол
   end;
   P:=(4*pi*A*B*+(A-B)*(A-B))/A+B;
   Edit.Text:='Perimetr Ellipsa='+formatfloat('0.00',P);
  and
S:=A*B*pi;
Edit.Text:='Ploshad Ellipsa='+formatfloat('0.00',S);
   end;

@Puporev · 14.06.2017, 09:31

Когда копируете код с кириллицей, переключайте клавиатуру в русскую раскладку, надоело исправлять Ваши загогулины.

Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
procedure Elips(Canvas: TCanvas; A, B: integer; e1,e2: TEdit);
var
  U,S,P: single;
  X, Y, XX, YY: integer;
begin
  X:= 150;
  Y:= 150;
  U:=0;
  while U<=2*pi do
   begin
    XX:=X+round(A*cos(U));
    YY:=Y-round(B*sin(U));
    if U=0 then Canvas.MoveTo(XX,YY)
    else Canvas.LineTo(XX,YY);
    U:=U+0.01;
   end;
   P:=(4*pi*A*B*+(A-B)*(A-B))/A+B;
   e1.Text:='Perimetr Ellipsa='+formatfloat('0.00',P);
   S:=A*B*pi;
   e2.Text:='Ploshad Ellipsa='+formatfloat('0.00',S);
end;
 
//Вызов процедуры
Elips(Image1.Canvas,strtoint(эдит с А),strtoint(эдит с В), эдит для Р, едит для s);

Добавлено через 9 минут

Delphi
1
P:=2*pi*sqrt(a*a+b*b/2);//где a,b полуоси эллипса

или

Delphi
1
P:=2*pi*sqrt(a*a+b*b/8);//где a,b оси эллипса

Добавлено через 9 минут
А вообще точной формулы для подсчета периметра нет, там через интегрирование делается.
Кстати у Вас в формуле ошибка, нужно

Delphi
1
P:=4*(pi*A*B*+(A-B))/(A+B));

@Педагогиня · 14.06.2017, 09:43

огромное спасибо!)

@Puporev · 14.06.2017, 10:03

Кстати Ваша Формула почти правильная, нужно

Delphi
1
p:=4*(pi*a*b+sqr(a-b))/(a+b);

Это я в одном из ресурсов списал неверную формулу.

Новые блоги и статьи Все статьи Все блоги /
Запустил конкурс "тем и промптов для текстовых квестов созданных почти чисто ИИ" Adler 06.10.2026 Всем привет! За последние три-четыре дня я создал более 16 текстовых квестовых игр используя преимущественно по одному запросу к ИИ на игру. Мне так понравилось смотреть все ветки/ сцены во всех. . .	ИИ не может найти нужный язык в списке Supersumestria 05.10.2026 Я ему даю вот такое изображение и прошу найти и подчеркнуть немецкий язык. Возвращает он вот это: https:/ / i. **********/ vqBWLe2. png Нужную строчку в 3й колонке просто выдумал. . Это. . .	Новая последняя моя музыка в SUNO zorxor 05.10.2026 Здравствуйте, дорогие мои друзья! С большой радостью я хотел бы представить вам свою новую последнею музыку, которую сгенерировала мне по моей просьбе нейросеть SUNO. С уважением, zorxor. Это. . .	Программный домашний кинотеатр russiannick 27.09.2026 Сподобился на программный домашний кинотеатр. В качестве ЯВУ по традиции выбрал js. В помощники взял Яндекс-Алису. Было создано три зала на разные интересы. исторические и ретро сериал Хичкок. . .
Беседа с ИИ о программистах, недопускающих к созданию и правке кода генеративные ИИ и причины этого zorxor 21.09.2026 Раньше я радовался или получал некоторые эмоции, пусть небольшие, но всё же, от самого процесса написания кода, рекомпиляции и запуска, видя постепенное развитие программы и прочее. А теперь лень. . .	Мобильное приложение ColorStep pavlinmavlin 17.09.2026 Реализовал приложение Красный, Зеленый, Синий в Unity3d + c#. Название изменил на ColorStep. Приложение прошло модерацию и теперь доступно для скачивания. Делал его сам, шаг за шагом — и вот,. . .	Запрет дублирования строк в табличной части Maks 13.09.2026 Реализация из решения ниже выполнена на нетиповом справочнике "Нормы ТО" с табличной часть "Виды ТО", разработанного в КА2, со следующими реквизитами: - ВидТО (СправочникСсылка. ВидыТО); - ВидГСМ. . .	Скрипты Tampermonkey для CyberForum, ChatGPT, Claude и пр. Jin X 06.09.2026 Скрипты Tampermonkey для CyberForum, ChatGPT, Claude и пр. Работая с форумом и нейросетями в браузере часто хочется что-то подкорректировать или добавить какого-то функционала. Ниже прикреплён. . .

@Puporev Почетный модератор 64320 / 47616 / 32743 Регистрация: 18.05.2008 Сообщений: 115,167
	13.06.2017, 14:34
	А в примере b=0 c=0 0

@Педагогиня 0 / 0 / 0 Регистрация: 09.10.2016 Сообщений: 50
	14.06.2017, 09:43
	огромное спасибо!) 0