Глава 34. Изображение и управление трехмерными объектами в трехмерном пространстве на Visual Basic для интеграции с Visual C# и другими языками

 

Листинг 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