С Новым годом! Форум программистов, компьютерный форум, киберфорум
Delphi: Графика, звук, видео
Войти
Регистрация
Восстановить пароль
Карта форума Темы раздела Блоги Сообщество Поиск Заказать работу  
 
 
Рейтинг 4.80/15: Рейтинг темы: голосов - 15, средняя оценка - 4.80
0 / 0 / 0
Регистрация: 16.11.2021
Сообщений: 32
1

При запуске программы на форме появляется линия

20.01.2022, 08:21. Показов 2779. Ответов 33
Метки нет (Все метки)

Author24 — интернет-сервис помощи студентам
Помогите написать код, к одной из этих задач. Пожалуйста, буду благодарен.

1.При запуске программы на форме появляется линия. При
наведении курсора на линию изменяются толщина и цвет линии.
Нажатие в этом состоянии на левую клавишу мыши изменяет форму
курсора: 1) если курсор находился на конце линии, то форма курсора
отражает состояние «резиновая нить», в этом состоянии мы можем
изменить положение конца линии путем перемещения мыши в другую
точку; 2) если курсор находился в средней части линии, то форма
курсора отражает состояние «перенос линии», в этом состоянии
перемещение мыши приводит к параллельному перемещению линии по
экранной форме.
Отпускание мыши приводит задачу в исходное состояние, при
этом линия остается в положении, которое она приняла в результате
манипуляций.
Используются события класса TForm: OnMouseDown,
OnMouseMove, OnMouseUp. Для моделирования состояния задачи ввести
с помощью перечислимого типа данных значения состояний:
«исходное», «параллельный перенос линии», «сдвигать линию
относительно конца 1», «сдвигать линию относительно конца 2».
Требование: линия должна моделироваться отдельным классом.

2.
При запуске программы на экранной форме появляются
две фигуры: круг и квадрат. С помощью устройства «мышь» фигуры
должны перемещаться по форме. Используются события класса TForm:
OnMouseDown, OnMouseMove, OnMouseUp. Ограничение: фигуры не
должны пересекать границы клиентской области формы.
Предусмотреть класс фигура (TFigure) и его потомков: круг (TCircle),
квадрат (TSquare). Метод перемещения фигур должен быть
полиморфным.
Требование: предполагается, что в будущем могут появиться
новые фигуры, а существующие – исключены, поэтому программа
должна обладать свойством модифицируемости.
0
cpp_developer
Эксперт
20123 / 5690 / 1417
Регистрация: 09.04.2010
Сообщений: 22,546
Блог
20.01.2022, 08:21
Ответы с готовыми решениями:

не появляется анимация при запуске программы
Выдали практическую мне в одном из заданий нужно разместить 6 компонентов Animate и кнопку. ...

Появляется картинка при запуске программы
Всем привет! Как сделать, чтобы при запуске программы, появилось сначала изображение (в течении 3...

Не появляется DataGritView при запуске программы
Form4.Designer namespace Weekly_Report { partial class Form4 { /// <summary> ...

При запуске программы окружность не появляется
При запуске программы окружность не появляется. В чем проблема?

JFrame при запуске программы форма не появляется
Добрый день, начал осваивать Яву, и тут же наткнулся на первые грабли. Создал приложение по этому...

33
Модератор
3758 / 2262 / 783
Регистрация: 15.11.2015
Сообщений: 9,000
20.01.2022, 09:10 2
По второй задаче уже есть тема При запуске программы на экранной форме появляются две фигуры Следите там.
0
Модератор
9646 / 6254 / 2426
Регистрация: 21.01.2014
Сообщений: 26,675
Записей в блоге: 3
20.01.2022, 09:36 3
Цитата Сообщение от AllexxMSC777 Посмотреть сообщение
Пожалуйста, буду благодарен.
И как это будет заметно?
0
Модератор
3758 / 2262 / 783
Регистрация: 15.11.2015
Сообщений: 9,000
20.01.2022, 10:06 4
Цитата Сообщение от AllexxMSC777 Посмотреть сообщение
Помогите написать код, к одной из этих задач. Пожалуйста, буду благодарен.
Если делать основательно, то код к первой задаче будет довольно объёмным. Тут проще сделать на основе существующих компонентов, например, взять реализацию TShape и переделать его под линию. Это будет новый компонент. Уверен, преподаватель не поверит, что это ты сам сделал.
0
Житель Земли
3002 / 3011 / 390
Регистрация: 26.07.2011
Сообщений: 11,465
Записей в блоге: 1
20.01.2022, 10:56 5
Задачи, как минимум, на курсовой проект заточены
0
Модератор
3758 / 2262 / 783
Регистрация: 15.11.2015
Сообщений: 9,000
20.01.2022, 11:16 6
Я с линией вариант попроще начал делать. Решение на курсовую не потянет точно.
0
Житель Земли
3002 / 3011 / 390
Регистрация: 26.07.2011
Сообщений: 11,465
Записей в блоге: 1
20.01.2022, 11:26 7
Я чёт не могу придумать способ отслеживания состояния "курсор над линией"...
0
Модератор
3758 / 2262 / 783
Регистрация: 15.11.2015
Сообщений: 9,000
20.01.2022, 11:39 8
DenNik, найти расстояние от точки до линии и всё.
1
Модератор
3758 / 2262 / 783
Регистрация: 15.11.2015
Сообщений: 9,000
20.01.2022, 12:38 9
Вот как-то так по простому наваял первую задачу. На форме ничего. Нужно только приделать соответствующие обработчики событий:
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
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls;
 
type
  TLineState = (lsDefault, lsMove1, lsMove2, lsMove);
 
  // Базовый класс, если потом понадобится добавить ещё фигуры
  TFigure = class
  private
    fRect: TRect;
    procedure DrawTo(ACanvas: TCanvas); virtual; abstract;
    procedure SetCoordinates(AValue: TRect);
  public
    function CheckOver(X, Y: integer): TLineState; virtual; abstract;
    property Coordinates: TRect read fRect write SetCoordinates;
  end;
 
  TLine = class(TFigure)
  public
    procedure DrawTo(ACanvas: TCanvas); override;
    function CheckOver(X, Y: integer): TLineState; override;
  end;
 
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { Private declarations }
    l1: TLine;
    os: TLineState;
    move1: TLineState;
    oc1: TRect;
    ox1, oy1: integer;
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
function PtInRect2(ARect: TRect; X, Y: integer): boolean;
var
  x1, y1, x2, y2: integer;
begin
  with ARect do begin
    if Left < Right then begin
      x1 := Left;
      x2 := Right;
    end else begin
      x1 := Right;
      x2 := Left;
    end;
    if Top < Bottom then begin
      y1 := Top;
      y2 := Bottom;
    end else begin
      y1 := Bottom;
      y2 := Top;
    end;
    Result := (X >= x1) and (X <= x2) and (Y >= y1) and (Y <= y2);
  end;
end;
 
{ TFigure }
 
procedure TFigure.SetCoordinates(AValue: TRect);
begin
  fRect := AValue;
end;
 
{ TLine }
 
function TLine.CheckOver(X, Y: integer): TLineState;
// Result:
// lsDefault - не попадает.
// lsMove1 - попадает в Left, Top.
// lsMove2 - попадает в Right, Bottom.
// lsMove  - попадает на середину.
var
  x1, y1, x2, y2: integer;
  d: double;
begin
  Result := lsDefault;
  if ((X-FRect.Left)*(X-FRect.Left) + (Y-FRect.Top)*(Y-FRect.Top)) <= 3*3 then begin
    Result := lsMove1;
    Exit;
  end;
  if ((X-FRect.Right)*(X-FRect.Right) + (Y-FRect.Bottom)*(Y-FRect.Bottom)) <= 3*3 then begin
    Result := lsMove2;
    Exit;
  end;
  // distance(P1, P2, (x0, y0)) = Abs((y2-y1)*x0 - (x2-x1)*y0 + x2*y1 - y2*x1) / SQRT(SQR(y2-y1) + SQR(x2-x1));
  x1 := FRect.Left;
  y1 := FRect.Top;
  x2 := FRect.Right;
  y2 := FRect.Bottom;
 
  if (x1 = x2) then begin
    if ABS(X - x1) <= 9 then Result := lsMove;
  end else
  if (y1 = y2) then begin
    if ABS(Y - y1) <= 9 then Result := lsMove;
  end else begin
    d := ABS((y2-y1)*X - (x2-x1)*Y + x2*y1 - y2*x1) / SQRT(SQR(y2-y1) + SQR(x2-x1));
    if (d <= 9) and PtInRect2(FRect, X, Y) then
      Result := lsMove;
  end;
end;
 
procedure TLine.DrawTo(ACanvas: TCanvas);
begin
  ACanvas.MoveTo(FRect.Left, FRect.Top);
  ACanvas.LineTo(FRect.Right, FRect.Bottom);
end;
 
{ TLine ---------------------------------------}
 
 
procedure TForm1.FormCreate(Sender: TObject);
begin
  l1 := TLine.Create;
  l1.SetCoordinates(Rect(100, 100, 200, 200));
end;
 
procedure TForm1.FormPaint(Sender: TObject);
begin
  l1.DrawTo(Canvas);
end;
 
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if (Button = mbLeft) then begin
    move1 := os;
    oc1 := l1.Coordinates;
    ox1 := X;
    oy1 := Y;
  end;
end;
 
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
  o: TLineState;
begin
  if move1 = lsMove1 then l1.Coordinates := Rect(X, Y, l1.Coordinates.Right, l1.Coordinates.Bottom);
  if move1 = lsMove2 then l1.Coordinates := Rect(l1.Coordinates.Left, l1.Coordinates.Top, X, Y);
  if move1 = lsMove then l1.Coordinates := Rect(oc1.Left+X-ox1, oc1.Top+Y-oy1, oc1.Right+X-ox1, oc1.Bottom+Y-oy1);
 
  o := l1.CheckOver(X, Y);
 
  if o <> lsDefault then Canvas.Pen.Width := 3 else Canvas.Pen.Width := 1;
 
  if (o = lsMove1) or (o = lsMove2) then
    Screen.Cursor := crSizeNS
  else
  if (o = lsMove) then
    Screen.Cursor := crSize
  else
    Screen.Cursor := crDefault;
 
  if (o <> os) or (ssLeft in Shift) then
    Invalidate; // Перерисовать форму
 
  os := o;
  Label1.Caption := Format('%d, %d', [integer(o), Random(1000)]);
end;
 
procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if (Button = mbLeft) then move1 := lsDefault;
end;
 
end.
Вложения
Тип файла: rar delphi-multimedia thread2936342 Линия.rar (3.2 Кб, 5 просмотров)
0
Житель Земли
3002 / 3011 / 390
Регистрация: 26.07.2011
Сообщений: 11,465
Записей в блоге: 1
20.01.2022, 15:04 10
Забил на работу и наваял Итак

вот эти требования
форма курсора отражает состояние «резиновая нить»
форма курсора отражает состояние «перенос линии»
на мой взгляд, несколько излишни, во всяком случае, для точного их выполнения нужно загружать пользователькие курсоры, что выходит за рамки задачи. Вместо этого были применены стандартные курсоры (crSizeAll при перетягивании линии, crDrag при перетягивании конца), а также изменяется начертание самой линии на "резиновое" при перетягивании конца.

Способ определения нахождения курсора "над" линией применил отличный от
Цитата Сообщение от AzAtom Посмотреть сообщение
найти расстояние от точки до линии
- см. комментарии в коде

класс "линия"
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
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
unit ULine;
 
interface
 
uses
  System.Classes, System.Math, Vcl.Graphics,
 
  System.Types;
 
type
  TLine = class
  private
    FX1,FY1,FX2,FY2: integer;
    FColor: TColor;
    FStyle: TPenStyle;
    FWidth: byte;
    FLength: Extended;
    FOnChange: TNotifyEvent;
    procedure DoChange;
    function Catet(I1,I2: integer): integer;
    procedure CalcLength;
    function GetRect(const X,Y: integer): TRect;
    procedure SetColor(const Value: TColor);
    procedure SetStyle(const Value: TPenStyle);
    procedure SetWidth(const Value: byte);
  public
    constructor Create(const X1,Y1,X2,Y2: integer); reintroduce;
    procedure Draw(Canvas: TCanvas);
    function CaptureStart(const X,Y: integer): boolean;
    function CaptureEnd(const X,Y: integer): boolean;
    procedure MoveStart(const X,Y: integer);
    procedure MoveEnd(const X,Y: integer);
    procedure Offset(const dX,dY: integer);
    function PointIn(const X,Y: integer): boolean;
    property Color: TColor read FColor write SetColor;
    property Style: TPenStyle read FStyle write SetStyle;
    property Width: byte read FWidth write SetWidth;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
    end;
 
var
  Line: TLine;
 
implementation
 
{ TLine }
 
procedure TLine.CalcLength;
begin
  // вычисление длины нашей прямой (по теореме Пифагора)
  FLength:= Sqrt(Sqr(Catet(FX1,FX2)) + Sqr(Catet(FY1,FY2)));
end;
 
function TLine.CaptureEnd(const X, Y: integer): boolean;
begin
  // определение, совпадает ли точка с конечной точкой линии
  Result:= PtInRect(GetRect(FX2,FY2),Point(X,Y));
end;
 
function TLine.CaptureStart(const X, Y: integer): boolean;
begin
  // определение, совпадает ли точка с начальной точкой линии
  Result:= PtInRect(GetRect(FX1,FY1),Point(X,Y));
end;
 
function TLine.Catet(I1, I2: integer): integer;
begin
  // вычисление длины катета
  Result:= Abs(I1 - I2);
end;
 
constructor TLine.Create(const X1,Y1,X2,Y2: integer);
begin
  FX1:= X1;  FY1:= Y1;
  FX2:= X2;  FY2:= Y2;
  CalcLength;
  // начальные параметры линии
  FStyle:= psSolid;
  FWidth:= 2;
  FColor:= clNavy;
end;
 
procedure TLine.DoChange;
begin
  if Assigned(FOnChange) then FOnChange(Self);
end;
 
procedure TLine.Draw(Canvas: TCanvas);
var
  OldBrush: TColor;
begin
  // рисование линии
  Canvas.Pen.Style:= FStyle;
  Canvas.Pen.Width:= IfThen(FStyle = psSolid,FWidth,1);
  Canvas.Pen.Color:= FColor;
  Canvas.MoveTo(FX1,FY1);
  Canvas.LineTo(FX2,FY2);
  // рисование конечных точек (для красоты)
  OldBrush:= Canvas.Brush.Color;
  Canvas.Brush.Color:= clLime;
  Canvas.Pen.Width:= 1;
  Canvas.Pen.Style:= psSolid;
  Canvas.Pen.Color:= clGray;
  Canvas.Rectangle(GetRect(FX1,FY1));
  Canvas.Rectangle(GetRect(FX2,FY2));
  Canvas.Brush.Color:= OldBrush;
end;
 
function TLine.GetRect(const X, Y: integer): TRect;
begin
  // вычисление "обрамляющего" точку прямоугольника
  Result:= Bounds(X-3,Y-3,6,6);
end;
 
procedure TLine.Offset(const dX, dY: integer);
begin
  // смещение всей линии
  Inc(FX1,dX);  Inc(FX2,dX);
  Inc(FY1,dY);  Inc(FY2,dY);
  DoChange;
end;
 
function TLine.PointIn(const X, Y: integer): boolean;
var
  B,C: Extended;
begin
  // вычисление, находится ли точка "над" линией, по алгоритму
  // "если сумма расстояний от точки до концов отрезка не превышает
  // длины отрезка - точка принадлежит прямой"
 
  // вычисление растояния от точки до начальной точки линии
  B:= Sqrt(Sqr(Catet(FX1,X)) + Sqr(Catet(FY1,Y)));
  // вычисление растояния от точки до конечной точки линии
  C:= Sqrt(Sqr(Catet(FX2,X)) + Sqr(Catet(FY2,Y)));
 
  // вычисление принадлежности точки отрезку
  Result:= Abs(FLength - B - C) <= 0.1;
end;
 
procedure TLine.MoveEnd(const X, Y: integer);
begin
  // новые координаты конечной точки
  FX2:= X;
  FY2:= Y;
  CalcLength;
  DoChange;
end;
 
procedure TLine.MoveStart(const X,Y: integer);
begin
  // новые координаты начальной точки
  FX1:= X;
  FY1:= Y;
  CalcLength;
  DoChange;
end;
 
procedure TLine.SetColor(const Value: TColor);
begin
  if FColor <> Value then
  begin
    FColor:= Value;
    DoChange;
  end;
end;
 
procedure TLine.SetStyle(const Value: TPenStyle);
begin
  if FStyle <> Value then
  begin
    FStyle:= Value;
    DoChange;
  end;
end;
 
procedure TLine.SetWidth(const Value: byte);
begin
  if FWidth <> Value then
  begin
    FWidth:= Value;
    DoChange;
  end;
end;
 
initialization
 
Line:= TLine.Create(50,50,200,100);
finalization
  Line.Free;
end.


основное приложение
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
unit UMain;
 
interface
 
uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;
 
type
  TfrmMain = class(TForm)
    procedure FormPaint(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X,
      Y: Integer);
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  end;
 
  TJobStatus = (jsDefault,jsMoveLine,jsMoveStart,jsMoveEnd);
 
var
  frmMain: TfrmMain;
  JobStatus: TJobStatus = jsDefault;      // текущий статус задачи
  aX,aY: integer;  // позиция курсора, сохранённая при зажатии мыши на линии
 
implementation
 
{$R *.dfm}
 
uses ULine, System.Math;
 
procedure TfrmMain.FormCreate(Sender: TObject);
begin
  // подписка на события линии
  Line.OnChange:= FormPaint;
end;
 
procedure TfrmMain.FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X,
  Y: Integer);
begin
  if JobStatus <> jsDefault then Exit;
  // захват начальной точки
  if Line.CaptureStart(X,Y) then
  begin
    JobStatus:= jsMoveStart;
    Line.Style:= psDot;
  end else
  // захват конечной точки
  if Line.CaptureEnd(X,Y) then
  begin
    JobStatus:= jsMoveEnd;
    Line.Style:= psDot;
  end else
  // захват всей линии
  if Line.PointIn(X,Y) then
  begin
    JobStatus:= jsMoveLine;
    aX:= X;
    aY:= Y;
  end;
end;
 
procedure TfrmMain.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
var
  flag: boolean;
begin
  case JobStatus of
  // выделение линии
  jsDefault:   begin
                 flag:= (Line.PointIn(X,Y) or Line.CaptureStart(X,Y) or Line.CaptureEnd(X,Y));
                 Line.Width:= IfThen(flag,4,2);
                 Line.Color:= IfThen(flag,clRed,clNavy);
                 if not flag then Cursor:= crDefault else
                 if Line.PointIn(X,Y) then Cursor:= crSizeAll
                 else Cursor:= crDrag;
               end;
  // движение всей линии
  jsMoveLine:  begin
                 Line.Offset(X-aX,Y-aY);
                 aX:= X;
                 aY:= Y;
               end;
  // перемещение начальной точки
  jsMoveStart: Line.MoveStart(X,Y);
  // перемещение конечной точки
  jsMoveEnd:   Line.MoveEnd(X,Y);
  end;
end;
 
procedure TfrmMain.FormMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X,
  Y: Integer);
begin
  JobStatus:= jsDefault;
  Line.Style:= psSolid;
end;
 
procedure TfrmMain.FormPaint(Sender: TObject);
begin
  // вызов при перерисовке формы, либо изменении состояния линии (подписка на событие)
  Canvas.FillRect(ClientRect);
  Line.Draw(Canvas);
end;
 
end.


в архиве готовый ехе
Миниатюры
При запуске программы на форме появляется линия   При запуске программы на форме появляется линия   При запуске программы на форме появляется линия  

Вложения
Тип файла: zip MoveLine.zip (854.1 Кб, 7 просмотров)
1
Модератор
3758 / 2262 / 783
Регистрация: 15.11.2015
Сообщений: 9,000
20.01.2022, 15:20 11
Цитата Сообщение от DenNik Посмотреть сообщение
- см. комментарии в коде
Это какой-то эллипс получается.
0
Житель Земли
3002 / 3011 / 390
Регистрация: 26.07.2011
Сообщений: 11,465
Записей в блоге: 1
20.01.2022, 15:27 12
Цитата Сообщение от AzAtom Посмотреть сообщение
Это какой-то эллипс получается
В каком месте?
0
Житель Земли
3002 / 3011 / 390
Регистрация: 26.07.2011
Сообщений: 11,465
Записей в блоге: 1
20.01.2022, 15:42 13
все вычисления по теореме Пифагора. Сперва прикинул на бумаге
Миниатюры
При запуске программы на форме появляется линия  
0
Модератор
3758 / 2262 / 783
Регистрация: 15.11.2015
Сообщений: 9,000
20.01.2022, 16:16 14
Так если точку двигать вдоль линии, то и будет эллипс. Это же метод построения эллипса, когда сумма расстояний от точки эллипса до каждого фокуса - постоянное число.
0
Житель Земли
3002 / 3011 / 390
Регистрация: 26.07.2011
Сообщений: 11,465
Записей в блоге: 1
20.01.2022, 16:24 15
Цитата Сообщение от AzAtom Посмотреть сообщение
Так если точку двигать вдоль линии, то и будет эллипс
а зачем мне двигать точку вдоль линии? Мне нужно определить, принадлежит ли точка CURSOR (см. рисунок) отрезку с координатами (X1,Y1) (X2,Y2). Если выполняется условие Length = B + C (с учётом погрешности сравнения типа Extended) - то принадлежит. А CURSOR - это координаты курсора из события MouseMove

Расстояния Length, B,C являются гипотенузами соответствующих треугольников. вот и всё
0
Модератор
3758 / 2262 / 783
Регистрация: 15.11.2015
Сообщений: 9,000
20.01.2022, 16:38 16
DenNik, поставь вместо 0.1 где-то 5-10 и наглядно увидишь, в середине линии расстояние, при котором меняется курсор, больше, чем у концов линии.
0
Житель Земли
3002 / 3011 / 390
Регистрация: 26.07.2011
Сообщений: 11,465
Записей в блоге: 1
20.01.2022, 16:50 17
Цитата Сообщение от AzAtom Посмотреть сообщение
поставь вместо 0.1 где-то 5-10
А зачем мне это делать? 0,1 - это допустимая погрешность сравнения типов Extended.

Добавлено через 2 минуты
Данный механизм сравнения, если уж выражаться высокопарно, является частью "движка" линии и не предусматривает изменения извне. Так зачем мне менять это значение, если результат работы (курсор меняется только если указатель мыши находится "над" линией) удовлетворяет условиям задачи?

Добавлено через 36 секунд
AzAtom, ты хоть запускал приложение из архива?
0
Модератор
3758 / 2262 / 783
Регистрация: 15.11.2015
Сообщений: 9,000
20.01.2022, 16:56 18
Цитата Сообщение от DenNik Посмотреть сообщение
А зачем мне это делать?
Чтобы увидеть, что это действительно эллипс.

Цитата Сообщение от DenNik Посмотреть сообщение
ты хоть запускал приложение из архива?
Конечно.

Ещё и использовал кусок твоего кода, чтобы построить приложенную картину.
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
function Catet(I1, I2: integer): integer;
begin
  // вычисление длины катета
  Result:= Abs(I1 - I2);
end;
 
function PointIn(const X, Y: integer): boolean;
var
  B, C, FLength: double;
  FX1, FY1, FX2, FY2: integer;
begin
  FX1 := 50;
  FY1 := 150;
  FX2 := 350;
  FY2 := 150;
 
  // вычисление длины нашей прямой (по теореме Пифагора)
  FLength := Sqrt(Sqr(Catet(FX1,FX2)) + Sqr(Catet(FY1,FY2)));
 
  // вычисление, находится ли точка "над" линией, по алгоритму
  // "если сумма расстояний от точки до концов отрезка не превышает
  // длины отрезка - точка принадлежит прямой"
 
  // вычисление растояния от точки до начальной точки линии
  B:= Sqrt(Sqr(Catet(FX1,X)) + Sqr(Catet(FY1,Y)));
  // вычисление растояния от точки до конечной точки линии
  C:= Sqrt(Sqr(Catet(FX2,X)) + Sqr(Catet(FY2,Y)));
 
  // вычисление принадлежности точки отрезку
  Result := Abs(FLength - B - C) <= 10;
end;
 
 
procedure TForm1.Timer1Timer(Sender: TObject);
const
  col1: array[boolean]of TColor = (clBlue, clRed);
var
  X, Y, i: integer;
begin
  for i := 0 to 100 do begin
    X := Random(ClientWidth);
    Y := Random(ClientHeight);
    Canvas.Pixels[X, Y] := col1[PointIn(X, Y)];
  end;
end;
Миниатюры
При запуске программы на форме появляется линия  
1
Житель Земли
3002 / 3011 / 390
Регистрация: 26.07.2011
Сообщений: 11,465
Записей в блоге: 1
20.01.2022, 17:04 19
AzAtom, объясни мне толком, каким боком здесь вообще эллипс?

У нас дано:
- отрезок (наша линия)
- точка (позиция курсора мыши)

Определить:
- лежит ли точка на отрезке (находится ли курсор "над" линией)

Способ определения:
- вычислить длину отрезка (A)
- вычислить расстояние от точки до начала отрезка (B)
- вычислить расстояние от точки до конца отрезка (C)

Если выполняется условие А = В + С - задача решена.
Это чистая геометрия за 6 класс.

Так каким боком здесь эллипс?

Добавлено через 1 минуту
Цитата Сообщение от AzAtom Посмотреть сообщение
Result := Abs(FLength - B - C) <= 10;
ЗАЧЕМ из линии делать эллипс, не врублюсь никак?!
0
Модератор
3758 / 2262 / 783
Регистрация: 15.11.2015
Сообщений: 9,000
20.01.2022, 17:11 20
Цитата Сообщение от DenNik Посмотреть сообщение
объясни мне толком, каким боком здесь вообще эллипс?
При том, что ты его использовал.
Вот, вернул ту самую погрешность 0.1 и сделал линию длиной в 700 пикселей. Красная область это то место, где будет определено, что курсор попал на линию:
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
function Catet(I1, I2: integer): integer;
begin
  // вычисление длины катета
  Result:= Abs(I1 - I2);
end;
 
function PointIn(const X, Y: integer): boolean;
var
  B, C, FLength: double;
  FX1, FY1, FX2, FY2: integer;
begin
  FX1 := 50;
  FY1 := 150;
  FX2 := 750;
  FY2 := 150;
 
  // вычисление длины нашей прямой (по теореме Пифагора)
  FLength := Sqrt(Sqr(Catet(FX1,FX2)) + Sqr(Catet(FY1,FY2)));
 
  // вычисление, находится ли точка "над" линией, по алгоритму
  // "если сумма расстояний от точки до концов отрезка не превышает
  // длины отрезка - точка принадлежит прямой"
 
  // вычисление растояния от точки до начальной точки линии
  B:= Sqrt(Sqr(Catet(FX1,X)) + Sqr(Catet(FY1,Y)));
  // вычисление растояния от точки до конечной точки линии
  C:= Sqrt(Sqr(Catet(FX2,X)) + Sqr(Catet(FY2,Y)));
 
  // вычисление принадлежности точки отрезку
  Result := Abs(FLength - B - C) <= 0.1; // ---------- 
end;
 
procedure TForm1.Button1Click(Sender: TObject);
const
  col1: array[boolean]of TColor = (clBlue, clRed);
var
  X, Y, i: integer;
begin
  for y := 0 to ClientHeight-1 do
    for x := 0 to ClientWidth-1 do
      Canvas.Pixels[X, Y] := col1[PointIn(X, Y)];
end;
Миниатюры
При запуске программы на форме появляется линия  
1
20.01.2022, 17:11
raxper
Эксперт
30234 / 6612 / 1498
Регистрация: 28.12.2010
Сообщений: 21,154
Блог
20.01.2022, 17:11
Помогаю со студенческими работами здесь

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

Почему при запуске программы в программе появляется консоль?
Код программы, которая запускает саму себя через некоторое время: {$apptype windows} uses...

Консоль появляется только на мгновение при запуске программы
Консоль появляется только на мгновение при запуске программы. Пробовал Eclipse, Netbeans . ОС...

При запуске программы появляется ошибка: list index out of bounds (0)
но к сожалению файл не читает и выдает такую ошибку, сама программа запускается Вот что выдает в...

При запуске игры появляется окно - Прекращение работы программы
Почему кода я запускаю игру на Windows 7 у меня вылезает окно Прекращение работы програмы Windows...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
20
Ответ Создать тему
Новые блоги и статьи
Как настроить CI/CD с Azure DevOps
InfoMaster 15.01.2025
CI/ CD, или непрерывная интеграция и непрерывное развертывание, представляет собой современный подход к разработке программного обеспечения, который позволяет автоматизировать и оптимизировать процесс. . .
Как настроить CI/CD с помощью Jenkins
InfoMaster 15.01.2025
Введение в CI/ CD и Jenkins В современной разработке программного обеспечения непрерывная интеграция (CI) и непрерывная доставка (CD) стали неотъемлемыми элементами процесса создания качественных. . .
Как написать микросервис на Go/Golang с Kafka и GitHub CI/CD
InfoMaster 14.01.2025
Определение микросервиса, преимущества использования Go/ Golang Микросервис – это архитектурный подход к разработке программного обеспечения, при котором приложение состоит из небольших, независимо. . .
Как написать микросервис с нуля на C# с RabbitMQ, CQRS и CI/CD
InfoMaster 14.01.2025
В современном мире разработки программного обеспечения микросервисная архитектура стала стандартом де-факто для создания масштабируемых и гибких приложений. Этот архитектурный подход предполагает. . .
Как создать интернет-магазин на PHP и JavaScript
InfoMaster 14.01.2025
В современном мире электронная коммерция стала неотъемлемой частью бизнеса. Создание собственного интернет-магазина открывает широкие возможности для предпринимателей, позволяя достичь большей. . .
Как написать Тетрис на Ассемблере
InfoMaster 14.01.2025
Тетрис – одна из самых узнаваемых и популярных компьютерных игр, созданная в 1984 году советским программистом Алексеем Пажитновым. За прошедшие десятилетия она завоевала симпатии миллионы людей по. . .
Как создать игру "Танчики" на Unity3d и C#
InfoMaster 14.01.2025
Разработка игр – это увлекательный процесс, сочетающий в себе творчество и технические навыки. В этой статье мы рассмотрим создание классической игры "Танчики" с использованием Unity3D и языка. . .
Организую платный онлайн микро-курс по доработке Android-клиента Telegram
_Ivana 14.01.2025
Официальная версия и распространенные форки не полностью устраивают? Сделай свою кастомную версию клиента! 4 занятия по 2 часа (2 недели пн, ср 19:00-21:00 по Москве). Первое вводное занятие. . .
Как создать приложение для фитнеса для iOS/iPhone на Kotlin
InfoMaster 14.01.2025
Создание собственного фитнес-приложения — это не только захватывающий, но и полезный процесс, ведь оно может стать вашим верным помощником на пути к здоровому и активному образу жизни. В современных. . .
Как создать приложение магазина для iOS/iPhone на Swift
InfoMaster 14.01.2025
Введение в разработку iOS-приложений Разработка приложений для iPhone и других устройств на базе iOS открывает огромные возможности для создания инновационных мобильных решений. В данной статье мы. . .
Это работает. Скорость асинхронной логики велика. Вопрос видимо останется в стабильности. Плата - огонь!
Hrethgir 13.01.2025
По прошлому проекту в Logisim Evolution https:/ / www. cyberforum. ru/ blogs/ 223907/ blog8781. html прилагаю файл архива проекта в Gowin Eda. Восьмибитный счётчик из сумматора+ генератор сигнала. . .
UserScript для подсветки кнопок языков программировани­­­­я в зависимости от текущего раздела
volvo 13.01.2025
В результате работы этого скрипта подсвечиваются нужные кнопки не только в форме быстрого ответа, но и при редактировании сообщения: / / ==UserScript== / / @name CF_DefaultLangSelect / / . . .
КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin
Copyright ©2000 - 2025, CyberForum.ru