Разработка программы, моделирующей муаровый эффект

SomeChange = True

End Sub

Private Sub CB_Pov_SelectedIndexChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles CB_Pov.SelectedIndexChanged

SomeChange = True

Face = CB_Pov.SelectedIndex

If (Face = 6) And (Resel) Then

OFD.ShowDialog()

Dim FName As String = OFD.FileName

If (FName = "") Then

Face = 0

CB_Pov.SelectedIndex = 0

Return

End If

Dim fs As IO.FileStream = New IO.FileStream(FName, IO.FileMode.Open)

'создание(файла)

Dim r As IO.BinaryReader = New IO.BinaryReader(fs)

'открытие файла на запись

SurSize.X = r.ReadInt32()

SurSize.Y = r.ReadInt32()

Dim ix, iy As Integer

For iy = 0 To SurSize.Y

For ix = 0 To SurSize.X

UserSur(ix, iy) = r.ReadInt32()

Next

Next

r.Close() закрытие файла.

fs.Close()

LProba.Text = Path.GetFileNameWithoutExtension(FName)

OFD.FileName = ""

End If

If (Face = 7) Then

LSyn.Visible = True

NUDSyn.Visible = True

Else

LSyn.Visible = False

NUDSyn.Visible = False

End If

End Sub

Private Sub CB_Res_SelectedIndexChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles CB_Res.SelectedIndexChanged

SomeChange = True

fWidth(0) = fWidth(CB_Res.SelectedIndex + 1)

fHeight(0) = fHeight(CB_Res.SelectedIndex + 1)

NewResolution = True

refreshwindow = True

End Sub

Private Sub NumericUpDownMRS_ValueChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles NumericUpDownMRS.ValueChanged

SomeChange = True

NumericUpDownMRS1.Value = NumericUpDownMRS.Value \ 2

End Sub

Private Sub OpenFileDialog1_FileOk(ByVal sender As System.Object, ByVal e As System.ComponentModel.CancelEventArgs) Handles OFD.FileOk

End Sub

Private Sub BCreate_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BCreate.Click

Randomize()

Dim FName As String = TBFileName.Text & ".txt"

Dim MaxH As Integer = NUDH.Value

Dim X As Integer = NUDX.Value

Dim Y As Integer = NUDY.Value

Dim ix, iy As Integer

Dim h As Integer

Dim fs As IO.FileStream = New IO.FileStream(FName, IO.FileMode.Create)

создание файла

Dim w As IO.BinaryWriter = New IO.BinaryWriter(fs)

открытие файла на запись

w.Write(X)

w.Write(Y)

Dim Sur(X, Y) As Integer

If (RBRnd.Checked) Then

For iy = 0 To Y

For ix = 0 To X

Randomize()

Sur(ix, iy) = MaxH * Rnd()

Next

Next

End If

If (RBRndOff.Checked) Then

For iy = 0 To Y

Sur(0, iy) = 0

For ix = 1 To X

Randomize()

h = Sur(ix - 1, iy) + (-1) ^ (CInt(2 * Rnd()))

Sur(ix, iy) = h

If (h < 0) Then Sur(ix, iy) = 0

If (h > MaxH) Then Sur(ix, iy) = MaxH

Next

Next

End If

If (RBRndOff2.Checked) Then

For iy = 0 To Y

Sur(0, iy) = 0

Next

For ix = 1 To X

Randomize()

h = Sur(ix - 1, 0) + (-1) ^ (CInt(2 * Rnd()))

Sur(ix, 0) = h

If (h < 0) Then Sur(ix, 0) = 0

If (h > MaxH) Then Sur(ix, 0) = MaxH

For iy = 1 To Y

Sur(ix, iy) = Sur(ix, 0)

Next

Next

End If

If (RBRndOff3.Checked) Then

Sur(0, 0) = 0

For ix = 1 To X

Randomize()

