Расчет и изображение линий уровня поверхности на Visual Basic для интеграции с Visual C#, Visual C++ и другими языками

 

Листинг 41.1. Код выше и в теле процедуры Form1_Load.

'Вводим функцию для поверхности z = f = f(x, y):

Private Function f(ByVal x As Single, ByVal y As Single) _

As Single

f = 2 * x * x * x * x - 3 * x * x + 4 * y * y

End Function

'Вводим функцию для частной производной df/dx:

Private Function df_dx(ByVal x As Single, _

ByVal y As Single) As Single

df_dx = 8 * x * x * x - 6 * x

End Function

'Вводим функцию для частной производной df/dy:

Private Function df_dy(ByVal x As Single, _

ByVal y As Single) As Single

df_dy = 8 * y

End Function

'Задаем перо для рисования линий уровня:

Private myPen As Pen

'Загружаем функции для рисования линий уровня:

Private Sub Form1_Load(ByVal sender As System.Object, _

ByVal e As EventArgs) Handles MyBase.Load

'Задаем цвет пера:

myPen = New Pen(Color.Black, 0)

'Связываем графический элемент PictureBox1

'с объектом g класса Graphics:

Dim bmp As New Bitmap(PictureBox1.ClientSize.Width, _

PictureBox1.ClientSize.Height)

Dim g As Graphics = Graphics.FromImage(bmp)

'Определяем преобразования для масштабирования и

'рисования линий на PictureBox1 в интервале

'-1.5 <= x <= 1.5, -1.5 <= y <= 1.5:

Const x_min As Single = -1.5

Const x_max As Single = 1.5

Const y_min As Single = -1.5

Const y_max As Single = 1.5

g.ScaleTransform(bmp.Width / (x_max - x_min), _

bmp.Height / (y_max - y_min))

g.TranslateTransform(-x_min, -y_min, _

System.Drawing.Drawing2D.MatrixOrder.Prepend)

'Вызываем функцию для рисования линий уровня:

For LevelCurves As Integer = -3 To 10

PlotLevelCurve(g, CSng( _

LevelCurves / 4), -4, 4, -4, 4, 0.05, 1, 1, 0.002)

Next

'Показываем результат рисования:

PictureBox1.Image = bmp

End Sub

Ниже этого кода записываем следующие вспомогательные процедуры.

Листинг 41.2. Вспомогательные процедуры.

'Находим точку на линии:

Private Sub FindPointOnCurve(ByRef x As Single, _

ByRef y As Single, ByVal LevelCurves As Single, _

Optional ByVal start_x As Single = 0.1, _

Optional ByVal start_y As Single = 0.2, _

Optional ByVal tolerance As Single = 0.01, _

Optional ByVal initial_delta As Single = 0.1)

Dim dx As Single : Dim dy As Single

Dim dz As Single : Dim dist As Single

Dim delta As Single : Dim f_xy As Single

Dim direction As Integer

'Начальная точка:

x = start_x : y = start_y : delta = initial_delta

'Повторяем решение:

Do

f_xy = f(x, y) : dz = LevelCurves - f_xy

If Abs(dz) < tolerance Then Exit Do

'Анализируем направление:

If Sign(dz) <> direction Then

'Изменяем направление. Уменьшаем delta:

delta = delta / 2 : direction = Sign(dz)

End If

'Рассчитываем градиент:

Gradient(x, y, dx, dy)

If Abs(dx) + Abs(dy) < 0.001 Then Exit Do

'Перемещаемся направо:

x = x + dx * delta * direction

y = y + dy * delta * direction

Loop

End Sub

'Рассчитываем градиент в этой точке:

Private Sub Gradient(ByVal x As Single, _

ByVal y As Single, ByRef dx As Single, ByRef dy As Single)

Dim dist As Single

dx = df_dx(x, y) : dy = df_dy(x, y)

dist = CSng(Sqrt(dx * dx + dy * dy))

If Abs(dist) < 0.0001 Then

dx = 0 : dy = 0

Else

dx = dx / dist : dy = dy / dist

End If

End Sub

'Программируем второй массив для передачи в файл:

'Задаем границы индексов второго массива myArrayVB_2(i, j):

Dim N_x_2 As Integer = 20000

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(20000, 1) As Single 'Автомат-ки обнуляется.

'Значение первой границы массива myArrayVB_2:

Dim N_1_myArrayVB_2 As Integer

'Счетчик элементов массива:

Dim ii As Integer = -1

'Рисуем линию уровня f(x, y) = LevelCurves:

Private Sub PlotLevelCurve(ByVal g As Graphics, _

ByVal LevelCurves As Single, ByVal x_min As Single, _

ByVal x_max As Single, ByVal y_min As Single, _

ByVal y_max As Single, _

Optional ByVal step_size As Single = 0.1, _

Optional ByVal start_x As Single = 1.0, _

Optional ByVal start_y As Single = 1.0, _

Optional ByVal tolerance As Single = 0.02)

