Автор работы: Пользователь скрыл имя, 26 Января 2014 в 14:29, курсовая работа
Цель исследования: изучение и разработка программного обеспечения для моделирования электронно-проекционного метода. В процессе исследования и разработки модели электронно-проекционного метода использовались следующие программные приложения: Visual Basic 2005, DirectX 9.0с SDK, MathCAD 13, 3D Studio Max 6.0. Была разработана программа по моделированию муарового эффекта. Были получены различные муаровые картины. Область применения: данная разработка может быть использована в исследовании муаровых методов, демонстрации муарового эффекта, определения деформаций на различных поверхностях.
Введение 5
1 Муаровый эффект 6
1.1 Природа муарового эффекта 6
1.2 Классификация муаровых методов 7
1.3 Муаровые методы 10
1.4 Математическая модель исследования топологии поверхностей электронно-проекционным муаровым методом 14
2 Выбор аппаратно-программных средств разработки 18
3 Разработка программного обеспечения для моделирования муарового эффекта 19
3.1 Основной алгоритм программы, модулирующий муаровый эффект 19
3.2 Интерфейс программы 22
Заключение 31
Список использованных источников 32
axisZ = amp * Math.Cos(axisX * Math.PI / 50) + amp
End If
Return axisZ ' возращает значение высоты
End Function
'Процедура расчета искажений
Sub Camera(ByVal TResol As Byte, ByVal Mas2D(,) As Byte, ByRef MasCam(,) As Byte, ByVal h As Integer)
Dim maxx As Integer = fWidth(TResol) 'разрешение по X и У
Dim maxy As Integer = fHeight(TResol)
Dim xc As Integer = maxx \ 2 'центр X и Y
Dim yc As Integer = maxy \ 2
Dim ax, ay As Int16 'свободные переменные
Dim x1, y1 As Integer
Dim freevarible, az, thaz As Single
ProgressBar1.Maximum = fHeight(TResol)
'Цикл создания растра, производится сканирование по X и Y
'узнается, где должна находиться эта точка, затем, где она находится
For ay = 0 To maxy - 1
For ax = 0 To maxx - 1
az = Telo(ax - xc, ay - yc)
thaz = h - az
If thaz = 0 Then thaz = -0.000000000000001
x1 = ((ax - xc) * h) / thaz + xc
y1 = ((ay - yc) * h) / thaz + yc
If (x1 < fWidth(0)) And (y1 < fHeight(0)) And (x1 >= 0) And (y1 >= 0) Then
MasCam(ax, ay) = Mas2D(x1, y1)
Else : MasCam(ax, ay) = 0
End If
Next
ProgressBar1.Value = ay
Next
ProgressBar1.Value = 0
End Sub
'Процедура сохранения двух мерного массива Mas2D в файл с именем FName
Sub SaveToFile(ByVal TResol As Byte, ByVal Mas2D(,) As Byte, ByVal FName As String)
Dim FSize As Int32 = fWidth(TResol) * fHeight(TResol) * (bitperpix / 8) + Off
' размер файла
Dim BitCount As Int16 = bitperpix ' количество бит на цвет
Dim fs As IO.FileStream = New IO.FileStream(FName, IO.FileMode.Create)
' создание файла
Dim w As IO.BinaryWriter = New IO.BinaryWriter(fs)
' открытие файла на запись
'Запись заголовка
w.Write(FType) 'Тип файла
w.Write(FSize) 'Размер
w.Write(Rez)
w.Write(Rez)
w.Write(Off) 'Смещение
w.Write(HSize) 'Размер заголовка
w.Write(fWidth(TResol)) 'Расширение по X
w.Write(fHeight(TResol)) ' по Y
w.Write(planes) ' число битовых плоскостей
w.Write(BitCount) 'число битов на пиксель
w.Write(Compr) 'способ упаковки 0 - отсутствует
w.Write(ISize) 'размер изображения
w.Write(XpM) 'количества точек на метр
w.Write(YpM) 'количества точек на метр
w.Write(CUsed) 'количества цветов использовано
w.Write(CImp) 'количества цветов нужно
' Запись данных из массива в файл
Dim ax, ay As Int16
Dim i As Integer
ProgressBar1.Maximum = fHeight(TResol)
For ay = fHeight(TResol) - 1 To 0 Step -1
For ax = 0 To fWidth(TResol) - 1
w.Write(Mas2D(ax, ay)) 'R
w.Write(Mas2D(ax, ay)) 'G
w.Write(Mas2D(ax, ay)) 'B
Next
ProgressBar1.Value = ay
Next
ProgressBar1.Value = 0
w.Close() ' закрытие файла.
fs.Close()
End Sub
' Процедура загрузки данных из BMP файла в массив.
Sub LoadFromFile(ByVal TResol As Byte, ByVal FName As String, ByRef MasOut(,) As Byte)
Dim fs As IO.FileStream = New IO.FileStream(FName, IO.FileMode.Open)
' открытие файла
Dim r As IO.BinaryReader = New IO.BinaryReader(fs)
' установка на чтение
r.BaseStream.Seek(&HA, IO.SeekOrigin.Begin)
Dim beginData As Int32
beginData = r.ReadInt32() ' чтение где начало данных
r.BaseStream.Seek(&H12, IO.SeekOrigin.Begin)
Dim MaxX, MaxY As Int32
MaxX = r.ReadInt32() ' чтение разрешение по X
MaxY = r.ReadInt32() ' по Y
r.BaseStream.Seek(&H1C, IO.SeekOrigin.Begin)
Dim BperP As Byte
BperP = r.ReadByte ' чтение количество bit на точку
Dim MasTemp(MaxX, MaxY) As Byte 'Создание временного массива
ClearMas(0, MasTemp) ' очистка массива
Dim b1, b2, b3, b4 As Integer
r.BaseStream.Seek(beginData, IO.SeekOrigin.Begin) ' переход на начало данных
'Чтение данных в массив
Dim x, y As Integer
For y = MaxY - 1 To 0 Step -1
For x = 0 To MaxX - 1
b1 = r.ReadByte
If BperP >= 16 Then b2 = r.ReadByte
If BperP >= 24 Then b3 = r.ReadByte
If BperP >= 32 Then b4 = r.ReadByte
MasTemp(x, y) = b1
Next
Next
' первичная обработка данных
Dim lx, ly As Integer
lx = (MaxX - fWidth(TResol)) \ 2
ly = (MaxY - fHeight(TResol)) \ 2
For x = 0 To fWidth(TResol) - 1
For y = 0 To fHeight(TResol) - 1
MasOut(x, y) = MasTemp(lx + x, ly + y)
Next
Next
r.Close() ' закрытие файла
fs.Close()
End Sub
'Процеду выделения центров линий
Sub CenterLine(ByVal TResol As Byte, ByVal MasIn(,) As Byte, ByRef MasOut(,) As Byte, ByVal Alpha As Integer)
Dim ax, ay As Int16
Dim i As Integer
Dim ly As Integer
Dim Line As Boolean
Dim notdel As Boolean
Dim t As Integer
'Обнуление массива
For ax = 0 To fWidth(TResol) - 1
For ay = 0 To fHeight(TResol) - 1
MasOut(ax, ay) = 0
Next
Next
' Если угол меньше 45 градусов то сканировать по Y
If Alpha <= 45 Then
For ax = 0 To fWidth(TResol) - 1
Line = False
ly = 0
For ay = 0 To fHeight(TResol) - 1
If (MasIn(ax, ay) >= 200) And (Line = False) Then ' =1
Line = True
ly = ay
ElseIf (MasIn(ax, ay) <= 100) And (Line = True) Then '=0
MasOut(ax, (ly + ay) \ 2) = &HFF
Line = False
ly = ay
End If
Next
Next
Else
' Если угол больше 45 градусов то сканировать по X
For ay = 0 To fHeight(TResol) - 1
Line = False
ly = 0
For ax = 0 To fWidth(TResol) - 1
If (MasIn(ax, ay) >= 200) And (Line = False) Then ' =1
Line = True
ly = ay
ElseIf (MasIn(ax, ay) <= 100) And (Line = True) Then '=0
MasOut(ax, (ly + ay) \ 2) = &HFF
Line = False
ly = ay
End If
Next
Next
End If
End Sub
'Процедура очистки массива
Sub ClearMas(ByVal TResol As Integer, ByRef Mas(,) As Byte)
Dim ax, ay As Integer
For ax = 0 To fWidth(0) - 1
For ay = 0 To fHeight(0) - 1
MasC(ax, ay) = 0
Next
Next
End Sub
'Процедура создания мнимого растра
Sub CreatMRast()
LStatus.Text = "Создание м-растра"
ClearMas(0, MasM)
CreatLine(0, MasM, NumericUpDownMRS.Value, NumericUpDownMRS.Value - NumericUpDownMRS1.Value, NumericUpDownMRA.Value)
' NumericUpDownMRS.Value ' шаг сетки
' NumericUpDownMRS1.Value ' ширина темных полос
' NumericUpDownMRA.Value ' угол поворота;
LStatus.Text = "Сохранение растра"
SaveToFile(0, MasM, ".\Мнимый растр.bmp")
End Sub
'Процедура получения муара
Sub Myar(ByVal TResol As Integer, ByVal MasIn1(,) As Byte, ByVal MasIn2(,) As Byte, ByRef MasOut(,) As Byte)
Dim ax, ay As Integer
For ax = 0 To fWidth(0) - 1
For ay = 0 To fHeight(0) - 1
If (MasIn1(ax, ay) > MasIn2(ax, ay)) Then
MasOut(ax, ay) = MasIn1(ax, ay)
Else
MasOut(ax, ay) = MasIn2(ax, ay)
End If
Next
Next
End Sub
'Процедура Центры линий рабочей поверхности
Sub Cwline()
ClearMas(0, MasC)
ClearMas(0, Mas3)
LoadFromFile(0, ".\Вид рабочей поверхности.bmp", MasC)
CenterLine(0, MasC, Mas3, NumericUpDown.Value)
SaveToFile(0, Mas3, ".\Центры линий рабочей поверхности.bmp")
End Sub
'Процедура Центры линий мнимой поверхности
Sub Cmline()
ClearMas(0, MasCM)
ClearMas(0, Mas4)
LoadFromFile(0, ".\Вид мнимой поверхности.bmp", MasCM)
CenterLine(0, MasCM, Mas4, Me.NumericUpDownMRA.Value)
SaveToFile(0, Mas4, ".\Центры линий мнимой поверхности.bmp")
End Sub
'Процедура получения муара центров линий
Sub MyarEffectLine()
ClearMas(0, Mas3)
ClearMas(0, Mas4)
ClearMas(0, MasMyarC)
LoadFromFile(0, ".\Центры линий рабочей поверхности.bmp", Mas3)
LoadFromFile(0, ".\Центры линий мнимой поверхности.bmp", Mas4)
Myar(0, Mas3, Mas4, MasMyarC)
SaveToFile(0, MasMyarC, ".\Муаровый эффект центров линий.bmp")
End Sub
'Процедура получения муара
Sub MyarEffect()
ClearMas(0, MasC)
ClearMas(0, MasCM)
ClearMas(0, MasMyar)
LoadFromFile(0, ".\Вид мнимой поверхности.bmp", MasCM)
LoadFromFile(0, ".\Вид рабочей поверхности.bmp", MasC)
Myar(0, MasC, MasCM, MasMyar)
SaveToFile(0, MasMyar, ".\Муаровый эффект.bmp")
End Sub
'Процедура авто создания муаров и поиска центров линий
Public Sub autocreatall()
Cwline()
Cmline()
MyarEffectLine()
MyarEffect()
End Sub
Private Sub Options_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
CB_Res.SelectedIndex = 0
CB_Pov.SelectedIndex = 0
Me.Location = New System.Drawing.Point(10, 0)
Me.TopMost = True
End Sub
Private Sub ButtonBMP(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button12.Click
statW = "CreateBMPbrowser"
End Sub
Private Sub TabControl1_
TabControl1.Refresh()
If CheckBoxAuto.Checked = True Then
If SomeChange = True Then
Button2_Click(sender, e)
CreatMRast()
createcameraviewA = 3
End If
SomeChange = False
End If
refreshwindow = True
End Sub
Private Sub Button10_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button10.Click
LoadFromFile(0, ".\Центры линий рабочей поверхности.bmp", Mas3)
LoadFromFile(0, ".\Центры линий мнимой поверхности.bmp", Mas4)
Dim h, cosf1, cosf2 As Double
Dim fs As IO.FileStream = New IO.FileStream("test", IO.FileMode.Create)
Dim w As IO.TextWriter = New IO.StreamWriter(fs)
Dim ax, ay As Integer
For ax = 0 To fWidth(0) - 1
For ay = 0 To fHeight(0) - 1
If (Mas3(ax, ay) = &HFF) And (Mas4(ax, ay) = &HFF) Then
cosf1 = NumericUpDownPZ.Value / Math.Sqrt(NumericUpDownPZ.
cosf2 = NumericUpDownCH.Value * Math.Cos(NumericUpDownCA.Value * Math.PI
/ 180) / Math.Sqrt(NumericUpDownCH.
h = NumericUpDownWRS.Value() / (Math.Tan(Math.Acos(cosf1)) + Math.Tan(Math.Acos(cosf2)))
w.WriteLine(" X:" + CStr(ax) + " Y:" + CStr(ay) + " H:" + CStr(h))
End If
Next
Next
w.Close()
fs.Close()
End Sub
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
Button2_Click(sender, e)
CreatMRast()
createcameraviewA = 3
LStatus.Text = ""
End Sub
Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
LStatus.Text = "Создание растра"
ClearMas(0, Mas)
CreatLine(0, Mas, NumericUpDownWRS.Value, NumericUpDownWRS.Value - NumericUpDownWRS1.Value, NumericUpDownWRA.Value)
LStatus.Text = "Сохранение растра"
SaveToFile(0, Mas, ".\Рабочий растр.bmp")
LStatus.Text = "Сохранение растра2"
ClearMas(0, Mas2)
Camera(0, Mas, Mas2, NumericUpDownPZ.Value * fWidth(0) / 16)
SaveToFile(0, Mas2, ".\Искажения рабочего растра.bmp")
NewRast = True
LStatus.Text = "Наложение растра"
refreshwindow = True
End Sub
Private Sub Button3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button3.Click
createcameraview = True
refreshwindow = True
End Sub
Private Sub Button4_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button4.Click
CreatMRast()
createcameraview = True
createcameraviewM = True
MRast = True
LStatus.Text = "Наложение растра"
refreshwindow = True
LStatus.Text = ""
End Sub
Private Sub Button5_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button5.Click
Cwline()
End Sub
Private Sub Button6_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button6.Click
Cmline()
End Sub
Private Sub Button7_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button7.Click
MyarEffectLine()
End Sub
Private Sub Button8_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button8.Click
MyarEffect()
End Sub
Protected Overrides Sub Finalize() 'Процедура завершения
MyBase.Finalize()
End Sub
Private Sub NumericUpDownWRS_ValueChanged(
SomeChange = True
NumericUpDownWRS1.Value = NumericUpDownWRS.Value \ 2
End Sub
Private Sub NumericUpDownPZ_ValueChanged(B
SomeChange = True
TrackBarPZ.Value = NumericUpDownPZ.Value
refreshwindow = True
End Sub
Private Sub TrackBarPZ_Scroll(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TrackBarPZ.Scroll
SomeChange = True
NumericUpDownPZ.Value = TrackBarPZ.Value
refreshwindow = True
End Sub
Private Sub TrackBarCX_Scroll(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TrackBarCX.Scroll
SomeChange = True
NumericUpDownCX.Value = TrackBarCX.Value
If CheckBox1.Checked Then
createcameraview = True
End If
refreshwindow = True
End Sub
Private Sub NumericUpDownCX_ValueChanged(B
SomeChange = True
TrackBarCX.Value = NumericUpDownCX.Value
NumericUpDownCH.Value = Math.Sqrt(NumericUpDownCX.
NumericUpDownCA.Value = Math.Acos(NumericUpDownCZ.
If CheckBox1.Checked Then
createcameraview = True
End If
refreshwindow = True
End Sub
Private Sub TrackBarCY_Scroll(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TrackBarCY.Scroll
SomeChange = True
NumericUpDownCY.Value = TrackBarCY.Value
If CheckBox1.Checked Then
createcameraview = True
End If
refreshwindow = True
End Sub
Private Sub NumericUpDownCY_ValueChanged(B
SomeChange = True
TrackBarCY.Value = NumericUpDownCY.Value
NumericUpDownCH.Value = Math.Sqrt(NumericUpDownCX.
NumericUpDownCA.Value = Math.Acos(NumericUpDownCZ.
Информация о работе Разработка программы, моделирующая муаровый эффект