h = Sur(ix - 1, 0) + (-1) ^ (CInt(2 * Rnd()))

Sur(ix, 0) = h

If (h < 0) Then Sur(ix, 0) = 0

If (h > MaxH) Then Sur(ix, 0) = MaxH

Next

Dim Offs As Integer

For iy = 1 To Y

Randomize()

Offs = (-1) ^ (CInt(2 * Rnd()))

For ix = 0 To X

h = Sur(ix, iy - 1) + Offs

Sur(ix, iy) = h

If (h < 0) Then Sur(ix, iy) = 0

If (h > MaxH) Then Sur(ix, iy) = MaxH

Next

Next

End If

If (RBSyn.Checked) Then

For ix = 0 To X

h = MaxH * Math.Cos((ix - SurSize.X / 2) * Math.PI / 50) + MaxH

Sur(ix, 0) = h

If (h < 0) Then Sur(ix, 0) = 0

For iy = 1 To Y

Sur(ix, iy) = Sur(ix, 0)

Next

Next

End If

If (RBSyn2.Checked) Then

For ix = 0 To X

Sur(ix, 0) = MaxH * Math.Cos((ix - SurSize.X / 2) * Math.PI / 50) + MaxH

Next

Dim Offs As Integer

Dim S0, S1 As Integer

For iy = 1 To Y

S0 = MaxH * Math.Cos((iy - 1) * Math.PI / 50) + MaxH

S1 = MaxH * Math.Cos((iy) * Math.PI / 50) + MaxH

Offs = S1 - S0

For ix = 0 To X

h = Sur(ix, iy - 1) + Offs

Sur(ix, iy) = h

If (h < 0) Then Sur(ix, iy) = 0

Next

Next

End If

For iy = 0 To Y

For ix = 0 To X

w.Write(Sur(ix, iy))

Next

Next

w.Close() закрытие файла.

fs.Close()

End Sub

Private Sub RBRnd_CheckedChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles RBRnd.CheckedChanged

TBFileName.Text = "RunSuf" + Trim(Str(NUDX.Value)) + "_" + Trim(Str(NUDY.Value))

End Sub

Private Sub RBRndOff_CheckedChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles RBRndOff.CheckedChanged

TBFileName.Text = "RunSufOff" + Trim(Str(NUDX.Value)) + "_" + Trim(Str(NUDY.Value))

End Sub

Private Sub RBRndOff2_CheckedChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles RBRndOff2.CheckedChanged

TBFileName.Text = "RunSufOff2_" + Trim(Str(NUDX.Value)) + "_" + Trim(Str(NUDY.Value))

End Sub

Private Sub RBRndOff3_CheckedChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles RBSyn.CheckedChanged

TBFileName.Text = "Syn" + Trim(Str(NUDX.Value)) + "_" + Trim(Str(NUDY.Value))

End Sub

Private Sub NUDX_ValueChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles NUDX.ValueChanged, NUDY.ValueChanged

Dim text As String = "RunSuf"

If (RBRndOff.Checked) Then text = text + "Off"

If (RBRndOff2.Checked) Then text = text + "Off2_"

If (RBRndOff3.Checked) Then text = text + "Off3_"

If (RBSyn.Checked) Then text = "Syn"

If (RBSyn2.Checked) Then text = "Syn2_"

text = text + Trim(Str(NUDX.Value)) + "_" + Trim(Str(NUDY.Value))

TBFileName.Text = text

End Sub