'Объявляем индексы элементов всех массивов:

Dim i, j As Integer

'Программируем 1-й массив для рисования здесь.

'Задаем границы индексов 1-го массива myArrayVB(i, j):

Dim N_x As Integer = 2000

Dim N_y As Integer = 1

'Объявляем 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

'Объявляем переменные для точек линий уровня:

Dim num_points As Integer

Dim x0 As Single : Dim y0 As Single

Dim x1 As Single : Dim y1 As Single

Dim x2 As Single : Dim y2 As Single

Dim dx As Single : Dim dy As Single

'Находим точку (x0, y0) на линии уровня LevelCurves:

FindPointOnCurve(x0, y0, LevelCurves, _

start_x, start_y, tolerance)

'Начальная точка линии:

num_points = 1

'Следующая линия уровня LevelCurves:

x2 = x0

y2 = y0

i = -1 'Задаем до цикла.

'Начало цикла Do - Loop:

Do

x1 = x2

y1 = y2

'Находим следующую точку на линии:

Gradient(x2, y2, dx, dy)

If Abs(dx) + Abs(dy) < 0.001 Then Exit Do

x2 = x2 + dy * step_size

y2 = y2 - dx * step_size

FindPointOnCurve(x2, y2, LevelCurves, x2, y2, _

tolerance)

'Можно рисовать и здесь (без массива) до этой точки:

'g.DrawLine(myPen, x1, y1, x2, y2)

'Записываем коорд-ты точек в 1-й массив для текущей

'линии уровня, которую будем рисовать здесь:

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 'Значение границы массива.

'Записываем координаты точек текущей линии

'во 2-й массив, который будем экспортировать в файл:

ii = ii + 2

myArrayVB_2(ii, 0) = x1

myArrayVB_2(ii, 1) = y1

myArrayVB_2(ii + 1, 0) = x2

myArrayVB_2(ii + 1, 1) = y2

N_1_myArrayVB_2 = ii + 1 'Значение границы массива.

'Задаем следующую точку:

num_points = num_points + 1

'Смотрим,находится ли точка вне области рисования:

If x2 < x_min Or x2 > x_max Or _

y2 < y_min Or y2 > y_max _

Then Exit Do

'Если мы ушли более чем на 4 точки, то смотрим

'не пришли ли мы в начало:

If num_points >= 4 Then

If Sqrt((x0 - x2) * (x0 - x2) + (y0 - y2) _

* (y0 - y2)) <= step_size * 1.1 Then

'Можно рисовать и здесь (без массива):

'g.DrawLine(myPen, x2, y2, x0, y0)

'Записываем координаты точек в 1-й массив:

i = i + 2

myArrayVB(i, 0) = x2

myArrayVB(i, 1) = y2

myArrayVB(i + 1, 0) = x0

myArrayVB(i + 1, 1) = y0

N_1_myArrayVB = i + 1 'Граница массива.

'Записываем координаты точек во 2-й массив,

'который будем экспортировать в файл:

ii = ii + 2

myArrayVB_2(ii, 0) = x2

myArrayVB_2(ii, 1) = y2

myArrayVB_2(ii + 1, 0) = x0

myArrayVB_2(ii + 1, 1) = y0

N_1_myArrayVB_2 = ii + 1 'Граница массива.

Exit Do

End If

End If

Loop 'Переход в начало цикла Do - Loop.

'Начало N_first_line и конец N_last_line цикла

'при рисовании здесь из массива myArrayVB:

Dim N_first_line, N_last_line As Integer

N_first_line = 1

N_last_line = N_1_myArrayVB

'Передаем значения начала 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(2000, 1):

Dim k As Integer

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(myPen, x1, y1, x2, y2)

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 = 1

N_last_line_2 = N_1_myArrayVB_2

'Передаем значения начала 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(20000, 1) в файл.

'Создаем объект sw класса StreamWriter

'для записи в файл D:\MyDocs\MyTest_LevelCurves.txt.

'Файл автоматически "опустошается":

Dim sw As StreamWriter = _

New StreamWriter("D:\MyDocs\MyTest_LevelCurves.txt")

'Каждый элемент массива myArrayVB_2(i, j) запис-м в файл

'в виде отдельной строки при помощи процедуры WriteLine:

For i = 0 To N_x_2

For j = 0 To N_y_2

sw.WriteLine(myArrayVB_2(i, j))

Next

Next

sw.Close()

End Sub

Аналогично можно записать массивы с координатами точек для нескольких геометрических изображений в несколько различных файлов на жестком диске компьютера.

Предлагаю ознакомиться с аналогичными статьями: