Практика

В данном приложении строится поверхность по введенным в диалоговое окно построение поверхности (рис. У8.1) начальным, конечным значениям аргументов и их шагах изменения. Уравнение поверхности также вводится в программу из диалогового окна. Уравнение должно быть составлено в соответствии с правилами, по которым строятся функции рабочего листа, но в качестве аргументов в нем следует использовать х и у вместо ссылок на ячейки. Программа сама переведет эти аргументы в ссылки на ячейки. После табуляции введенной функции программой и построения поверхности на рабочем листе (рис. У8.2), эта поверхность также отображается в объекте управления image, расположенном в диалоговом окне построение поверхности (рис. У8.3). Управляя полосами прокрутки можно изменить ориентацию поверхности на рабочем листе.

Рис. У8.1. Диалоговое окно Построение поверхности

Рис. У8.2. Результат построения поверхности на рабочем листе

Рис. У8.3. Диалоговое окно Построение поверхности с рисунком построенной поверхности

Обсудим, как приведенная ниже программа решает описанную задачу и что происходит в ней.

	UserForm_Initialize		Активизирует диалоговое окно. Назначает клавише <Esc> функцию кнопки Отмена, а клавише <Enter> — Построение. Устанавливает максимальные и минимальные допустимые значения для полос прокрутки, а также их первоначальные значения. Устанавливает, чтобы отображаемая картинка поверхности в диалоговом окне помещалась целиком и пропорционально в пределах элемента управления Image, а также чтобы левый верхний угол рисунка совпадал с левым верхним углом элемента управления Image.
	Нажатие кнопки Построение запускает на выполнение процедуру CornmandButton1_Click		Проверяет, являются ли вводимые данные числами. В случае ошибки отображается соответствующее сообщение. Проверяет согласованность вводимых данных. В случае ошибки отображается соответствующее сообщение (рис. У8.4). Преобразует формулу, введенную в поле Уравнение поверхности, в формулу рабочего листа. Проверяет корректность введенной формулы. В случае ошибки отображается соответствующее сообщение (рис. У8.5). Используя метод DataSeriea, начиная с ячейки А2 строит вниз по столбцу арифметическую прогрессию, являющуюся результатом табуляции аргумента х уравнения поверхности с указанными шагами. Используя метод Dataseries, начиная с ячейки в 1 строит вправо по строке арифметическую прогрессию, являющуюся результатом табуляции аргумента у уравнения поверхности с указанными шагами. Заносит в ячейку В2 уравнение поверхности, введенное пользователем в диалоговом окне. Для корректности последующего табулирования значений функций важно в уравнении указать абсолютные ссылки на столбец А и строку в. Это обеспечивается вводом в уравнении поверхности вместо аргумента х ссылки $А2, а вместо аргумента у — ссылки в$1. Для табуляции функции протаскивается маркер заполнения ячейки В2, используя метод AutoFill и формулу поверхности, позволяющих распространить табуляцию на весь диапазон, где табулируется функция. Строит поверхности при помощи методаChartWizard. Изменяет ориентацию надписи оси z. и Сохраняет построенную поверхность в файле График-gif. 12. Отображает рисунок из файла График.gif в элементе управления image1.

<


Рис. У8.4. Пример сообщения о несогласованности данных



Рис. У8.5. Сообщение о некорректном вводе формулы

	Нажатие кнопки отмена запускает на выполнение процедуру CommandButton2 Click	Закрывает диалоговое окно.
	ScrollBarl Change	Перемещение ползунка горизонтальной полоски прокрутки вызывает вращение вокруг оси Z диаграммы за счет изменения величины свойства Rotation.
	ScrollBar2 Change	Перемещение ползунка вертикальной полоски прокрутки вызывает изменение угла, под которым смотрят на диаграмму, за счет изменения величины свойства Elevation.
	ВращениеГрафика	Программирует вращение поверхности за счет изменения свойств Rotation и Elevation.

'

' Описание переменных уровня модуля

'

Dim УголЗрения as Integer

Dim ВокругОси2 as Integer

Dim УголЗренияСоСчетчика as Integer

'

' УголЗренияСоСчетчика - величина, снимаемая с полосы прокрутки

' и определяющая угол зрения под которым смотрят на поверхность

' УголЗрения - угол зрения, под которым смотрят на поверхность,

' он равен УголЗренияСоСчетчика - 90 и лежит в

'диапазоне от -90 до 90

' ВокругОсиЕ - угол поворота вокруг оси z, лежит в

' диапазоне от 0 до 360

'

Private Sub CommandButtonl_Click()

'

' Процедура табуляции функции

' и построения поверхности

'

Dim х_нз As Double

Dim х_пз As Double

Dim х_шаг As Double

Dim у_нз As Double

Dim у_пз As Double

Dim у_шаг As Double

Dim УрПоверхности As String

'

' Переменная х:

' х_нз - начальное значение

' х_пз - предельное значение

' х_шаг - шаг изменения

' Переменная у:

' у_нз - начальное значение

' у_пз - предельное значение

' у_шаг - шаг изменения

' УрПоверхности - уравнение поверхности

'

Dim nx As Integer

Dim ny As Integer

'

' nx - число протабулированных значений аргумента х

' ny - число протабулированных значений аргумента у

'

Dim n As Integer

Dim i As Integer

'

' n ,i - вспомогательные целые переменные

Dim ПоляВвода(1 То 6) As Object

'

' Массив полей ввода



'

Set ПоляВвода(1) = TextBoxl

Set ПоляВвода(2) = TextBox2

Set ПоляВвода(3) = TextBox3

Set ПоляВвода(4) = TextBox4

Set ПоляВвода(5) = TextBox5

Set ПоляВвода(6) = TextBox6

'

' Проверка корректности ввода данных

'

For i = 1 To 6

If IsNumeric(ПоляВвода(i).Text) = False Then Select Case i

Case 1

MsgBox "Ошибка в начальном значении х", vblnformation, "Поверхность"

TextBox1.SetFocus

Exit Sub

Case 2

MsgBox "Ошибка в начальном значении у", vblnformation, "Поверхность"

TextBox2.SetFocus

Exit Sub

Case 3

MsgBox "Ошибка в шаге х", vblnformation, "Поверхность"

TextBox3.SetFocus

Exit Sub

Case 4

MsgBox "Ошибка в шаге у", vblnformation, "Поверхность"

TextBox4.SetFocus

Exit Sub

Case 5

MsgBox "Ошибка в конечном значении х", vblnformation, "Поверхность"

TextBox5.SetFocus

Exit Sub

Case 6

MsgBox "Ошибка в конечном значении у", vblnformation, "Поверхность"

TextBox6.SetFocus

Exit Sub

End Select

End If

Next i

'

' Считывание с диалогового окна

' значений переменных

'

х_нз = CDbl(TextBoxl.Text)

у_нз = CDbl(TextBox2.Text)

х__шаг = CDbl (TextBox3.Text)

у_шаг = CDbl(TextBox4.Text)

х_пз = CDbl(TextBox5.Text)

у_пз = CDbl(TextBox6.Text)

УрПоверхности = Trim(TextBoxV.Text)

'

' Проверка согласованности введенных данных

'

If х_нз >= х_пз Then

MsgBox "Начальное значение х слишком большое", vblnformation, "Поверхность"

TextBoxl.SetFocus

Exit Sub

End If

If х_нз + х_шаг >= х_пз Then

MsgBox "Шаг х великоват", vblnformation, "Поверхность"

TextBox3.SetFocus

Exit Sub

End If

If у_нз >= у_пз Then

MsgBox "Начальное значение у слишком большое", vblnformation, "Поверхность"

TextBox2.SetFocus

Exit Sub

End If

If у_нз + у_шаг >= у_пз Then

MsgBox "Шаг у великоват", vblnformation, "Поверхность"

TextBox4.SetFocus



Exit Sub

End If

'

'

' Переход на отладчик ошибок в случае их возникновения On Error GoTo Сообщение

' Замена в введенной формуле аргумента х на ссылку $А2,

' а аргумента у на ссылку В$1

'

i=1

Do

'

' Замена в введенной формуле аргумента х на ссылку $А2

'

If Mid(УрПоверхности, i, 1) = "х" Or Mid(УрПоверхности, i, 1) = "X" Then

n = Len(УрПоверхности)

If (1 < i) And (i < n) Then

УрПоверхности = Left(УрПоверхности, i - 1) & "$A2" & Right(УрПоверхности, n - i)

End If

If i = 1 Then УрПоверхности = "$A2" & Right(УрПоверхности, n - 1)

If i = n Then УрПоверхности = Left(УрПоверхности, n - 1) & "$A2"

End If

' Замена в введенной формуле аргумента у на ссылку В$1

If Mid(УрПоверхности, i, 1) = "y" Or Mid(УрПоверхности, i, 1) = "Y" Then n = Len(УрПоверхности)

If (1 < i) And (i < n) Then

УрПоверхности = Left(УрПоверхности, i - 1) & "B$l" & Right(УрПоверхности, n - i)

End If

If i = 1 Then УрПоверхности = "B$l" & Right(УрПоверхности, n - 1)

If i = n Then УрПоверхности = Left(УрПоверхности, n - 1) & "B$l"

End If

i = i + 1

Loop While i <= Len(УрПоверхности)

'

' Очистка на активном листе ранее введенных данных

'

ActiveSheet.Cells.Select Selection.Clear

' Заполнение диапазонов значениями аргументов

'

With ActiveSheet

'

' Ввод в ячейку А2 начального значения

'

.Range("A2").Value = х_нз

'

' Создание арифметической прогрессии по столбцу

' с указанными шагом и начальным значением

'

.Range("A2").DataSeries Rowcol:=xlColuims,

Type:=xlLinear, Step:=x__iuar, Stop:=x_ns, Trend:=False

'

' Ввод в ячейку В1 начального значения

'

.Range("Bl").Value = у_нз

'

' Создание арифметической прогрессии вдоль строки

' с указанными шагом и начальным значением

'

.Range("Bl").DataSeries Rowcol:=xlRows,

Type:=xlLinear, Step:=y_iuar, Stop:=y_ns, Trend:=Faise



End With

' Заполнение диапазона значениями функции

'

With ActiveSheet

'

' Определение числа строк в диапазоне заполнения

'

nx = .Range("A1").CurrentRegion.Rows.Count

'

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

ny = .Range("Al").CurrentRegion.Columns.Count

'

' Ввод уравнения поверхности в ячейку В2

'

.Range("В2").Formula = УрПоверхности

If IsError(Evaluate(УрПоверхности)) = True Then

MsgBox "Ошибка в формуле", vbExclamation, "Поверхность"

Exit Sub

End If

'

' Заполнение диапазона Range(Cells(2, 2), Cells(2, ny))

' начиная с ячейки В2, что эквивалентно протаскиванию маркера

' заполнения ячейки В2 на диапазон

Range(Cells(2, 2), Cells(2, ny))

'

.Range("B2").AutoFill

Destination:=Range(Cells(2, 2), Cells(2, ny)),

Type:=xlFillDefault

' Заполнение диапазона

Range(Cells(2, 2), Cells(nx, ny)),

' начиная с диапазона

Range(Cells(2, 2), Cells(2, ny)),

' что эквивалентно протаскиванию маркера

' заполнения диапазона

Range(Cells(2, 2), Cells(2, ny))

' на диапазон

Range(Cells(2, 2), Cells(nx, ny))

'

.Range(Cella(2, 2), Cells(2, ny)).AutoFill

Destination:=Range(Cells(2, 2),

Cells(nx, ny)),

Type:=xlFillDefault

End With

'

' Удаление с рабочего листа всех ранее построенных диаграмм

'

ActiveSheet.ChartObjects.Delete

'

' Выбор диапазона, по которому строится поверхность

ActiveSheet.Range(Cells(2, 2), Cells(nx, ny)).Select

'

' Задание и выбор области на рабочем листе, где

' будет построена поверхность

'

ActiveSheet.ChartObjects.Add(29.25, 19.5, 270.75, 187'.5).Select Application.CutCopyMode = False

' Построение поверхности

ActiveChart.ChartWizard

Source:=Range(Cells (1, 1), Cells(nx, ny) ),

Gallery:=x13DSurface, Format:=1,

PlotBy:=xlColumns,

CategoryLabels:=1,

SeriesLabels:=l,

HasLegend:=False,

Title:="Поверхность",

CategoryTitle:="x",

ValueTitle:="z",

ExtraTitle:="y" ActiveSheet.ChartObjects(1).Activate



ActiveChart.Axes(xlValue)

.AxisTitle.Select With Selection

.HorizontalAlignment = xlCenter

.VerticalAlignment = xlCenter

.Orientation = xlVertical

End With

'

ВращениеГрафика 20, 15

'

' Запись диаграммы в файл и

' загрузка картинки в Imagel

ActiveChart.Export FilterNаmе:="График.gif",

FilterName:="GIF"

UserForml.Image1.Picture = LoadPicture("График.gif") ActiveSheet.Range("Al").Select

'

Exit Sub Сообщение:

MsgBox "Ошибка: " & Err.Description, vbExclamation, "Поверхность"

TextBox7.SetFocus

Exit Sub End Sub

Private Sub CoramandButton2_Click()

'

' Процедура закрытия диалогового окна

UserForml. Hide

End Sub

Private Sub Label7_Click()

End Sub

'

Private Sub ScrollBarl_Change()

' Процедура вращения вокруг оси z

'

'

' Считывание данных с полос прокрутки

'

ВокругОсиZ = ScrollBarl.Value УголЗренияСоСчетчика = ScrollBar2.Value

УголЗрения = УголЗренияСоСчетчика - 90

' Вращение поверхности

'

ВращениеГрафика ВокругОсиг, УголЗрения

End Sub

'

Private Sub ScrollBar2_Change()

' Процедура изменения угла, под которым

' смотрят на диаграмму

' Считывание данных с полос прокрутки

'

ВокругОсиZ = CInt(ScrollBarl.Value)

УголЗренияСоСчетчика = CInt(ScrollBar2.Value)

'

УголЗрения = УголЗренияСоСчетчика - 90

'

' Вращение поверхности ВращениеГрафика ВокругОсиг, УголЗрения

End Sub

'

Sub ВращениеГрафика( ByVal ВокругОсиг, ByVal УголЗрения As Integer)

'

' Процедура вращения поверхности

'

If ActiveSheet.ChartObjects.Count >= 1 Then

ActiveSheet.ChartObjects(I).Activate

With ActiveChart

'

' Угол, под которым смотрят на диаграмму,

' допустимые значения от -90 до 90,

' по умолчанию 15

'

.Elevation = УголЗрения

'

' Вращение вокруг оси z, допустимые значения от 0 до 360,

' по умолчанию 20

'

.Rotation = ВокругОсиг End With

End If

'

End Sub

'

Private Sub UserForm_Initialize()

'

' Процедура инициализации диалогового окна



'

CommandButtonl.Default = True

CoiranandButton2.Cancel = True

ScrollBarl.ControlTipText = "Поворот вокруг оси Z"

ScrollBar2.ControlTipText = "Изменение угла зрения"

' Рисунок масштабируется с учетом относительных размеров так,

' чтобы он помещался в объекте Imagel

'

With Imagel

.PictureAlignment = fmPictureAlignmentTopLeft

.PictureSizeMode = fmPictureSizeModeStretch

End With

'

'

' Установка максимальных и минимальных допустимых значений

' для полос прокрутки, а

' также их первоначальных значений

'

With ScrollBar2

.Min = 0

.Max = 180

.Value = 105

End With

With ScrollBarl

.Min = 0

.Max = 360

.Value =20

End With

UserForml.Show

'

End Sub




Содержание раздела

---

---