Private Sub RBRndOff3_CheckedChanged_1(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles RBRndOff3.CheckedChanged

TBFileName.Text = "RunSufOff3_" + Trim(Str(NUDX.Value)) + "_" + Trim(Str(NUDY.Value))

End Sub

Private Sub RBSyn2_CheckedChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles RBSyn2.CheckedChanged

TBFileName.Text = "Syn2_" + Trim(Str(NUDX.Value)) + "_" + Trim(Str(NUDY.Value))

End Sub

Private Sub Button9_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button9.Click

Cwline()

Cmline()

MyarEffectLine()

MyarEffect()

End Sub

End Class

Приложение Б

Листинг модуля «Rendering.vb»

Imports System

Imports System.Drawing

Imports System.Windows.Forms

Imports Microsoft.DirectX

Imports Microsoft.DirectX.Direct3D

Imports Direct3D = Microsoft.DirectX.Direct3D

Namespace Myar

Public Class rendering

Inherits Form

'Глобальные переменные для модуля

Private device As Device = Nothing наше 3D устройство

Private vertexBuffer As VertexBuffer = Nothing 'рабочая поверхность

Private vertexBuffer2 As VertexBuffer = Nothing 'стена, пол

Private texture As Texture = Nothing 'рабочая поверхность

Private texturefloor As Texture = Nothing 'стена, пол

Private texturecamera As Texture = Nothing 'текстура камеры

Private textureM As Texture = Nothing 'мнимая поверхность

Private vertexBufferM As VertexBuffer = Nothing 'мнимая поверхность

Private presentParams As New PresentParameters() 'параметры для 3D

Private pause As Boolean = False

Private mx As Integer = 120 'Количество точек по X

Private kol_y As Integer = 90 'Количество точек по Y

Private mx2 As Integer = 6

Private my2 As Integer = 6

Private RA, RC, RB As Single 'Точка обзора

Public mmn As New Options() 'Создаем окно Options

Private nv As Integer

Private coneMesh As Mesh = Nothing Камера

Private cylMesh As Mesh = Nothing Штатив

'Основная процедура при создании окна

Public Sub New()

mmn.Show()

Me.ClientSize = New System.Drawing.Size(400, 300)

Me.Location = New System.Drawing.Point(0, 0)

Me.Text = "3D моделирование"

Me.AutoScaleBaseSize = New System.Drawing.Size(0, 0)

Me.MaximizeBox = False

Me.MinimizeBox = True

Me.TopMost = True

Me.FormBorderStyle = System.Windows.Forms.FormBorderStyle.FixedToolWindow

Me.Location = New System.Drawing.Point(301, 0)

Me.StartPosition = System.Windows.Forms.FormStartPosition.Manual

End Sub

Попытка проинициализировать 3D устройство

Public Function InitializeGraphics() As Boolean

Try

presentParams.BackBufferCount = 1 'Один задний буффер

presentParams.Windowed = True 'В окне

presentParams.SwapEffect = SwapEffect.Discard 'Выключить swap эффект

presentParams.EnableAutoDepthStencil = True

presentParams.AutoDepthStencilFormat = DepthFormat.D16

device = New Device(0, DeviceType.Hardware, Me, CreateFlags.SoftwareVertexProcessing, presentParams)

AddHandler device.DeviceCreated, AddressOf Me.OnCreateDevice

AddHandler device.DeviceReset, AddressOf Me.OnResetDevice

Me.OnCreateDevice(device, Nothing)

Me.OnResetDevice(device, Nothing)

pause = False

Return True

Catch e As DirectXException 'Ошибка при создании!

Return False

End Try

End Function 'InitializeGraphics

'При создании устройства

Public Sub OnCreateDevice(ByVal sender As Object, ByVal e As EventArgs)

Dim dev As Device = CType(sender, Device)

'Создаем вертекс рабочей поверхности

vertexBuffer = New VertexBuffer(GetType(CustomVertex.PositionNormalTextured), 3 * 2 * mx * kol_y, dev, Usage.WriteOnly, CustomVertex.PositionNormalTextured.Format, Pool.Default)

vertexBufferM = New VertexBuffer(GetType(CustomVertex.PositionNormalTextured), 3 * 2 * mx * kol_y, dev, Usage.WriteOnly, CustomVertex.PositionNormalTextured.Format, Pool.Default)

vertexBuffer2 = New VertexBuffer(GetType(CustomVertex.PositionNormalTextured), 3 * 2 * mx2 * my2, dev, Usage.WriteOnly, CustomVertex.PositionNormalTextured.Format, Pool.Default)

'AddHandler vertexBuffer.Created, AddressOf Me.CreateVertexBuffer

mmn.LStatus.Text = "Генерация объекта"

nv = 0

CreateVertexBuffer(vertexBuffer)

'Создаем вертекс стен

mmn.LStatus.Text = "Генерация Объектов"

nv = 1

CreateVertexBuffer(vertexBuffer2)

'Создаем вертекс мнимой поверхности

nv = 0

CreateVertexBuffer(vertexBufferM)

mmn.LStatus.Text = ""

End Sub 'OnCreateDevice

'Настройка 3D устройства

Public Sub OnResetDevice(ByVal sender As Object, ByVal e As EventArgs)

Dim dev As Device = CType(sender, Device)

'отключение обрезаний поверхностей

dev.RenderState.CullMode = Cull.None

Включение света

dev.RenderState.Lighting = True

Включение ZBuffer

dev.RenderState.ZBufferEnable = True

'Настройка источника света

dev.Lights(0).Type = LightType.Point

dev.Lights(0).Position = New Vector3(0, 8, 10)

dev.Lights(0).Direction = New Vector3(0, 0, 0)

dev.Lights(0).Diffuse = System.Drawing.Color.White

dev.Lights(0).Range = 100.0F

dev.Lights(0).Attenuation1 = 0.1F

device.Lights(0).Commit()

dev.Lights(0).Enabled = True

'Включение основного источника

dev.RenderState.Ambient = System.Drawing.Color.FromArgb(&H646464)

coneMesh = Mesh.FromFile(".\1.x", MeshFlags.Managed, device)

cylMesh = Mesh.Cylinder(device, 0.05F, 0.05F, 40, 20, 20)

'Настройка материала

Dim mtrl As Microsoft.DirectX.Direct3D.Material

mtrl.Ambient = System.Drawing.Color.White

mtrl.Diffuse = System.Drawing.Color.White

device.Material = mtrl

Try

texturefloor = TextureLoader.FromFile(device, Application.StartupPath + "\Текстура стен.bmp")

texturecamera = TextureLoader.FromFile(device, Application.StartupPath + "\Текстура объектов.bmp")

Catch

End Try

End Sub 'OnResetDevice

'Функция определения высоты для плоскости

Public Function fZ(ByVal X As Single, ByVal Y As Single) As Single

Dim Z As Single = 0

Dim Dx, Dy As Single

Dx = mmn.fWidth(0) / 16

Dy = mmn.fHeight(0) / 12

Z = -mmn.Telo(X * Dx - Dx * 8, Y * Dy - Dy * 6) / Dx

Return Z

End Function

'Процедура создания вертекса, 3Д-объекта

Public Sub CreateVertexBuffer(ByVal sender As Object)

Dim vb As VertexBuffer = CType(sender, VertexBuffer)

Dim verts As CustomVertex.PositionNormalTextured() = CType(vb.Lock(0, 0), CustomVertex.PositionNormalTextured()) Начать обработку структуры

Dim dX As Single = ((16 + 4 * nv) * (1.0F)) / (mx * (1 - nv) + mx2 * nv)

Dim dY As Single = ((12 + 4 * nv) * (1.0F)) / (kol_y * (1 - nv) + my2 * nv)

Dim k As Integer = 0

Dim x As Integer

mmn.ProgressBar1.Value = 0

mmn.ProgressBar1.Maximum = mx * (1 - nv) + mx2 * nv - 1

For x = 0 To mx * (1 - nv) + mx2 * nv - 1

Dim y As Integer

mmn.ProgressBar1.Value = x

For y = 0 To kol_y * (1 - nv) + my2 * nv - 1

verts(k).X = x * dX

verts(k).Y = y * dY

If nv = 0 Then

verts(k).Z = fZ(verts(k).X, verts(k).Y)

verts(k).Tu = verts(k).X / 16

verts(k).Tv = 1 - verts(k).Y / 12

Else

verts(k).Z = 0

verts(k).Tu = verts(k).X / 20

verts(k).Tv = verts(k).Y / 16

End If

verts(k).SetNormal(New Vector3(0, 0, 1))

k += 1

verts(k).X = x * dX

verts(k).Y = (y + 1) * dY

If nv = 0 Then

verts(k).Z = fZ(verts(k).X, verts(k).Y)

verts(k).Tu = verts(k).X / 16

verts(k).Tv = 1 - verts(k).Y / 12

Else

verts(k).Z = 0

verts(k).Tu = verts(k).X / 20

verts(k).Tv = verts(k).Y / 16

End If

verts(k).SetNormal(New Vector3(0, 0, 1))

k += 1

verts(k).X = (x + 1) * dX

verts(k).Y = (y + 1) * dY

If nv = 0 Then

verts(k).Z = fZ(verts(k).X, verts(k).Y)

verts(k).Tu = verts(k).X / 16

verts(k).Tv = 1 - verts(k).Y / 12

Else

verts(k).Z = 0

verts(k).Tu = verts(k).X / 20

verts(k).Tv = verts(k).Y / 16

End If

verts(k).SetNormal(New Vector3(0, 0, 1))

k += 1

verts(k).X = x * dX

verts(k).Y = y * dY

If nv = 0 Then

verts(k).Z = fZ(verts(k).X, verts(k).Y)

verts(k).Tu = verts(k).X / 16

verts(k).Tv = 1 - verts(k).Y / 12

Else

verts(k).Z = 0

verts(k).Tu = verts(k).X / 20

verts(k).Tv = verts(k).Y / 16

End If

verts(k).SetNormal(New Vector3(0, 0, 1))

k += 1

verts(k).X = (x + 1) * dX

verts(k).Y = (y + 1) * dY

If nv = 0 Then

verts(k).Z = fZ(verts(k).X, verts(k).Y)

verts(k).Tu = verts(k).X / 16

verts(k).Tv = 1 - verts(k).Y / 12

Else

verts(k).Z = 0

verts(k).Tu = verts(k).X / 20

verts(k).Tv = verts(k).Y / 16

End If

verts(k).SetNormal(New Vector3(0, 0, 1))

k += 1

verts(k).X = (x + 1) * dX

verts(k).Y = y * dY

If nv = 0 Then

verts(k).Z = fZ(verts(k).X, verts(k).Y)

verts(k).Tu = verts(k).X / 16

verts(k).Tv = 1 - verts(k).Y / 12

Else

verts(k).Z = 0

verts(k).Tu = verts(k).X / 20

verts(k).Tv = verts(k).Y / 16

End If

verts(k).SetNormal(New Vector3(0, 0, 1))

k += 1

Next

Next

mmn.ProgressBar1.Value = 0

vb.Unlock() 'Закрыть структуру

End Sub 'OnCreateVertexBuffer

'Процедура рендерига 3D сцены, построение самой сцены с необходимыми параметрами

Private Sub Render()

If mmn.NewRast = True Then

nv = 1

CreateVertexBuffer(vertexBuffer2)

nv = 0

CreateVertexBuffer(vertexBuffer)

mmn.NewRast = False

mmn.LStatus.Text = ""

Try

texture = TextureLoader.FromFile(device, Application.StartupPath + "\Искажения рабочего растра.bmp")

Catch

End Try

End If

If mmn.MRast = True Then

mmn.Resel = False

Dim temp As Integer

temp = mmn.CB_Pov.SelectedIndex

mmn.CB_Pov.SelectedIndex = 0

nv = 0

CreateVertexBuffer(vertexBufferM)

textureM = TextureLoader.FromFile(device, Application.StartupPath + "\Мнимый растр.bmp")

mmn.CB_Pov.SelectedIndex = temp

mmn.Resel = True

End If

If device Is Nothing Then

Return

End If

If (pause = True) Or (mmn.refreshwindow = False) Then

Return

End If

mmn.refreshwindow = False

device.Clear(ClearFlags.Target Or ClearFlags.ZBuffer, Color.Blue, 1.0F, 0)

device.BeginScene() 'Начало сцены

device.VertexFormat = CustomVertex.PositionNormalTextured.Format

SetupMatrices() 'Настройка камеры

device.SetTexture(0, texturefloor)

device.SetStreamSource(0, vertexBuffer2, 0)

device.Transform.World2 = Matrix.Multiply(Matrix.RotationY(0), Matrix.Translation(-10, 0, 0))

device.Transform.World = Matrix.Multiply(device.Transform.World2, device.Transform.World1)

device.DrawPrimitives(PrimitiveType.TriangleList, 0, 2 * mx2 * my2)

device.Transform.World2 = Matrix.Multiply(Matrix.RotationX(-Math.PI / 2), Matrix.Translation(-10, 0, 0))

device.Transform.World = Matrix.Multiply(device.Transform.World2, device.Transform.World1)

device.DrawPrimitives(PrimitiveType.TriangleList, 0, 2 * mx2 * my2)

If mmn.MRast = False Then

device.SetTexture(0, texture)

device.TextureState(0).ColorOperation = TextureOperation.Modulate

device.TextureState(0).ColorArgument1 = TextureArgument.TextureColor

device.TextureState(0).ColorArgument2 = TextureArgument.Diffuse

device.Transform.World2 = Matrix.Multiply(Matrix.RotationY(0), Matrix.Translation(-10 + (20 - 16) / 2, 2, -0.5))

device.Transform.World = Matrix.Multiply(device.Transform.World2, device.Transform.World1)

device.SetStreamSource(0, vertexBuffer, 0)

device.DrawPrimitives(PrimitiveType.TriangleList, 0, 2 * mx * kol_y)

Else

device.SetTexture(0, textureM)

device.TextureState(0).ColorOperation = TextureOperation.Modulate

device.TextureState(0).ColorArgument1 = TextureArgument.TextureColor

device.TextureState(0).ColorArgument2 = TextureArgument.Diffuse

device.Transform.World2 = Matrix.Multiply(Matrix.RotationY(0), Matrix.Translation(-10 + (20 - 16) / 2, 2, -0.5))

device.Transform.World = Matrix.Multiply(device.Transform.World2, device.Transform.World1)

device.SetStreamSource(0, vertexBufferM, 0)

device.DrawPrimitives(PrimitiveType.TriangleList, 0, 2 * mx * kol_y)

mmn.MRast = False

End If

If mmn.createcameraview = False Then

device.SetTexture(0, texturecamera)

Dim vecFrom As New Vector3(mmn.NumericUpDownCX.Value, 10 + mmn.NumericUpDownCY.Value, 1 - mmn.NumericUpDownCZ.Value)

Dim vecAt As New Vector3(0, 10, 0)

Dim vecUp As New Vector3(0, 1, 0)

Dim matWorldInv As Matrix

Dim matWorld As Matrix

matWorldInv = Matrix.LookAtLH(vecFrom, vecAt, vecUp)

matWorld = Matrix.Invert(matWorldInv)

device.SetTransform(TransformType.World, matWorld)

coneMesh.DrawSubset(0)

Dim vecFrom2 As New Vector3(mmn.NumericUpDownCX.Value, 20, 1 - mmn.NumericUpDownCZ.Value)

Dim vecAt2 As New Vector3(mmn.NumericUpDownCX.Value, 0, 1.1 - mmn.NumericUpDownCZ.Value)

matWorldInv = Matrix.LookAtLH(vecFrom2, vecAt2, vecUp)

matWorld = Matrix.Invert(matWorldInv)

device.SetTransform(TransformType.World, matWorld)

cylMesh.DrawSubset(0)

vecFrom = New Vector3(mmn.NumericUpDownPX.Value, 10 + mmn.NumericUpDownPY.Value, 1 - mmn.NumericUpDownPZ.Value)

matWorldInv = Matrix.LookAtLH(vecFrom, vecAt, vecUp)

matWorld = Matrix.Invert(matWorldInv)

device.SetTransform(TransformType.World, matWorld)

coneMesh.DrawSubset(0)

vecFrom2 = New Vector3(mmn.NumericUpDownPY.Value, 20, 1 - mmn.NumericUpDownPZ.Value)

vecAt2 = New Vector3(mmn.NumericUpDownPY.Value, 0, 1.1 - mmn.NumericUpDownPZ.Value)

matWorldInv = Matrix.LookAtLH(vecFrom2, vecAt2, vecUp)

matWorld = Matrix.Invert(matWorldInv)

device.SetTransform(TransformType.World, matWorld)

cylMesh.DrawSubset(0)

End If

device.EndScene() 'Конец сцены

device.Present()

If mmn.createcameraview = True Then

Dim FbufC As Direct3D.Surface

FbufC = device.GetBackBuffer(0, 0, BackBufferType.Mono)

If mmn.createcameraviewM = False Then

SurfaceLoader.Save(".\Вид рабочей поверхности.bmp", ImageFileFormat.Bmp, FbufC)

Else

SurfaceLoader.Save(".\Вид мнимой поверхности.bmp", ImageFileFormat.Bmp, FbufC)

End If

mmn.createcameraview = False

mmn.createcameraviewM = False

Else

End If

End Sub 'Render

'Процедура настройки вида, мира и камеры

Private Sub SetupMatrices()

If mmn.createcameraview = True Then

RA = 0

RC = 0

RB = 0

Else

RA = mmn.TrackBar1.Value

RC = mmn.TrackBar2.Value

RB = mmn.TrackBar3.Value

End If

Dim fAngle As Single = (2.0F * Math.PI) / 360

Dim zAngel As Single = (2.0F * Math.PI) / 360

Dim xAngel As Single = (2.0F * Math.PI) / 360

device.Transform.World1 = Matrix.Multiply(Matrix.RotationY(fAngle), Matrix.RotationZ(zAngel))

device.Transform.World1 = Matrix.Multiply(device.Transform.World1, Matrix.RotationX(xAngel))

device.Transform.World = device.Transform.World1

If mmn.createcameraview = True Then

Dim l As Double = Math.Sqrt(mmn.NumericUpDownCX.Value ^ 2 + mmn.NumericUpDownCY.Value ^ 2 + mmn.NumericUpDownCZ.Value ^ 2)

device.Transform.View = Matrix.LookAtLH(New Vector3(mmn.NumericUpDownCX.Value * 1.0F, mmn.NumericUpDownCY.Value * 1.0F + 8, -mmn.NumericUpDownCZ.Value * 1.0F), New Vector3(0.0F, 8.0F, 0.0F), New Vector3(0.0F, 1.0F, 0))

device.Transform.Projection = Matrix.PerspectiveFovLH(2 * Math.Atan((16 / 2) / l), mx / kol_y, 1.0F, 100.0F)

Else

device.Transform.View = Matrix.LookAtLH(New Vector3(40.0F + RA, 40.0F + RB, -40.0F + RC), New Vector3(0.0F, 0.0F, 0.0F), New Vector3(0.0F, 1.0F, 0))

device.Transform.Projection = Matrix.PerspectiveFovLH(CSng(Math.PI) / 4, 1.0F, 1.0F, 1000.0F)

End If

End Sub 'SetupMatrices

'Процедура проверок

Private Function TryF()

If mmn.Text = "" Then 'Проверка на потерю приложения

mmn.Close()

Me.Close() 'Выход!

End If

If mmn.NewResolution Then 'Проверка на новое расширение

Me.ClientSize = New System.Drawing.Size(mmn.fWidth(0), mmn.fHeight(0))

mmn.NewResolution = False

mmn.NewRast = True

End If

If mmn.statW = "CreateBMPbrowser" Then 'Проверка на необходимость создать

Me.Hide() 'приложение BMPbrowser

mmn.Hide()

Dim mbrow As New BMPBrowser()

mbrow.Show()

mbrow.PictureBox1.Size = New System.Drawing.Size(mmn.fWidth(0), mmn.fHeight(0))

mbrow.ClientSize = New System.Drawing.Size(120 + mmn.fWidth(0), 0 + mmn.fHeight(0))

mbrow.PictureBox1.Location = New System.Drawing.Point(120, 0)

mbrow.Location = New System.Drawing.Point(300, 0)

While mbrow.Created

Application.DoEvents()

End While

mbrow.PictureBox1.Dispose()

mbrow.Dispose()

Me.Show()

mmn.Show()

mmn.statW = ""

End If

If mmn.createcameraviewA = 1 Then

mmn.autocreatall()

mmn.createcameraviewA = 0

mmn.SomeChange = False

mmn.refreshwindow = True

End If

If mmn.createcameraviewA = 2 Then

mmn.createcameraview = True

mmn.createcameraviewM = True

mmn.MRast = True

mmn.refreshwindow = True

mmn.createcameraviewA = 1

End If

If mmn.createcameraviewA = 3 Then

mmn.createcameraview = True

mmn.refreshwindow = True

mmn.createcameraviewA = 2

End If

End Function

Private Sub InitializeComponent()

Me.SuspendLayout()

''rendering

'Me.ClientSize = New System.Drawing.Size(292, 273)

Me.Name = "rendering"

Me.ResumeLayout(False)

End Sub

Protected Overrides Sub Finalize()

mmn.Close()

MyBase.Finalize()

End Sub

Private Sub Rendering_Paint(ByVal sender As System.Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles MyBase.Paint

mmn.refreshwindow = True

End Sub

Private Sub Rendering_KeyPress(ByVal sender As System.Object, ByVal e As System.Windows.Forms.KeyPressEventArgs) Handles MyBase.KeyPress

If Asc(e.KeyChar) = CInt(System.Windows.Forms.Keys.Escape) Then

Me.Close() Выход при нажатии на Esc

End If

End Sub

Shared Sub Main()

Dim frm As New rendering() 'Создаем окно rendering

If Not frm.InitializeGraphics() Then Initialize Direct3D

MessageBox.Show("Could not initialize Direct3D.")

Return

End If

frm.Show()

While frm.Created

frm.Render()

Application.DoEvents()

frm.TryF()

End While

End Sub 'Main

End Class

End Namespace

Приложение В

Листинг модуля « BMPBrowser.vb»

Public Class BMPBrowser

Inherits System.Windows.Forms.Form

Public stat As Boolean = False

Public z As IO.Stream

'Процедура при выборе элемента(bmp) и его отображение

Private Sub ListBox1_SelectedIndexChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ListBox1.SelectedIndexChanged

Try

Dim stf As IO.Stream

stf = New IO.FileStream(ListBox1.SelectedItem, IO.FileMode.Open)

Dim buf(stf.Length) As Byte

stf.Read(buf, 0, stf.Length)

stf.Close()

Me.Text = ListBox1.SelectedItem

z = New IO.MemoryStream()

z.Write(buf, 0, buf.Length)

PictureBox1.Image = Image.FromStream(z)

z.Close()

Catch

Me.Text = "Выберите объект"

End Try

End Sub

End Class

Приложение Г

Листинг модуля «MyClass.vb»

Public Class RecSize

Public X As Integer

Public Y As Integer

End Class

Размещено на Allbest.ru