Поворот фигур...

[DirectXManiac]

У меня такая проблема... Я искал на форуме и не нашёл!
На PictureBoxe рисую четыре точки так:
Pic.Circle (X,Y), 2
А в зависимости от этих точек строятся линии, которые образуют квадрат. Мне надо повернуть эту фигуру, т.е. переместить точки так, чтобы линии образовали повёрнутую на определйнный угол фигуру!
Как это сделать... Впринципе я думал можно через DirectX но это же PictureBox

[DirectXManiac]

ПОМОГИТЕ ПОЖАЛУЙСТА!!!!!!!!!!!!!!!!!

[Хакер]

Мдя. Была и у меня такая проблема. Нужно было делать программу "Редактор чертежей".

Для того чтобы это сделать нужно очень хорошо знать математику, на всякий случай даю МАТЕМ-МОДУЛЬ

Код: Выделить всё


Global Const TwoPi As Single = 6.2831853071795
Global Const PI As Single = 3.14159265358979

Public Function ArcSine(TheNumber As Double) As Single
Dim N2 As Double
On Error Resume Next
N2 = Sqr(-TheNumber * TheNumber + 1)
If Not N2 = 0 Then
ArcSine = Atn(TheNumber / N2)
End If
On Error GoTo 0
End Function

Public Function GetAngle(XCenter As Single, YCenter As Single, ToX As Single, ToY As Single) As Single
On Error Resume Next
'Определяем дистанцию между точками
'т.е гипот-зу если катетами будут проэкции
'расстояния между точками на оси Х и У
Distance = Sqr((Abs(XCenter - ToX)) * (Abs(XCenter - ToX)) + (Abs(YCenter - ToY)) * (Abs(YCenter - ToY)))
'Находим угол (в радианах)
Gradus = ArcSine((YCenter - ToY) / Distance)
'Исправляем неточности при высчитывании арксинуса
If XCenter = ToX Then
If ToY < YCenter Then
Gradus = PI / 2
End If
If ToY > YCenter Then
Gradus = TwoPi - PI / 2
End If
End If
If ToY > YCenter And ToX < XCenter Then
Gradus = TwoPi + Gradus
End If

If XCenter < ToX Then Gradus = PI - Gradus
GetAngle = Gradus
End Function

Public Function GetDistance(X1 As Single, Y1 As Single, X2 As Single, Y2 As Single) As Single
GetDistance = Sqr((Abs(X1 - X2)) * (Abs(X1 - X2)) + (Abs(Y1 - Y2)) * (Abs(Y1 - Y2)))
End Function


Описание функций:
GetDistance - расстояние между двумя точками (теорема Пифагора)
GetAngle - возвращает угол между горизонтом и прямой проведённой между двумя точками
ArcSine - код функции "арксинус" (и почему её нет в ВБ )

Итак что нам нужно сделать чтобы повернуть квадрат:

Первое, что должно было пожаловать в голову, это то, что выполнять это в прямоугольных декартовых координатах неудобно (а точнее сказать невозможно)

Поэтому надо перевести координаты каждой точки из декартовых в полярные.

Полярные координаты характеризуют точку по двум величинам: удалённость от начала координат (R) и угол наклона прямой между началом координат и точкой (тетта).

Так вот нам нужно повернуть фигуру (и не обязательно это должен быть прямоугольник) вокруг какой то точки. Т.е. нам нужно повернуть каждую точку этой фигуры вокруг точки вращения на определённый угол. Используя полярную систему координат нам нужно просто прибавить к тетте каждой точки нужный угол поворота.

Итак, самое сложное МАТЕМАТИКА!

(Модуль с МАТ-Функциями я уже выложил)

Объявим два типа для точки:

Код: Выделить всё


Public Type POINT_DECART
X as Single
Y as Single
End Type

Public Type POINT_POLAR
Theta as Single
R as Single
End Type


Ещё понадобится два массива, в которых будем хранить точки (хотя можно было обойтись одним)

Код: Выделить всё


Dim dPoints(1 To 4) as POINT_DECART
Dim pPoints(1 to 4) as POINT_POLAR


А теперь в принципе и сам код

Код: Выделить всё


'====Инициализируем нашу фигуру (пусть это будет ромб)======
dPoints(1).x = -1: dPoints(1).y = 0
dPoints(2).x = 0: dPoints(2).y = -3
dPoints(3).x = 1: dPoints(3).y = 0
dPoints(4).x = 0: dPoints(4).y = 3
'====Перевод координат (из дек. в полярные)
For i = 1 To 4
pPoints(i).R = GetDistance(0, 0, dPoints(i).x, dPoints(i).y)
pPoints(i).Theta = GetAngle(0, 0, dPoints(i).x, dPoints(i).y)
Next i
'====== ПРОЦЕСС ВРАЩЕНИЯ ============
' Здесь будем вращать картинку на 45 гр.
' Только нужно не забыть перевести градусы в радианы.
For i = 1 To 4
pPoints(i).Theta = pPoints(i).Theta + (45) * PI / 180
Next i
'==== ПЕРЕВОДИМ ОБРАТНО В ДЕКАРТОВЫ==========
For i = 1 To 4
dPoints(i).x = Cos(pPoints(i).Theta) * pPoints(i).R
dPoints(i).y = Sin(pPoints(i).Theta) * pPoints(i).R
Next i


Вот собственно и всё.
Чтобы всё было окончательно понятно прилагаю проект.

Должен будешь -

[DirectXManiac]

ОГРОМНОЕ СПАСИБО!! Обращайся если надо! Я понимаю что надо математику знать но всё таки...

[Хакер]

Пожалуйста.

Так я сам когда "чертилово" писал мучался... По кускам вынюхивать что-нибудь где-нибудь...

[pronto]

на тему вращения квадрата предлагаю свой вариант.

так так теоретические основы вопроса уже освещены,
то я их пропущу и приступлю непосредственно к
описанию кода.

1. размести на форме PictureBox, ComboBox

2. В свойствах PictureBox'а задай:
ScaleMode = 3 - Pixel
MousePointer = 2 - Cross
Name = Sheet
В свойствах ComboBox'a задай:
Style = 2 - Dropdown List
List = 3
4
5
6
7
Name = cmbTops
Вообще, способы ввода количества вершин могут быть
различными, но такой вариант проще в реализации и
изначально предотвращает ошибки со стороны
пользователя. В общем, дело вкуса...

3. Открой код формы и в секции (General) (Declarations)
объяви следующие переменные:

Код: Выделить всё

   Private Const gPi As Double  = 3.14159265358979  'число     пи = 180°
   Private Const g2Pi as Double = 6.28318530717959  'число 2 * пи = 360°
   
   Private A As Single, alpha As Single '. A - промежуточная угловая переменная
                                        '. alpha - угол поворота фигуры в радианах
   Private F as Single '.................. угол между вершинами многоугольника
                       '.................. для треугольника - 120°, для квадрата - 90° и тд
   Private kl As Integer, i As Integer '.. kl - счетчик щелчков по Sheet, i - счетчик цикла
   Private Tops As Integer '.............. количество вершин многоугольника
   Private r as Single '.................. радиус, описанной около многоугольника, окружности
   Private x1 as Single, y1 as Single '... координаты вершины
   Private cx As Single, cy As Single '... координаты центра фигуры
   Private dx As Single, dy As Single '... смещение вершины относительно центра

4. Создаем события Form_Load(), cmbTops_Click(), Sheet_MouseDown(), Sheet_MoseMove()
и создаем в них код.

Код: Выделить всё

   Private Sub Form_Load()
      kl = 0
      cmbTops.ListIndex = 1 'выбирается 4 вершины, то есть квадрат
   End Sub
   
   Private Sub cmbPolyGonStarTops_Click()
      Tops = Val(cmbTops.Text)
      F = (g2Pi / Tops) 'угол между верщинами (для правильных многоугольников)
   End Sub
   
   Private Sub Sheet_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
      Select Case kl
      Case 1
         cx = X: cy = Y 'координаты центра
      Case 2
         kl = 0 'прекращение изменение параметров фигуры (размер и угол поворота)
      End Select
   End Sub

   'основной код находится здесь
   Private Sub Sheet_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
      If kl = 1 Then
         Sheet.Cls
         r1 = Sqr((cx - X) ^ 2 + (cy - Y) ^ 2)
         
         For i = 0 To Tops 'начало цикла перечисления сторон многоугольника
            A = X - cx
            If A = 0 Then A = 0.000001 'предотвращение деления на ноль
            alpha = Atn((cy - Y) / A)
           
            If A < 0 Then 'когда курсор мыши находится левее центра фигуры
               alpha = i * F - alpha
            Else 'когда курсор мыши находится правее центра фигуры
               alpha = i * F - alpha - gPi
            End If
           
            dx = r * Cos(alpha): dy = r * Sin(alpha)
            x1 = cx - dx:        y1 = cy - dy
           
            If q > 0 Then
               Sheet.Line -(x1, y1)
            Else
               Sheet.PSet (x1, y1)
               Sheet.Line (cx, cy)-(x1, y1), &HFF 'прорисовка радиуса
            End If
         Next 'конец цикла перечисления сторон многоугольника
      End If
   End Sub

Все. Пользуйся!

[DirectXManiac]

Как я понял ,pronto, ты выложил код для поворота квадрата мышью? Спасибо! Это как раз то, что мне надо!

[Rostik Ultra (2)]

В архиве два исходника по вращению трёхмерных фигур

[DirectXManiac]

СПАСИБО!