Листинг 38.1. Код выше и в теле процедуры Form1_Load.
'Вводим функцию для изображаемой поверхности z = f(x, y):
Public Function f(ByVal x As Double, ByVal y As Double) _
As Double
'Параметры поверхности z = f(x, y)для эллипсоида:
Dim a As Double = 1.03
Dim b As Double = 1.02
Dim c As Double = 1.01
'Уравнение поверхности z = f(x, y) в виде эллипсоида:
f = Sqrt(c * c * (200 - x * x / (a * a) - _
y * y / (b * b)))
End Function
'Точка наблюдения:
Private myEye As myClassPoint3D
'Концы числового интервала области задания поверхности:
Private Const x_max As Integer = 20
Private Const y_max As Integer = 20
Private Const x_min As Integer = -10
Private Const y_min As Integer = -10
'Массив узловых точек:
Private Points(x_max, y_max) As myClassPoint3D
'Точки на осях координат:
Private Axes(3) As myClassPoint3D
'Загрузка данных и их инициализация:
Private Sub Form1_Load(ByVal sender As System.Object, _
ByVal e As EventArgs) Handles MyBase.Load
'Задаем координаты точки наблюдения:
myEye = New myClassPoint3D(40, 20, 20)
'Объявляем координаты точки:
Dim x, y, z As Double : Dim i, j As Integer
'В каждом (i,j)-м узле плоскости x,y
'рассчитываем координату z точки поверхности z = f(x, y):
For i = 0 To x_max
x = i + x_min
For j = 0 To y_max
y = j + y_min
'Координата z точек поверхности z = f(x, y):
z = f(x, y)
Points(i, j) = New myClassPoint3D(x, y, z)
Next
Next
'Инициализация осей (axes) координат:
Axes(0) = New myClassPoint3D(0, 0, 0) 'Начало коорд-т.
Axes(1) = New myClassPoint3D(30, 0, 0) 'Ось (axis) x.
Axes(2) = New myClassPoint3D(0, 30, 0) 'Ось y.
Axes(3) = New myClassPoint3D(0, 0, 30) 'Ось z.
End Sub
Чтобы мы могли рисовать заданную поверхность и оси координат внутри графического элемента PictureBox, в окне Class Name выбираем PictureBox1, а в окне Method Name выбираем Paint. Появляется файл Form1.vb с шаблоном (процедуры PictureBox1_Paint), который после записи нашего кода принимает такой вид.
Листинг 38.2. Метод PictureBox1_Paint для рисования поверхности.
Private Sub PictureBox1_Paint(ByVal sender As Object, _
ByVal e As System.Windows.Forms.PaintEventArgs) _
Handles PictureBox1.Paint
'Масштабируем все графические объекты на PictureBox1.
'Коэффициенты масштабирования:
Dim M_1 As Single = 29
Dim M_2 As Single = 31
e.Graphics.ScaleTransform( _
PictureBox1.Size.Width / M_1, _
-PictureBox1.Size.Height / M_2, _
MatrixOrder.Append)
Dim M_3 As Single = 2
Dim M_4 As Single = 2
e.Graphics.TranslateTransform( _
PictureBox1.Size.Width / M_3, _
PictureBox1.Size.Height / M_4, _
MatrixOrder.Append)
'Задавая M_1, M_2, M_3, M_4 другие значения,
'мы будем смещать поверхность по отношению к осям x,y,z.
'Матрица преобразования (transformation matrix):
Dim tr As myClassMatrix3D = CalculateTransformation()
'Применяем матрицу преобразования к точкам:
For x As Integer = 0 To x_max
For y As Integer = 0 To y_max
Points(x, y).Transformation(tr)
Next
Next
'Объявляем индексы элементов массива myArrayVB(i, j):
Dim i, j As Integer
'Задаем границы индексов массива myArrayVB(i, j):
Dim N_x As Integer = 2000
Dim N_y As Integer = 1
'Задаем массив myArrayVB(i, j)переменных типа Single,
'когда i = 0,1,2,3,...,N_x; j = 0,1,2,3,...,N_y:
Dim myArrayVB(N_x, N_y) As Single
'Первая, вторая и третья границы массива, разделяющие
'линии поверхности, параллельные xz, yz, и оси:
Dim N_1_myArrayVB, N_2_myArrayVB, _
N_3_myArrayVB As Integer
'Рассчитываем элементы массива myArrayVB(i, j)
'для рисования линий поверхности,
'параллельных плоскости координат xz:
Dim x1, y1, x2, y2 As Single
i = -2 'Задаем до циклов.
For x As Integer = 0 To x_max
With Points(x, 0)
x2 = .trans_coord(0)
y2 = .trans_coord(1)
End With
For y As Integer = 1 To y_max
x1 = x2 : y1 = y2
With Points(x, y)
x2 = .trans_coord(0)
y2 = .trans_coord(1)
End With
'Можно рисовать линии поверхности и здесь:
'e.Graphics.DrawLine(myPen, x1, y1, x2, y2)
'Записываем в массив координат:
i = i + 2
myArrayVB(i, 0) = x1
myArrayVB(i, 1) = y1
myArrayVB(i + 1, 0) = x2
myArrayVB(i + 1, 1) = y2
N_1_myArrayVB = i + 1 'Первая граница в массиве.
Next
Next
'Рассчитываем элементы массива myArrayVB(i, j)
'для рисования линий поверхности,
'параллельных плоскости координат yz:
i = N_1_myArrayVB - 1
For y As Integer = 0 To y_max
With Points(0, y)
x2 = .trans_coord(0)
y2 = .trans_coord(1)
End With
For x As Integer = 1 To x_max
x1 = x2 : y1 = y2
With Points(x, y)
x2 = .trans_coord(0)
y2 = .trans_coord(1)
End With
'Можно рисовать линии поверхности и здесь:
'e.Graphics.DrawLine(myPen, x1, y1, x2, y2)
'Записываем в массив координат:
i = i + 2
myArrayVB(i, 0) = x1
myArrayVB(i, 1) = y1
myArrayVB(i + 1, 0) = x2
myArrayVB(i + 1, 1) = y2
N_2_myArrayVB = i + 1 'Вторая граница в массиве.
Next
Next
'Преобразовываем оси(axes):
For k As Integer = 0 To 3
Axes(k).Transformation(tr)
Next
'Рассчитываем элементы массива для рисования осей:
i = N_2_myArrayVB - 1
x1 = Axes(0).trans_coord(0)
y1 = Axes(0).trans_coord(1)
For k As Integer = 1 To 3
x2 = Axes(k).trans_coord(0)
y2 = Axes(k).trans_coord(1)
'Можно рисовать оси координат и здесь:
'e.Graphics.DrawLine(myPen, x1, y1, x2, y2)
'Записываем в массив координат:
i = i + 2
myArrayVB(i, 0) = x1
myArrayVB(i, 1) = y1
myArrayVB(i + 1, 0) = x2
myArrayVB(i + 1, 1) = y2
N_3_myArrayVB = i + 1 'Число всех чисел в массиве.
Next
'Рисуем при помощи массива координат myArrayVB(2000, 1).
'Рисуем линии, параллельные плоскости xz:
Dim myPen As New Pen(Color.Black, 0)
i = -2
For x As Integer = 0 To x_max
For y As Integer = 1 To y_max
i = i + 2
x1 = myArrayVB(i, 0)
y1 = myArrayVB(i, 1)
x2 = myArrayVB(i + 1, 0)
y2 = myArrayVB(i + 1, 1)
e.Graphics.DrawLine(myPen, x1, y1, x2, y2)
Next
Next
'Рисуем линии, параллельные плоскости yz:
i = N_1_myArrayVB - 1
For y As Integer = 0 To y_max
For x As Integer = 1 To x_max
i = i + 2
x1 = myArrayVB(i, 0)
y1 = myArrayVB(i, 1)
x2 = myArrayVB(i + 1, 0)
y2 = myArrayVB(i + 1, 1)
e.Graphics.DrawLine(myPen, x1, y1, x2, y2)
Next
Next
'Рисуем три оси координат:
i = N_2_myArrayVB - 1
Dim myPen2 As New Pen(Color.Red, 0)
For k As Integer = 1 To 3
i = i + 2
x1 = myArrayVB(i, 0)
y1 = myArrayVB(i, 1)
x2 = myArrayVB(i + 1, 0)
y2 = myArrayVB(i + 1, 1)
e.Graphics.DrawLine(myPen2, x1, y1, x2, y2)
Next
'Записываем массив координат myArrayVB(2000, 1) в файл.
'Создаем объект sw класса StreamWriter
'для записи в файл по адресу D:\MyDocs\MyTest.txt.
'Файл автоматически “опустошается”:
Dim sw As StreamWriter = _
New StreamWriter("D:\MyDocs\MyTest.txt")
'Каждый элемент массива myArrayVB(i, j) записываем в файл
'в виде отдельной строки при помощи процедуры WriteLine:
For i = 0 To N_x
For j = 0 To N_y
sw.WriteLine(myArrayVB(i, j))
Next
Next
sw.Close()
End Sub
Чтобы мы могли управлять (например, вращать) объектами при помощи нажатия клавиш, в окне Class Name выбираем (Overrides), а в окне Method Name выбираем ProcessCmdKey. Появляется файл Form1.vb с шаблоном (процедуры ProcessCmdKey), который после записи нашего кода принимает следующий вид.
Листинг 38.3. Метод ProcessCmdKey для вращения поверхности.
'Поворачиваем поверхность после нажатия клавиши:
Protected Overrides Function ProcessCmdKey( _
ByRef msg As System.Windows.Forms.Message, _
ByVal keyData As System.Windows.Forms.Keys) As Boolean
'Задаем шаг поворота поверхности:
Const delta_theta As Double = PI / 32
Const delta_phi As Double = PI / 16
'Вычисляем сферические координаты (spherical coordinates)
'точки наблюдения:
Dim theta As Double = Atan2(myEye.orig_coord(1), _
myEye.orig_coord(0))
Dim r1 As Double = Sqrt(myEye.orig_coord(0) * _
myEye.orig_coord(0) _
+ myEye.orig_coord(1) * myEye.orig_coord(1))
Dim r2 As Double = Sqrt(myEye.orig_coord(0) * _
myEye.orig_coord(0) _
+ myEye.orig_coord(1) * myEye.orig_coord(1) + _
myEye.orig_coord(2) * myEye.orig_coord(2))
Dim phi As Double = Atan2(myEye.orig_coord(2), r1)
'Корректируем углы phi и theta:
Select Case keyData
Case Keys.Left
theta = theta - delta_theta
Case Keys.Up
phi = phi - delta_phi
If phi < -PI / 2 Then phi = -PI / 2
Case Keys.Right
theta = theta + delta_theta
Case Keys.Down
phi = phi + delta_phi
If phi > PI / 2 Then phi = PI / 2
Case Else
Exit Function
End Select
'Изменяем координаты точки наблюдения:
myEye.orig_coord(0) = r1 * Cos(theta)
myEye.orig_coord(1) = r1 * Sin(theta)
myEye.orig_coord(2) = r2 * Sin(phi)
'Перерисовываем изображение внутри PictureBox1:
PictureBox1.Invalidate()
End Function
Ниже этого кода записываем следующую функцию.
Листинг 38.4. Метод CalculateTransformation.
'Вычисляем матрицу преобразования
'для текущей точки наблюдения:
Private Function CalculateTransformation() As myClassMatrix3D
'Поворачиваем вокруг оси z,
'чтобы точка наблюдения оказалась в плоскости y-z:
Dim transformation1 As myClassMatrix3D = _
myClassMatrix3D.GetZRotPointToYZ(myEye)
'Поворачиваем вокруг оси x,
'чтобы точка наблюдения оказалась на оси z:
Dim transformation2 As myClassMatrix3D = _
myClassMatrix3D.GetXRotPointToZ(myEye)
'Проецируем по оси z, игнорируя координату z.
'Умножаем матрицы преобразования:
Return transformation1.TimesMatrix(transformation2)
End Function
Ниже этого автоматически сгенерированного класса Form1:
Public Class Form1
Inherits System.Windows.Forms.Form
…
End Class
вводим два новых класса с методами преобразования систем координат.
Листинг 38.5. Два новых класса.
'Вводим класс с методами преобразования систем координат
'в трехмерном пространстве:
Public Class myClassPoint3D
'Массив из 4-х элементов для первоначальных координат
'(original coordinates); нулевой индекс используем:
Public orig_coord(3) As Double
'Массив для преобразованных координат
'(transformed coordinates):
Public trans_coord(3) As Double
'Создаем новый неинициализированный вектор:
Public Sub New()
End Sub
'Создаем новый инициализированный вектор:
Public Sub New(ByVal x As Double, ByVal y As Double, _
ByVal z As Double, Optional ByVal myScale As Double = 1)
orig_coord(0) = x
orig_coord(1) = y
orig_coord(2) = z
orig_coord(3) = myScale
End Sub
'Матрица преобразования (transformation matrix):
Public Function Transformation( _
ByVal matrix As myClassMatrix3D, _
Optional ByVal normalize As Boolean = True) _
As myClassPoint3D
Dim value As Double
Dim result As New myClassPoint3D
For i As Integer = 0 To 3
value = 0
For j As Integer = 0 To 3
value = value + _
orig_coord(j) * matrix.M(j, i)
Next
trans_coord(i) = value
Next
'Повторно нормализуем точку:
If normalize Then
'После выхода из цикла value = trans_coord(3):
trans_coord(0) = trans_coord(0) / value
trans_coord(1) = trans_coord(1) / value
trans_coord(2) = trans_coord(2) / value
trans_coord(3) = 1
End If
End Function
End Class
'Вводим класс с методами преобразования координат точки
'в трехмерном пространстве:
Public Class myClassMatrix3D
'Матрица (matrix) в виде массива размера 4x4:
Public M(3, 3) As Double
'Создаем новую неинициализированную матрицу:
Public Sub New()
End Sub
'Создаем новую инициализированную матрицу:
Public Sub New( _
ByVal m00 As Double, ByVal m01 As Double, _
ByVal m02 As Double, ByVal m03 As Double, _
ByVal m10 As Double, ByVal m11 As Double, _
ByVal m12 As Double, ByVal m13 As Double, _
ByVal m20 As Double, ByVal m21 As Double, _
ByVal m22 As Double, ByVal m23 As Double, _
ByVal m30 As Double, ByVal m31 As Double, _
ByVal m32 As Double, ByVal m33 As Double)
M(0, 0) = m00 : M(0, 1) = m01 : M(0, 2) = m02
M(0, 3) = m03
M(1, 0) = m10 : M(1, 1) = m11 : M(1, 2) = m12
M(1, 3) = m13
M(2, 0) = m20 : M(2, 1) = m21 : M(2, 2) = m22
M(2, 3) = m23
M(3, 0) = m30 : M(3, 1) = m31 : M(3, 2) = m32
M(3, 3) = m33
End Sub
'Умножение матрицы на матрицу справа:
Public Function TimesMatrix( _
ByVal right_matrix As myClassMatrix3D) As myClassMatrix3D
Dim result As New myClassMatrix3D
Dim value As Double
For i As Integer = 0 To 3
For j As Integer = 0 To 3
value = 0
For k As Integer = 0 To 3
value = value + M(i, k) * _
right_matrix.M(k, j)
Next
result.M(i, j) = value
Next
Next
Return result
End Function
'Поворот вокруг оси z до точки в y-z плоскости:
Public Shared Function GetZRotPointToYZ( _
ByVal pt As myClassPoint3D) As myClassMatrix3D
Dim R As Double = Sqrt(pt.orig_coord(0) * _
pt.orig_coord(0) + _
pt.orig_coord(1) * pt.orig_coord(1))
Dim stheta As Double = pt.orig_coord(0) / R
Dim ctheta As Double = pt.orig_coord(1) / R
Return New myClassMatrix3D( _
ctheta, stheta, 0, 0, _
-stheta, ctheta, 0, 0, _
0, 0, 1, 0, _
0, 0, 0, 1)
End Function
'Поворот вокруг оси x до точки на оси z:
Public Shared Function GetXRotPointToZ( _
ByVal pt As myClassPoint3D) As myClassMatrix3D
Dim R1 As Double = Sqrt(pt.orig_coord(0) * _
pt.orig_coord(0) + pt.orig_coord(1) * _
pt.orig_coord(1))
Dim R2 As Double = Sqrt(pt.orig_coord(0) * _
pt.orig_coord(0) + pt.orig_coord(1) * _
pt.orig_coord(1) + pt.orig_coord(2) * _
pt.orig_coord(2))
Dim sphi As Double = -R1 / R1
Dim cphi As Double = -pt.orig_coord(2) / R2
Return New myClassMatrix3D( _
1, 0, 0, 0, _
0, cphi, sphi, 0, _
0, -sphi, cphi, 0, _
0, 0, 0, 1)
End Function
End Class
Аналогично можно записать массивы с координатами точек для нескольких геометрических изображений в несколько различных файлов на жестком диске компьютера
0 коммент.:
Отправить комментарий