Изображение и управление
Листинг 34.1. Код выше и в теле процедуры Form1_Load.
'Начало координат:
Private Const x_focus As Double = 0
Private Const y_focus As Double = 0
Private Const z_focus As Double = 0
'Сферические координаты точки E (глаза наблюдателя Eye):
Private r_Eye As Single
Private phi_Eye As Single
Private theta_Eye As Single
'Объявляем матрицу (как массив) и переменные
'(во всех массивах нулевые индексы не используем):
Private Const pi As Double = Math.PI
Private MatrixProjection(4, 4) As Single
Private Tetrahedron As Integer
Private Cube As Integer
Private Octahedron As Integer
Private Dodecahedron As Integer
Private Icosahedron_first As Integer
Private Icosahedron_last As Integer
'Для параллельного проецирования объекта на экран
'(parallel projection) задаем константу:
Private Const ParallelProjection As Integer = 0
'Для перспективного проецирования объекта на экран
'(perspective projection)задаем константу:
Private Const PerspectiveProjection As Integer = 1
Private Sub Form1_Load(ByVal sender As System.Object, _
ByVal e As EventArgs) Handles MyBase.Load
'Задаем координаты глаза наблюдателя, например:
r_Eye = 4 : phi_Eye = 0.05 * pi : theta_Eye = 0.3 * pi
'Вызываем процедуру для перспективного проецирования,
'когда type_of_projection = PerspectiveProjection
'(для параллельного проецирования вместо
'PerspectiveProjection пишем ParallelProjection):
Projection(MatrixProjection, PerspectiveProjection, _
r_Eye, phi_Eye, theta_Eye, _
x_focus, y_focus, z_focus, 0, 1, 0)
'Рассчитываем параметры геометрического тела:
СalculateParameters()
'Связываем элемент PictureBox1 с классом Bitmap:
PictureBox1.Image = New Bitmap(PictureBox1.Width, _
PictureBox1.Height)
'Проектируем и в PictureBox1 рисуем выбранное нами тело:
Designing(DirectCast(PictureBox1.Image, Bitmap))
End Sub
Чтобы мы могли управлять (например, вращать) объектами при помощи нажатия клавиш, в окне Class Name выбираем (Overrides), а в окне Method Name выбираем ProcessCmdKey. Появляется файл Form1.vb с шаблоном (метода ProcessCmdKey), который после записи нашего кода принимает следующий вид. Отметим, что если в версии VS, которая имеется у читателя, отсутствует метод ProcessCmdKey, то необходимо полностью записать нижеследующий метод вместе с шаблоном (или скопировать весь метод из прилагаемого к книге диска).
Листинг 34.2. Метод 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 Single = pi / 20
Select Case keyData
Case System.Windows.Forms.Keys.Left
theta_Eye = theta_Eye - delta_theta
Case System.Windows.Forms.Keys.Right
theta_Eye = theta_Eye + delta_theta
Case System.Windows.Forms.Keys.Up
phi_Eye = phi_Eye - delta_theta
Case System.Windows.Forms.Keys.Down
phi_Eye = phi_Eye + delta_theta
Case Else
Return MyBase.ProcessCmdKey(msg, keyData)
End Select
Projection(MatrixProjection, PerspectiveProjection, _
r_Eye, phi_Eye, theta_Eye, _
x_focus, y_focus, z_focus, 0, 1, 0)
'В элементе PictureBox1 перерисовываем объект:
Designing(DirectCast(PictureBox1.Image, Bitmap))
PictureBox1.Refresh()
Return True
End Function
Ниже этого кода записываем следующие все процедуры и функции.
Листинг 34.3. Процедуры и функции.
'Проектируем и при помощи процедуры DrawSolid
'рисуем выбранное флажком CheckBox геометрическое тело:
Private Sub Designing(ByVal bmp As Bitmap)
'Создаем объект g класса Graphics:
Dim g As Graphics
'Связываем объект g с изображением bmp:
g = Graphics.FromImage(bmp)
' Задаем белый цвет типа Window
'для элемента управления PictureBox1:
g.Clear(SystemColors.Window)
'Высвобождаем ресурсы от графического объекта g:
g.Dispose()
'Преобразуем точки:
TransformAllDataFull(MatrixProjection)
'Проектируем и рисуем выбранное на CheckBox тело:
If CheckBox1.CheckState = _
System.Windows.Forms.CheckState.Checked Then
DrawSolid(bmp, Tetrahedron, Cube - 1, _
System.Drawing.Color.Red, False)
End If
If CheckBox2.CheckState = _
System.Windows.Forms.CheckState.Checked Then _
DrawSolid(bmp, Cube, Octahedron - 1, _
System.Drawing.Color.Black, False)
If CheckBox3.CheckState = _
System.Windows.Forms.CheckState.Checked Then _
DrawSolid(bmp, Octahedron, Dodecahedron - 1, _
System.Drawing.Color.Green, False)
If CheckBox4.CheckState = _
System.Windows.Forms.CheckState.Checked Then _
DrawSolid(bmp, Dodecahedron, Icosahedron_first - 1, _
System.Drawing.Color.Blue, False)
If CheckBox5.CheckState = _
System.Windows.Forms.CheckState.Checked Then _
DrawSolid(bmp, Icosahedron_first, Icosahedron_last, _
System.Drawing.Color.Orange, False)
If CheckBox6.CheckState = _
System.Windows.Forms.CheckState.Checked Then _
DrawSolid(bmp, 1, Tetrahedron - 1, _
System.Drawing.Color.Salmon, False)
End Sub
'Рассчитываем параметры геометрических тел и осей:
Private Sub СalculateParameters()
Dim theta1 As Single : Dim theta2 As Single
Dim s1 As Single : Dim s2 As Single
Dim c1 As Single : Dim c2 As Single
Dim S As Single : Dim R As Single
Dim H As Single : Dim A As Single
Dim B As Single : Dim C As Single
Dim D As Single : Dim X As Single
Dim Y As Single : Dim y2 As Single
Dim M As Single : Dim N As Single
'Оси координат:
DesigningLine(0, 0, 0, 0.5, 0, 0) 'Ось x.
DesigningLine(0, 0, 0, 0, 0.5, 0) 'Ось y.
DesigningLine(0, 0, 0, 0, 0, 0.5) 'Ось z.
'Тетраэдр (Tetrahedron):
Tetrahedron = NumLines + 1
S = CSng(Sqrt(6))
A = S / CSng(Sqrt(3))
B = -A / 2
C = A * CSng(Sqrt(2)) - 1
D = S / 2
DesigningLine(0, C, 0, A, -1, 0)
DesigningLine(0, C, 0, B, -1, D)
DesigningLine(0, C, 0, B, -1, -D)
DesigningLine(B, -1, -D, B, -1, D)
DesigningLine(B, -1, D, A, -1, 0)
DesigningLine(A, -1, 0, B, -1, -D)
'Куб (Cube):
Cube = NumLines + 1
DesigningLine(-1, -1, -1, -1, 1, -1)
DesigningLine(-1, 1, -1, 1, 1, -1)
DesigningLine(1, 1, -1, 1, -1, -1)
DesigningLine(1, -1, -1, -1, -1, -1)
DesigningLine(-1, -1, 1, -1, 1, 1)
DesigningLine(-1, 1, 1, 1, 1, 1)
DesigningLine(1, 1, 1, 1, -1, 1)
DesigningLine(1, -1, 1, -1, -1, 1)
DesigningLine(-1, -1, -1, -1, -1, 1)
DesigningLine(-1, 1, -1, -1, 1, 1)
DesigningLine(1, 1, -1, 1, 1, 1)
DesigningLine(1, -1, -1, 1, -1, 1)
'Октаэдр (Octahedron):
Octahedron = NumLines + 1
DesigningLine(0, 1, 0, 1, 0, 0)
DesigningLine(0, 1, 0, -1, 0, 0)
DesigningLine(0, 1, 0, 0, 0, 1)
DesigningLine(0, 1, 0, 0, 0, -1)
DesigningLine(0, -1, 0, 1, 0, 0)
DesigningLine(0, -1, 0, -1, 0, 0)
DesigningLine(0, -1, 0, 0, 0, 1)
DesigningLine(0, -1, 0, 0, 0, -1)
DesigningLine(0, 0, 1, 1, 0, 0)
DesigningLine(0, 0, 1, -1, 0, 0)
DesigningLine(0, 0, -1, 1, 0, 0)
DesigningLine(0, 0, -1, -1, 0, 0)
'ДОдекаэдр (Dodecahedron):
Dodecahedron = NumLines + 1
theta1 = pi * 0.4 : theta2 = pi * 0.8
s1 = CSng(Sin(theta1))
c1 = CSng(Cos(theta1))
s2 = CSng(Sin(theta2))
c2 = CSng(Cos(theta2))
M = 1 - (2 - 2 * c1 - 4 * s1 * s1) / (2 * c1 - 2)
N = CSng(Sqrt((2 - 2 * c1) - M * M)) * _
(1 + (1 - c2) / (c1 - c2)) : R = 2 / N
S = R * CSng(Sqrt(2 - 2 * c1))
A = R * s1 : B = R * s2
C = R * c1 : D = R * c2
H = R * (c1 - s1)
X = (R * R * (2 - 2 * c1) - 4 * A * A) / _
(2 * C - 2 * R)
Y = CSng(Sqrt(S * S - (R - X) * (R - X)))
y2 = Y * (1 - c2) / (c1 - c2)
DesigningLine(R, 1, 0, C, 1, A)
DesigningLine(C, 1, A, D, 1, B)
DesigningLine(D, 1, B, D, 1, -B)
DesigningLine(D, 1, -B, C, 1, -A)
DesigningLine(C, 1, -A, R, 1, 0)
DesigningLine(R, 1, 0, X, 1 - Y, 0)
DesigningLine(C, 1, A, X * c1, 1 - Y, X * s1)
DesigningLine(C, 1, -A, X * c1, 1 - Y, -X * s1)
DesigningLine(D, 1, B, X * c2, 1 - Y, X * s2)
DesigningLine(D, 1, -B, X * c2, 1 - Y, -X * s2)
DesigningLine(X, 1 - Y, 0, -X * c2, 1 - y2, -X * s2)
DesigningLine(X, 1 - Y, 0, -X * c2, 1 - y2, X * s2)
DesigningLine(X * c1, 1 - Y, X * s1, _
-X * c2, 1 - y2, X * s2)
DesigningLine(X * c1, 1 - Y, X * s1, _
-X * c1, 1 - y2, X * s1)
DesigningLine(X * c2, 1 - Y, X * s2, _
-X * c1, 1 - y2, X * s1)
DesigningLine(X * c2, 1 - Y, X * s2, -X, 1 - y2, 0)
DesigningLine(X * c2, 1 - Y, -X * s2, -X, 1 - y2, 0)
DesigningLine(X * c2, 1 - Y, -X * s2, _
-X * c1, 1 - y2, -X * s1)
DesigningLine(X * c1, 1 - Y, -X * s1, _
-X * c1, 1 - y2, -X * s1)
DesigningLine(X * c1, 1 - Y, -X * s1, _
-X * c2, 1 - y2, -X * s2)
DesigningLine(-R, -1, 0, -X, 1 - y2, 0)
DesigningLine(-C, -1, A, -X * c1, 1 - y2, X * s1)
DesigningLine(-D, -1, B, -X * c2, 1 - y2, X * s2)
DesigningLine(-D, -1, -B, -X * c2, 1 - y2, -X * s2)
DesigningLine(-C, -1, -A, -X * c1, 1 - y2, -X * s1)
DesigningLine(-R, -1, 0, -C, -1, A)
DesigningLine(-C, -1, A, -D, -1, B)
DesigningLine(-D, -1, B, -D, -1, -B)
DesigningLine(-D, -1, -B, -C, -1, -A)
DesigningLine(-C, -1, -A, -R, -1, 0)
'Икосаэдр (Icosahedron):
Icosahedron_first = NumLines + 1
R = 2 / (2 * CSng(Sqrt(1 - 2 * c1)) + _
CSng(Sqrt(3 / 4 * (2 - 2 * c1) - _
2 * c2 - c2 * c2 - 1)))
S = R * CSng(Sqrt(2 - 2 * c1))
H = 1 - CSng(Sqrt(S * S - R * R))
A = R * s1 : B = R * s2
C = R * c1 : D = R * c2
DesigningLine(R, H, 0, C, H, A)
DesigningLine(C, H, A, D, H, B)
DesigningLine(D, H, B, D, H, -B)
DesigningLine(D, H, -B, C, H, -A)
DesigningLine(C, H, -A, R, H, 0)
DesigningLine(R, H, 0, 0, 1, 0)
DesigningLine(C, H, A, 0, 1, 0)
DesigningLine(D, H, B, 0, 1, 0)
DesigningLine(D, H, -B, 0, 1, 0)
DesigningLine(C, H, -A, 0, 1, 0)
DesigningLine(-R, -H, 0, -C, -H, A)
DesigningLine(-C, -H, A, -D, -H, B)
DesigningLine(-D, -H, B, -D, -H, -B)
DesigningLine(-D, -H, -B, -C, -H, -A)
DesigningLine(-C, -H, -A, -R, -H, 0)
DesigningLine(-R, -H, 0, 0, -1, 0)
DesigningLine(-C, -H, A, 0, -1, 0)
DesigningLine(-D, -H, B, 0, -1, 0)
DesigningLine(-D, -H, -B, 0, -1, 0)
DesigningLine(-C, -H, -A, 0, -1, 0)
DesigningLine(R, H, 0, -D, -H, B)
DesigningLine(R, H, 0, -D, -H, -B)
DesigningLine(C, H, A, -D, -H, B)
DesigningLine(C, H, A, -C, -H, A)
DesigningLine(D, H, B, -C, -H, A)
DesigningLine(D, H, B, -R, -H, 0)
DesigningLine(D, H, -B, -R, -H, 0)
DesigningLine(D, H, -B, -C, -H, -A)
DesigningLine(C, H, -A, -C, -H, -A)
DesigningLine(C, H, -A, -D, -H, -B)
Icosahedron_last = NumLines
End Sub
Public Structure Line
'Массивы для соединения точек (points):
<VBFixedArray(4)> Dim fr_points() As Single
<VBFixedArray(4)> Dim to_points() As Single
' Массивы для соединения преобразованных точек
'(transformed points):
<VBFixedArray(4)> Dim fr_tr_points() As Single
<VBFixedArray(4)> Dim to_tr_points() As Single
Public Sub Initialize()
ReDim fr_points(4) : ReDim to_points(4)
ReDim fr_tr_points(4) : ReDim to_tr_points(4)
End Sub
End Structure
'Объявляем массив Lines структуры Line (создавать массив
'из изменяемого количества элементов и инициализировать его 'при помощи оператора ReDim мы будем ниже):
Public Lines() As Line
'Объявляем и инициализируем переменную для индекса массива:
Public NumLines As Integer
'Проектируем линию между точками (x1,y1,z1),(x2,y2,z2):
Public Sub DesigningLine(ByVal x1 As Single, _
ByVal y1 As Single, ByVal z1 As Single, ByVal x2 As Single, _
ByVal y2 As Single, ByVal z2 As Single)
NumLines = NumLines + 1
'Создаем массив Lines структуры Line из изменяемого
'количества элементов NumLines, инициализируем его
'оператором ReDim и при помощи ключевого слова Preserve
'сохраняем предыдущие данные массива:
ReDim Preserve Lines(NumLines)
'Инициализируем и рассчитываем массивы:
Lines(NumLines).Initialize()
Lines(NumLines).fr_points(1) = x1
Lines(NumLines).fr_points(2) = y1
Lines(NumLines).fr_points(3) = z1
Lines(NumLines).fr_points(4) = 1
Lines(NumLines).to_points(1) = x2
Lines(NumLines).to_points(2) = y2
Lines(NumLines).to_points(3) = z2
Lines(NumLines).to_points(4) = 1
End Sub
'Применяем матрицу переноса (translation matrix)
'ко всем линиям, используя MatrixApplyFull.
' Преобразование не имеет 0, 0, 0, 1 в последнем столбце:
Public Sub TransformAllDataFull(ByRef M(,) As Single)
TransformDataFull(M, 1, NumLines)
End Sub
'Применяем матрицу переноса (translation matrix)
'ко всем выделенным линиям, используя MatrixApplyFull.
'Преобразование не имеет 0, 0, 0, 1 в последнем столбце:
Public Sub TransformDataFull(ByRef M(,) As Single, _
ByVal line1 As Integer, ByVal line2 As Integer)
Dim i As Integer
For i = line1 To line2
MatrixApplyFull(Lines(i).fr_points, M, _
Lines(i).fr_tr_points)
MatrixApplyFull(Lines(i).to_points, M, _
Lines(i).to_tr_points)
Next i
End Sub
'Вводим перем-ю N_Graphics для номера многих геом-х изобр-й.
'Номер первого изображения равен 1:
Dim N_Graphics As Integer = 1
'Рисуем выделенные преобразованные линии и экпорт-м в файлы:
Public Sub DrawSolid(ByVal bmp As Bitmap, _
ByVal first_line As Integer, ByVal last_line As Integer, _
ByVal color As Color, ByVal clear As Boolean)
Dim k As Integer
Dim x1 As Single : Dim y1 As Single
Dim x2 As Single : Dim y2 As Single
Dim g As Graphics : Dim pen As Pen
'Задаем толщину линии рисования, например, 2
'(цвет линии мы задали в процедуре Designing):
pen = New Pen(color, 2)
'Связываем объект g с изображением bmp:
g = Graphics.FromImage(bmp)
If clear Then g.Clear(System.Drawing.Color.Black)
'Объявляем индексы элементов всех массивов:
Dim i, j As Integer
'Если этот метод DrawSolid вызван второй раз
'для рисования второго изображения и N_Graphics = 2,
'то обходим 1-й массив для первого изобр-я до метки M2:
If N_Graphics = 2 Then GoTo M2
'Программируем первый массив для первого изображения:
'Задаем границы индексов первого массива myArrayVB(i, j)
Dim N_x As Integer = 200
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 'Автомат-ки обнуляется.
'Значение первой границы массива myArrayVB:
Dim N_1_myArrayVB As Integer
'Рассчитываем элементы массива myArrayVB(i, j)
'для рисования линий первого геом-го изображения:
i = -1 'Задаем до цикла.
For k = first_line To last_line
x1 = Lines(k).fr_tr_points(1)
y1 = Lines(k).fr_tr_points(2)
x2 = Lines(k).to_tr_points(1)
y2 = Lines(k).to_tr_points(2)
'Можно рисовать линии изображения и здесь:
'g.DrawLine(pen, _
' (x1 * bmp.Width / 4) + bmp.Width / 2.0F, _
' bmp.Height / 2.0F - (y1 * bmp.Height / 4), _
' (x2 * bmp.Width / 4) + bmp.Width / 2.0F, _
' bmp.Height / 2.0F - (y2 * bmp.Height / 4) _
')
'Масштабируем значения координат:
x1 = (x1 * bmp.Width / 4) + bmp.Width / 2.0F
y1 = bmp.Height / 2.0F - (y1 * bmp.Height / 4)
x2 = (x2 * bmp.Width / 4) + bmp.Width / 2.0F
y2 = bmp.Height / 2.0F - (y2 * bmp.Height / 4)
'Записываем координаты точек в массив:
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
'Начало N_first_line и конец N_last_line цикла
'при рисовании из массива myArrayVB:
Dim N_first_line, N_last_line As Integer
N_first_line = first_line
N_last_line = last_line
'Передаем значения начала N_first_line
'и конца цикла N_last_line в элементы массива
'myArrayVB(0, 0) и myArrayVB(0, 1):
myArrayVB(0, 0) = N_first_line
myArrayVB(0, 1) = N_last_line
' Рисуем при помощи массива координат myArrayVB(200, 1).
i = -1
For k = N_first_line To N_last_line
i = i + 2
x1 = myArrayVB(i, 0)
y1 = myArrayVB(i, 1)
x2 = myArrayVB(i + 1, 0)
y2 = myArrayVB(i + 1, 1)
g.DrawLine(pen, x1, y1, x2, y2)
Next
'Записываем массив координат myArrayVB(200, 1) в файл.
'Создаем объект sw класса StreamWriter для записи
'в файл по адресу D:\MyDocs\MyTest3D_Graphics.txt.
If N_Graphics = 1 Then
Dim sw As StreamWriter = _
New StreamWriter("D:\MyDocs\MyTest3D_Graphics.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 If
M2:
'Если этот метод DrawSolid вызван первый раз
'для рисования первого изображения и N_Graphics = 1,
'то обходим 2-й массив для 2-го изобр-я до метки M_End:
If N_Graphics = 1 Then GoTo M_End
'Программируем второй массив для второго изображения.
'Задаем границы индексов 2-го массива myArrayVB_2(i, j):
Dim N_x_2 As Integer = 200
Dim N_y_2 As Integer = 1
'Задаем массив myArrayVB_2(i, j) переменных типа Single,
'когда i = 0,1,2,3,...,N_x; j = 0,1,2,3,...,N_y:
Dim myArrayVB_2(N_x_2, N_y_2) As Single
'Значение первой границы массива myArrayVB_2:
Dim N_1_myArrayVB_2 As Integer
'Рассчитываем элементы массива myArrayVB_2(i, j)
'для рисования линий второго геом-го изображения:
i = -1 'Задаем до цикла.
For k = first_line To last_line
x1 = Lines(k).fr_tr_points(1)
y1 = Lines(k).fr_tr_points(2)
x2 = Lines(k).to_tr_points(1)
y2 = Lines(k).to_tr_points(2)
'Можно рисовать линии изображения и здесь:
'g.DrawLine(pen, _
' (x1 * bmp.Width / 4) + bmp.Width / 2.0F, _
' bmp.Height / 2.0F - (y1 * bmp.Height / 4), _
' (x2 * bmp.Width / 4) + bmp.Width / 2.0F, _
' bmp.Height / 2.0F - (y2 * bmp.Height / 4) _
')
'Масштабируем значения координат:
x1 = (x1 * bmp.Width / 4) + bmp.Width / 2.0F
y1 = bmp.Height / 2.0F - (y1 * bmp.Height / 4)
x2 = (x2 * bmp.Width / 4) + bmp.Width / 2.0F
y2 = bmp.Height / 2.0F - (y2 * bmp.Height / 4)
'Записываем координаты точек в массив:
i = i + 2
myArrayVB_2(i, 0) = x1
myArrayVB_2(i, 1) = y1
myArrayVB_2(i + 1, 0) = x2
myArrayVB_2(i + 1, 1) = y2
N_1_myArrayVB_2 = i + 1 'Значение границы массива.
Next
'Начало N_first_line_2 и конец N_last_line_2 цикла
'при рисовании из массива myArrayVB_2:
Dim N_first_line_2, N_last_line_2 As Integer
N_first_line_2 = first_line
N_last_line_2 = last_line
'Передаем значения начала N_first_line_2
'и конца цикла N_last_line_2 в элементы массива
'myArrayVB_2(0, 0) и myArrayVB_2(0, 1):
myArrayVB_2(0, 0) = N_first_line_2
myArrayVB_2(0, 1) = N_last_line_2
' Рисуем при помощи массива координат myArrayVB_2(200, 1):
i = -1
For k = N_first_line_2 To N_last_line_2
i = i + 2
x1 = myArrayVB_2(i, 0)
y1 = myArrayVB_2(i, 1)
x2 = myArrayVB_2(i + 1, 0)
y2 = myArrayVB_2(i + 1, 1)
g.DrawLine(pen, x1, y1, x2, y2)
Next
'Записываем массив координат myArrayVB_2(200, 1) в файл.
'Создаем объект sw_2 класса StreamWriter для записи
'в файл по адресу D:\MyDocs\MyTest3D_Graphics_2.txt.
'Файл автоматически "опустошается":
Dim sw_2 As StreamWriter = _
New StreamWriter("D:\MyDocs\MyTest3D_Graphics_2.txt")
'Каждый элемент массива myArrayVB_2(i, j) запис-м в файл
' в виде отдельной строки при помощи процедуры WriteLine:
For i = 0 To N_x_2
For j = 0 To N_y_2
sw_2.WriteLine(myArrayVB_2(i, j))
Next
Next
sw_2.Close()
'Высвобождаем ресурсы от объектов g и pen:
g.Dispose() : pen.Dispose()
M_End:
'Если эта метод DrawSolid вызвана еще раз
'для рисования следующего изображения,
'то увеличиваем номер изображения N_Graphics на 1:
N_Graphics = N_Graphics + 1
End Sub
'Строим единичную матрицу:
Public Sub MatrixIdentity(ByRef M(,) As Single)
Dim i As Integer : Dim j As Integer
For i = 1 To 4
For j = 1 To 4
If i = j Then
M(i, j) = 1
Else
M(i, j) = 0
End If
Next
Next
End Sub
'Строим матрицу преобразования (3-D transformation matrix)
'для перспективной проекции вдоль оси z на плоскость x,y
'с центром объекта (фокусом) в начале координат
'и c центром проецирования на расстоянии (0, 0, Distance):
Public Sub MatrixPerspectiveXZ(ByRef M(,) As Single, _
ByVal Distance As Single)
MatrixIdentity(M)
If Distance <> 0 Then M(3, 4) = -1 / Distance
End Sub
'Строим матрицу преобразования (3-D transformation matrix)
'для проецирования с координатами:
'центр проецирования (cx, cy, cz),
'фокус (fx, fy, fx),
'вектор от объекта до экрана UP <ux, yx, uz>,
'тип проецирования (type_of_projection):
'PerspectiveProjection или ParallelProjection:
Public Sub MatrixTransformation(ByRef M(,) As Single, _
ByVal type_of_projection As Integer, _
ByVal Cx As Single, _
ByVal Cy As Single, ByVal Cz As Single, _
ByVal Fx As Single, ByVal Fy As Single, _
ByVal Fz As Single, ByVal ux As Single, _
ByVal uy As Single, ByVal uz As Single)
Static M1(4, 4) As Single : Static M2(4, 4) As Single
Static M3(4, 4) As Single : Static M4(4, 4) As Single
Static M5(4, 4) As Single : Static M12(4, 4) As Single
Static M34(4, 4) As Single
Static M1234(4, 4) As Single
Dim sin1 As Single : Dim cos1 As Single
Dim sin2 As Single : Dim cos2 As Single
Dim sin3 As Single : Dim cos3 As Single
Dim A As Single : Dim B As Single
Dim C As Single : Dim d1 As Single
Dim d2 As Single : Dim d3 As Single
Dim up1(4) As Single : Dim up2(4) As Single
'Переносим фокус (центр объекта) в начало координат:
MatrixTranslate(M1, -Fx, -Fy, -Fz)
A = Cx - Fx : B = Cy - Fy : C = Cz - Fz
d1 = CSng(Sqrt(A * A + C * C))
If d1 <> 0 Then
sin1 = -A / d1 : cos1 = C / d1
End If
d2 = CSng(Sqrt(A * A + B * B + C * C))
If d2 <> 0 Then
sin2 = B / d2 : cos2 = d1 / d2
End If
'Вращаем объект вокруг оси y, чтобы разместить
'центр проекции в y-z плоскости:
MatrixIdentity(M2)
'Если d1 = 0, тогда центр проекции
'уже находится на оси y и в y-z плоскости:
If d1 <> 0 Then
M2(1, 1) = cos1 : M2(1, 3) = -sin1
M2(3, 1) = sin1 : M2(3, 3) = cos1
End If
'Вращаем вокруг оси x,
'чтобы разместить центр проекции на оси Z.
MatrixIdentity(M3)
'Если d2 = 0, то центр проекции
'находится в начале координат.
'Это делает проекцию невозможной.
If d2 <> 0 Then
M3(2, 2) = cos2 : M3(2, 3) = sin2
M3(3, 2) = -sin2 : M3(3, 3) = cos2
End If
'Вращаем вектор UP:
up1(1) = ux : up1(2) = uy : up1(3) = uz
up1(4) = 1 : MatrixApply(up1, M2, up2)
MatrixApply(up2, M3, up1)
' Rotate around the Z axis to put the UP
' vector in the Y-Z plane.
'Вращаем вокруг оси z, чтобы разместить
'вектор UP в y-z плоскости:
d3 = CSng(Sqrt(up1(1) * up1(1) + _
up1(2) * up1(2)))
MatrixIdentity(M4)
'Если d3 = 0, то вектор UP равен нулю:
If d3 <> 0 Then
sin3 = up1(1) / d3 : cos3 = up1(2) / d3
M4(1, 1) = cos3 : M4(1, 2) = sin3
M4(2, 1) = -sin3 : M4(2, 2) = cos3
End If
'Проецируем:
If type_of_projection = _
PerspectiveProjection And d2 <> 0 Then
MatrixPerspectiveXZ(M5, d2)
Else
MatrixIdentity(M5)
End If
'Комбинируем преобразования:
m3MatMultiply(M12, M1, M2)
m3MatMultiply(M34, M3, M4)
m3MatMultiply(M1234, M12, M34)
If type_of_projection = PerspectiveProjection Then
m3MatMultiplyFull(M, M1234, M5)
Else
m3MatMultiply(M, M1234, M5)
End If
End Sub
'Строим матрицу преобразования (3-D transformation matrix)
'для перспективного проецирования (perspective projection):
'центр проецирования (r, phi, theta),
'фокус (fx, fy, fx),
'вектор от объекта до экрана UP <ux, yx, uz>,
'тип проецирования (type_of_projection):
'PerspectiveProjection:
Public Sub Projection(ByRef M(,) As Single, _
ByVal type_of_projection As Integer, ByVal R As Single, _
ByVal phi As Single, ByVal theta As Single, _
ByVal Fx As Single, ByVal Fy As Single, ByVal Fz As Single, _
ByVal ux As Single, ByVal uy As Single, ByVal uz As Single)
Dim Cx As Single : Dim Cy As Single
Dim Cz As Single : Dim r2 As Single
'Переходим к прямоугольным координатам:
Cy = R * CSng(Sin(phi))
r2 = R * CSng(Cos(phi))
Cx = r2 * CSng(Cos(theta))
Cz = r2 * CSng(Sin(theta))
MatrixTransformation(M, type_of_projection, _
Cx, Cy, Cz, Fx, Fy, Fz, ux, uy, uz)
End Sub
' Строим матрицу преобразования, чтобы получить
'отражение напротив плоскости, проходящей
'через (p1, p2, p3) с вектором нормали <n1, n2, n3>:
Public Sub m3Reflect(ByRef M(,) As Single, _
ByVal p1 As Single, ByVal p2 As Single, _
ByVal p3 As Single, ByVal n1 As Single, _
ByVal n2 As Single, ByVal n3 As Single)
Dim T(4, 4) As Single 'Перенос.
Dim R1(4, 4) As Single 'Вращение 1.
Dim r2(4, 4) As Single 'Вращение 2.
Dim S(4, 4) As Single 'Отражение.
Dim R2i(4, 4) As Single 'Не вращать 2.
Dim R1i(4, 4) As Single 'Не вращать 1.
Dim Ti(4, 4) As Single 'Не переносить.
Dim D As Single : Dim L As Single
Dim M12(4, 4) As Single : Dim M34(4, 4) As Single
Dim M1234(4, 4) As Single
Dim M56(4, 4) As Single : Dim M567(4, 4) As Single
'Переносим плоскость к началу координат:
MatrixTranslate(T, -p1, -p2, -p3)
MatrixTranslate(Ti, p1, p2, p3)
'Вращаем вокруг оси z,
'пока нормаль не будет в y-z плоскости:
MatrixIdentity(R1)
D = CSng(Sqrt(n1 * n1 + n2 * n2))
R1(1, 1) = n2 / D : R1(1, 2) = n1 / D
R1(2, 1) = -R1(1, 2) : R1(2, 2) = R1(1, 1)
MatrixIdentity(R1i)
R1i(1, 1) = R1(1, 1) : R1i(1, 2) = -R1(1, 2)
R1i(2, 1) = -R1(2, 1) : R1i(2, 2) = R1(2, 2)
'Вращаем вокруг оси x, когда нормаль будет по оси y:
MatrixIdentity(r2)
L = CSng(Sqrt(n1 * n1 + n2 * n2 + n3 * n3))
r2(2, 2) = D / L : r2(2, 3) = -n3 / L
r2(3, 2) = -r2(2, 3) : r2(3, 3) = r2(2, 2)
MatrixIdentity(R2i)
R2i(2, 2) = r2(2, 2) : R2i(2, 3) = -r2(2, 3)
R2i(3, 2) = -r2(3, 2) : R2i(3, 3) = r2(3, 3)
'Рисуем отражение объекта перпендикулярно x-z плоскости:
MatrixIdentity(S)
S(2, 2) = -1
'Комбинируем матрицы:
m3MatMultiply(M12, T, R1) : m3MatMultiply(M34, r2, S)
m3MatMultiply(M1234, M12, M34)
m3MatMultiply(M56, R2i, R1i)
m3MatMultiply(M567, M56, Ti)
m3MatMultiply(M, M1234, M567)
End Sub
' Строим матрицу преобразования для поворота на угол theta
'вокруг линии, проходящей через (p1, p2, p3)
'в направлении <d1, d2, d3>.
'Угол theta откладывается против часовой стрелки,
'если мы смотрим вниз в направлении,
'противоположном направлению линии:
Public Sub m3LineRotate(ByRef M(,) As Single, _
ByVal p1 As Single, ByVal p2 As Single, ByVal p3 As Single, _
ByVal d1 As Single, ByVal d2 As Single, ByVal d3 As Single, _
ByVal theta As Single)
Dim T(4, 4) As Single 'Перенос.
Dim R1(4, 4) As Single 'Вращение 1.
Dim r2(4, 4) As Single 'Вращение 2.
Dim Rot3(4, 4) As Single 'Вращение.
Dim R2i(4, 4) As Single 'Стоп вращению 2.
Dim R1i(4, 4) As Single 'Стоп вращению 1.
Dim Ti(4, 4) As Single 'Стоп переносу.
Dim D As Single : Dim L As Single
Dim M12(4, 4) As Single : Dim M34(4, 4) As Single
Dim M1234(4, 4) As Single
Dim M56(4, 4) As Single : Dim M567(4, 4) As Single
'Переносим плоскость к началу координат:
MatrixTranslate(T, -p1, -p2, -p3)
MatrixTranslate(Ti, p1, p2, p3)
'Вращаем вокруг оси z,
'пока линия не окажется в y-z плоскости:
MatrixIdentity(R1)
D = CSng(Sqrt(d1 * d1 + d2 * d2))
R1(1, 1) = d2 / D : R1(1, 2) = d1 / D
R1(2, 1) = -R1(1, 2) : R1(2, 2) = R1(1, 1)
MatrixIdentity(R1i)
R1i(1, 1) = R1(1, 1) : R1i(1, 2) = -R1(1, 2)
R1i(2, 1) = -R1(2, 1) : R1i(2, 2) = R1(2, 2)
'Вращаем вокруг оси x, когда линия будет по оси y:
MatrixIdentity(r2)
L = CSng(Sqrt(d1 * d1 + d2 * d2 + d3 * d3))
r2(2, 2) = D / L : r2(2, 3) = -d3 / L
r2(3, 2) = -r2(2, 3) : r2(3, 3) = r2(2, 2)
MatrixIdentity(R2i)
R2i(2, 2) = r2(2, 2) : R2i(2, 3) = -r2(2, 3)
R2i(3, 2) = -r2(3, 2) : R2i(3, 3) = r2(3, 3)
'Вращаем вокруг линии (оси y):
MatrixYRotate(Rot3, theta)
'Комбинируем матрицы:
m3MatMultiply(M12, T, R1)
m3MatMultiply(M34, r2, Rot3)
m3MatMultiply(M1234, M12, M34)
m3MatMultiply(M56, R2i, R1i)
m3MatMultiply(M567, M56, Ti)
m3MatMultiply(M, M1234, M567)
End Sub
'Строим матрицу преобразования (3-D transformation matrix)
' для переноса на Tx, Ty, Tz:
Public Sub MatrixTranslate(ByRef M(,) As Single, _
ByVal Tx As Single, ByVal Ty As Single, ByVal Tz As Single)
MatrixIdentity(M)
M(4, 1) = Tx : M(4, 2) = Ty : M(4, 3) = Tz
End Sub
'Строим матрицу преобразования (3-D transformation matrix)
'для поворота вокруг оси y (угол - в радианах):
Public Sub MatrixYRotate(ByRef M(,) As Single, _
ByVal theta As Single)
MatrixIdentity(M)
M(1, 1) = CSng(Cos(theta))
M(3, 3) = M(1, 1)
M(3, 1) = CSng(Sin(theta))
M(1, 3) = -M(3, 1)
End Sub
'Применяем матрицу преобразования к точке,
'где матрица не может иметь 0, 0, 0, 1
'в последнем столбце. Нормализуем только
'x и y компоненты результата, чтобы сохранить z информацию:
Public Sub MatrixApplyFull(ByRef V() As Single, _
ByRef M(,) As Single, ByRef Result() As Single)
Dim i As Integer : Dim j As Integer
Dim value As Single
For i = 1 To 4
value = 0
For j = 1 To 4
value = value + V(j) * M(j, i)
Next j
Result(i) = value
Next i
'Повторно нормализуем точку (value = Result(4)):
If value <> 0 Then
Result(1) = Result(1) / value
Result(2) = Result(2) / value
'Не преобразовываем z-составляющую:
Else
'Если значение z больше, чем от центра проекции,
'эта точка будет удалена:
Result(3) = Single.MaxValue
End If
Result(4) = 1
End Sub
'Применяем матрицу преобразования к точке:
Public Sub MatrixApply(ByRef V() As Single, _
ByRef M(,) As Single, ByRef Result() As Single)
Result(1) = V(1) * M(1, 1) + V(2) * M(2, 1) + _
V(3) * M(3, 1) + M(4, 1)
Result(2) = V(1) * M(1, 2) + V(2) * M(2, 2) + _
V(3) * M(3, 2) + M(4, 2)
Result(3) = V(1) * M(1, 3) + V(2) * M(2, 3) + _
V(3) * M(3, 3) + M(4, 3)
Result(4) = 1
End Sub
'Умножаем две матрицы. Матрицы
'не могут содержать 0, 0, 0, 1 в последних столбцах:
Public Sub m3MatMultiplyFull(ByRef Result(,) As Single, _
ByRef A(,) As Single, ByRef B(,) As Single)
Dim i As Integer : Dim j As Integer
Dim k As Integer : Dim value As Single
For i = 1 To 4
For j = 1 To 4
value = 0
For k = 1 To 4
value = value + A(i, k) * B(k, j)
Next k
Result(i, j) = value
Next
Next
End Sub
'Умножаем две матрицы:
Public Sub m3MatMultiply(ByRef Result(,) As Single, _
ByRef A(,) As Single, ByRef B(,) As Single)
Result(1, 1) = A(1, 1) * B(1, 1) + A(1, 2) * B(2, 1) _
+ A(1, 3) * B(3, 1)
Result(1, 2) = A(1, 1) * B(1, 2) + A(1, 2) * B(2, 2) _
+ A(1, 3) * B(3, 2)
Result(1, 3) = A(1, 1) * B(1, 3) + A(1, 2) * B(2, 3) _
+ A(1, 3) * B(3, 3)
Result(1, 4) = 0
Result(2, 1) = A(2, 1) * B(1, 1) + A(2, 2) * B(2, 1) _
+ A(2, 3) * B(3, 1)
Result(2, 2) = A(2, 1) * B(1, 2) + A(2, 2) * B(2, 2) _
+ A(2, 3) * B(3, 2)
Result(2, 3) = A(2, 1) * B(1, 3) + A(2, 2) * B(2, 3) _
+ A(2, 3) * B(3, 3)
Result(2, 4) = 0
Result(3, 1) = A(3, 1) * B(1, 1) + A(3, 2) * B(2, 1) _
+ A(3, 3) * B(3, 1)
Result(3, 2) = A(3, 1) * B(1, 2) + A(3, 2) * B(2, 2) _
+ A(3, 3) * B(3, 2)
Result(3, 3) = A(3, 1) * B(1, 3) + A(3, 2) * B(2, 3) _
+ A(3, 3) * B(3, 3)
Result(3, 4) = 0
Result(4, 1) = A(4, 1) * B(1, 1) + A(4, 2) * B(2, 1) _
+ A(4, 3) * B(3, 1) + B(4, 1)
Result(4, 2) = A(4, 1) * B(1, 2) + A(4, 2) * B(2, 2) _
+ A(4, 3) * B(3, 2) + B(4, 2)
Result(4, 3) = A(4, 1) * B(1, 3) + A(4, 2) * B(2, 3) _
+ A(4, 3) * B(3, 3) + B(4, 3)
Result(4, 4) = 1
End Sub
Листинг 34.4. Метод для печати изображения с элемента PictureBox.
Private Sub PrintDocument1_PrintPage( _
ByVal sender As System.Object, _
ByVal e As System.Drawing.Printing.PrintPageEventArgs) _
Handles PrintDocument1.PrintPage
e.Graphics.DrawImage(PictureBox1.Image, 0, 0)
End Sub
